package DebSrcBin;
use warnings;
use strict;
use integer;
use CheckVer;

# List the subparsable fields.
our %dkey_subparsable = map {$_=>1} qw(
  Depends
  Pre-Depends
  Recommends
  Suggests
  Conflicts
  Provides
  Replaces
  Enhances
  Build-Depends
  Build-Depends-Indep
  Build-Conflicts
  Build-Conflicts-Indep
  Binary
);

# List the required fields.  (Do not list Source and xProvides, however.
# These two fields are safely created in the instantiation even when the
# control stanza does not provide them.)
our @dkey_reqd = qw(
  Package
  Version
  Architecture
);

# List the irregularly keyed fields.
our %dkey_irreg = map {$_=>1} qw(
  task
  url
);

# List the version-relational operators.
our %rel = map {$_=>1} qw( << <= = >= >> );

# Define numerical priority levels.
our %pri = (
  required  =>  30,
  important =>  20,
  standard  =>  10,
  optional  =>   0,
  extra     => -10,
);
our $pri_default = -10;

# Set the default selection level and threshold.
our $select_default    = 0;
our $select_up_default = 1;

# Specify all the architectures of interest (typically
# qw( all any i386 )).  Or, set $arch_sense to 0 and specify all the
# architectures *not* of interest.
our $arch_sense = 1;
our %arch       = map {$_=>1} qw( all any i386 );

# Construct the pattern a subparsable field fits.
my $subp_pat;
{
  # This used to be one long pattern string, but then I couldn't read my own
  # pattern.  It was too long.  Splitting it into pieces here helps.  (If you
  # don't know Perl very well, even splitting it may not help much, eh?
  # Actually, it's pretty straightforward Perl, so if you want to read Perl
  # then it would be worth your while to learn to read this.)  -THB-
  my $pname   = qr/([^\s()\[\]]+)/;
  my $archs   = qr/\[\s*([^\[\]]*?)\s*\]/;
  my $rel     = qr/([<=>]*)/;
  my $ver     = qr/([^\s()]+?)/;
  my $rel_ver = qr/\(\s*${rel}\s*${ver}\s*\)/;
  $subp_pat   = qr/^${pname}\s*${rel_ver}?\s*${archs}?$/;
}

# Private subroutine: evaluate an architecture string.
sub eval_arch_str ($;$) {
  my( $arch_str, $arch_array ) = @_;
  my @arch;
  $$arch_array = \@arch if $arch_array;
  defined($arch_str) && length($arch_str) or return 1;
  @arch        = map {
    my( $not, $arch );
    ( $not, $arch ) = /^(!)?(\S+)$/
      or die "$0: bad architecture string\n$_\n$arch_str\n";
    +{
      not  => $not,
      arch => $arch,
    }
  } split ' ', $arch_str or return 1;
  my $so       = !$arch[0]{not};
  !$arch[$_]{not} eq $so
    or die "$0: mismatched `!' symbols\n$arch_str\n"
    for ( 1 .. $#arch );
  $arch_sense or $so = !$so;
  $arch{$_} and return $so for map { $_->{arch} } @arch;
  return !$so;
}

# Instantiate and initialize a new DebSrcBin object.
sub new {

  # Instantiate the object.
  my $class      = shift;
  my $self       = {};
  bless $self, $class;

  # Retrieve the next stanza from the Sources or Packages file.
  my $fh         = shift;
  {
    local $/        = '';
    $self->{stanza} = <$fh>;
    # warn "vvvvvvvv\n$self->{stanza}^^^^^^^^\n"; # diagnostic
  }
  defined $self->{stanza} or $self = undef, return $self;
  $self->{ldesc} = '';

  # Parse the stanza by line.
  for ( split /^/m, $self->{stanza} ) {
    if ( /^\s+\S/ ) {
      $self->{ldesc} .= $_;
    }
    elsif ( /^(\S*?):\s*(.*?)\s*$/ ) {
      my( $dkey, $dval ) = ( $1, $2 );
      $dkey =~ /^[[:upper:]]/ || $dkey_irreg{$dkey}
        or die "$0: bad field key $dkey\n$self->{stanza}";
      exists $self->{$dkey}
        and die "$0: repeated key $dkey\n$self->{stanza}";
      $self->{$dkey}    = $dval;
    }
    elsif ( /\S/ ) {
      die "$0: bad line\n$self->{stanza}";
    }
  }

  # Ensure required fields.  Skip if the architecture is irrelevant.
  # Number the Priority.
  defined( $self->{$_} ) && length( $self->{$_} )
    or die "$0: missing $_ key\n$self->{stanza}"
    for @dkey_reqd;
  eval_arch_str $self->{Architecture} or return new( $class, $fh );
  if ( defined $self->{Priority} ) {
    defined $pri{ $self->{Priority} }
      or die "$0: unknown priority $self->{Priority}\n$self->{stanza}";
    $self->{pri} = $pri{ $self->{Priority} };
  }
  else { $self->{pri} = $pri_default }

  # Subparse the subparsable lines.
  for my $dkey ( keys %$self ) {
    $dkey_subparsable{$dkey} or next;
    my $xkey = "x$dkey";

    $self->{"$xkey"} = [
      map {

        # The following is an *altern* (or *dependency alternative*): a
        # series of alternatives separated by " | " in the control
        # stanza.
        [
          map {

            # Here is a single entry like "debram (>> 0.5.1)".
            my( $vname, $rel, $ver, $archs );
            ( $vname, $rel, $ver, $archs ) = /$subp_pat/o
              or die "$0: cannot subparse\n$_\n$self->{stanza}";
            if ( defined($ver) ) {
              if    ( $rel eq '<'   ) { $rel = '<=' }
              elsif ( $rel eq '>'   ) { $rel = '>=' }
              elsif ( !length($rel) ) { $rel = '='  }
              $rel{$rel}
                or die "$0: unknown version-relational operator $rel\n"
                . "$self->{stanza}";
            }
            else {
              $rel = '=';
              $ver = '';
            }
            my $arch_array;
            eval_arch_str( $archs, \$arch_array ) ? {
              vname => $vname,
              rel   => $rel,
              ver   => $ver,
              arch  => $arch_array,
            } : ();

          } grep /\S/, split /\s*\|\s*/
        ]

      } grep /\S/, split /\s*,\s*/, $self->{$dkey}
    ];

  }

  # Ensure the Source field.  Create a select field.  Let the package
  # provide itself.  (These are unneeded but harmless for DebSrc
  # objects.)
  defined $self->{Source} or $self->{Source} = $self->{Package};
  $self->{select} = $select_default;
  unshift @{ $self->{xProvides} }, [
    {
      vname => $self->{Package},
      rel   => '=',
      ver   => $self->{Version},
    }
  ];

  # Reform xProvides to show provided names and versions (if there are
  # any versions), producing data records of the form
  #
  #     vname => { version_a, version_b },
  #
  # (technically "{ version_a=>1, version_b=>1 }"), where the null string
  # indicates [no version].
  #
  {
    my %prov2;
    for my $vhash2 ( map {@$_} @{ $self->{xProvides} } ) {
      $vhash2->{rel} eq '='
        or die "$0: unclear which version is provided "
        . "with $vhash2->{rel}\n$self->{stanza}\n";
      my $vname = $vhash2->{vname};
      my $ver   = $vhash2->{ver};
      $prov2{$vname}{ defined($ver) ? $ver : '' } = 1;
    }
    $self->{prov2} = \%prov2;
  }

  return $self;

}

sub cmp_ver {
  my( $self, $ver ) = @_;
  CheckVer::cmp_ver_string $self->{Version}, $ver;
}
sub check_ver {
  my( $self, $rel, $ver ) = @_;
  CheckVer::check_ver $self->{Version}, $rel, $ver;
}

1;

