#! @PERL@

# $NetBSD: lintpkgsrc.pl,v 1.115 2007/11/22 09:36:38 rillig Exp $

# Written by David Brownlee <abs@netbsd.org>.
#
# Caveats:
#	The 'Makefile parsing' algorithm used to obtain package versions and
#	DEPENDS information is geared towards speed rather than perfection,
#	though it has gotten somewhat better over time, it only parses the
#	simpler Makefile conditionals.
#
# TODO: Handle fun DEPENDS like avifile-devel with
#			{qt2-designer>=2.2.4,qt2-designer-kde>=2.3.1nb1}

$^W = 1;
use locale;
use strict;
use Getopt::Std;
use File::Find;
use File::Basename;
use IPC::Open3;
use Cwd 'realpath', 'getcwd';

# Buildtime configuration
my $conf_make      = '@MAKE@';
my $conf_pkgsrcdir = '@PKGSRCDIR@';
my $conf_prefix    = '@PREFIX@';

my (
    $pkglist,                     # list of Pkg packages
    $pkg_installver,              # installed version of pkg_install pseudo-pkg
    $default_vars,                # Set for Makefiles, inc PACKAGES & PKGSRCDIR
    %opt,                         # Command line options
    %vuln,                        # vulnerability data
    @matched_prebuiltpackages,    # List of obsolete prebuilt package paths
    @prebuilt_pkgdirs,            # Use to follow symlinks in prebuilt pkgdirs
    %prebuilt_pkgdir_cache,       # To avoid symlink loops in prebuilt_pkgdirs
);

$ENV{PATH} .=
  ":/bin:/usr/bin:/sbin:/usr/sbin:${conf_prefix}/sbin:${conf_prefix}/bin";

if (
       !getopts( 'BDE:I:K:LM:OP:RSVdg:himopru', \%opt )
    || $opt{h}
    || !(
           defined $opt{d}
        || defined $opt{g}
        || defined $opt{i}
        || defined $opt{m}
        || defined $opt{o}
        || defined $opt{p}
        || defined $opt{r}
        || defined $opt{u}
        || defined $opt{B}
        || defined $opt{D}
        || defined $opt{R}
        || defined $opt{O}
        || defined $opt{S}
        || defined $opt{V}
        || defined $opt{E}
    )
  )
{

    usage_and_exit();
}
$| = 1;

# Horrible kludge to ensure we have a value for testing in conditionals, but
# gets removed in the final evaluation
my $magic_undefined = 'M_a_G_i_C_UNDEFINED';

get_default_makefile_vars();    # $default_vars

if ( $opt{D} && @ARGV ) {
    foreach my $file (@ARGV) {
        if ( -d $file ) {
            $file .= "/Makefile";
        }
        if ( !-f $file ) {
            fail("No such file: $file");
        }
        my ( $pkgname, $vars ) = parse_makefile_pkgsrc($file);
        $pkgname ||= 'UNDEFINED';
        print "$file -> $pkgname\n";
        foreach my $varname ( sort keys %{$vars} ) {
            print "\t$varname = $vars->{$varname}\n";
        }

        #if ($opt{d}) {
        #	pkgsrc_check_depends();
        #}
    }
    exit;
}

sub main() {
    my ( $pkgsrcdir, $pkgdistdir );

    $pkgsrcdir  = $default_vars->{PKGSRCDIR};
    $pkgdistdir = $default_vars->{DISTDIR};

    if ( $opt{r} && !$opt{o} && !$opt{m} && !$opt{p} ) {
        $opt{o} = $opt{m} = $opt{p} = 1;
    }
    if ( $opt{o} || $opt{m} ) {
        my (@baddist);

        @baddist =
          scan_pkgsrc_distfiles_vs_distinfo( $pkgsrcdir, $pkgdistdir, $opt{o},
            $opt{m} );
        if ( $opt{r} ) {
            verbose("Unlinking 'bad' distfiles\n");
            foreach my $distfile (@baddist) {
                unlink("$pkgdistdir/$distfile");
            }
        }
    }

    # List BROKEN packages
    if ( $opt{B} ) {
        scan_pkgsrc_makefiles($pkgsrcdir);
        foreach my $pkgver ( $pkglist->pkgver ) {
            $pkgver->var('BROKEN') || next;
            print $pkgver->pkgname . ': ' . $pkgver->var('BROKEN') . "\n";
        }
    }

    # List obsolete or NO_BIN_ON_FTP/RESTRICTED prebuilt packages
    #
    if ( $opt{p} || $opt{O} || $opt{R} || $opt{V} ) {
        if ( $opt{V} ) {
            my ($vuln) = "$pkgdistdir/pkg-vulnerabilities";

            if ( !open( VULN, $vuln ) ) {
                fail("Unable to open '$vuln': $!");
            }
            while (<VULN>) {
                s/#.*//;
                if (/([^*?[]+)(<|>|<=|>=)(\d\S+)/) {
                    my ( $pkg, $cmp, $ver ) = ( $1, $2, $3 );
                    push( @{ $vuln{$pkg} }, "$cmp $ver" );
                }
            }
            close(VULN);
        }

        if ( $opt{p} || $opt{O} || $opt{R} || $opt{V} ) {
            scan_pkgsrc_makefiles($pkgsrcdir);
        }
        @prebuilt_pkgdirs      = ( $default_vars->{PACKAGES} );
        %prebuilt_pkgdir_cache = ();

        while (@prebuilt_pkgdirs) {
            find( \&check_prebuilt_packages, shift @prebuilt_pkgdirs );
        }

        if ( $opt{r} ) {
            verbose("Unlinking listed prebuiltpackages\n");
            foreach my $pkgfile (@matched_prebuiltpackages) {
                unlink($pkgfile);
            }
        }
    }

    if ( $opt{S} ) {
        my (%in_subdir);

        foreach my $cat ( list_pkgsrc_categories($pkgsrcdir) ) {
            my $vars = parse_makefile_vars("$pkgsrcdir/$cat/Makefile");

            if ( !$vars->{SUBDIR} ) {
                print "Warning - no SUBDIR for $cat\n";
                next;
            }
            foreach my $pkgdir ( split( /\s+/, $vars->{SUBDIR} ) ) {
                $in_subdir{"$cat/$pkgdir"} = 1;
            }
        }

        scan_pkgsrc_makefiles($pkgsrcdir);
        foreach my $pkgver ( $pkglist->pkgver ) {
            if ( !defined $in_subdir{ $pkgver->var('dir') } ) {
                print $pkgver->var('dir') . ": Not in SUBDIR\n";
            }
        }
    }

    if ( $opt{g} ) {
        my $tmpfile = "$opt{g}.tmp.$$";

        scan_pkgsrc_makefiles($pkgsrcdir);
        if ( !open( TABLE, ">$tmpfile" ) ) {
            fail("Unable to write '$tmpfile': $!");
        }
        foreach my $pkgver ( $pkglist->pkgver ) {
            print TABLE $pkgver->pkg . "\t"
              . $pkgver->var('dir') . "\t"
              . $pkgver->ver . "\n";
        }
        if ( !close(TABLE) ) {
            fail("Error while writing '$tmpfile': $!");
        }
        if ( !rename( $tmpfile, $opt{g} ) ) {
            fail("Error in rename('$tmpfile','$opt{g}'): $!");
        }
    }

    if ( $opt{d} ) {
        scan_pkgsrc_makefiles($pkgsrcdir);
        pkgsrc_check_depends();
    }

    if ( $opt{i} || $opt{u} ) {
        my ( @pkgs, @update );

        @pkgs = list_installed_packages();
        scan_pkgsrc_makefiles($pkgsrcdir);

        foreach my $pkgname ( sort @pkgs ) {
            if ( $_ = invalid_version($pkgname) ) {
                print $_;

                if ( $pkgname =~ /^([^*?[]+)-([\d*?[].*)/ ) {
                    foreach my $pkgver ( $pkglist->pkgver($1) ) {
                        $pkgver->var('dir') =~ /-current/ && next;
                        push( @update, $pkgver );
                        last;
                    }
                }
            }
        }

        if ( $opt{u} ) {
            print "\nREQUIRED details for packages that could be updated:\n";

            foreach my $pkgver (@update) {
                print $pkgver->pkg . ':';
                if ( open( PKGINFO, 'pkg_info -R ' . $pkgver->pkg . '|' ) ) {
                    my ($list);

                    while (<PKGINFO>) {
                        if (/Required by:/) {
                            $list = 1;
                        }
                        elsif ($list) {
                            chomp;
                            s/-\d.*//;
                            print " $_";
                        }
                    }
                    close(PKGINFO);
                }
                print "\n";
            }

            print
              "\nRunning '${conf_make} fetch-list | sh' for each package:\n";
            foreach my $pkgver (@update) {
                my ($pkgdir);

                $pkgdir = $pkgver->var('dir');
                if ( !defined($pkgdir) ) {
                    fail(
                        'Unable to determine ' . $pkgver->pkg . ' directory' );
                }

                print "$pkgsrcdir/$pkgdir\n";
                safe_chdir("$pkgsrcdir/$pkgdir");
                system("${conf_make} fetch-list | sh");
            }
        }
    }

    if ( $opt{E} ) {
        scan_pkgsrc_makefiles($pkgsrcdir);
        store_pkgsrc_makefiles( $opt{E} );
    }
}

sub canonicalize_pkgname($) {
	my ($pkgname) = @_;

	$pkgname =~ s,^py\d+(?:pth|)-,py-,;
	$pkgname =~ s,^ruby\d+-,ruby-,;
	$pkgname =~ s,^php\d+-,php-,;
	return $pkgname;
}

# Could speed up by building a cache of package names to paths, then processing
# each package name once against the tests.
sub check_prebuilt_packages() {

    if ( $_ eq 'distfiles' || $_ eq 'pkgsrc' ) {

        # Skip these subdirs if present
        $File::Find::prune = 1;

    }
    elsif (/(.+)-(\d.*)\.t[bg]z$/) {
        my ( $pkg, $ver ) = ( $1, $2 );

	$pkg = canonicalize_pkgname($pkg);

        if ( $opt{V} && $vuln{$pkg} ) {
            foreach my $chk ( @{ $vuln{$pkg} } ) {
                my ( $test, $matchver ) = split( ' ', $chk );

                if ( deweycmp( $ver, $test, $matchver ) ) {
                    print "$File::Find::dir/$_\n";
                    push( @matched_prebuiltpackages, "$File::Find::dir/$_" );
                    last;
                }
            }
        }

        my ($pkgs);
        if ( $pkgs = $pkglist->pkgs($pkg) ) {
            my ($pkgver) = $pkgs->pkgver($ver);

            if ( !defined $pkgver ) {
                if ( $opt{p} ) {
                    print "$File::Find::dir/$_\n";
                    push( @matched_prebuiltpackages, "$File::Find::dir/$_" );
                }

                # Pick probably the last version
                $pkgver = $pkgs->latestver;
            }

            if ( $opt{R} && $pkgver->var('RESTRICTED') ) {
                print "$File::Find::dir/$_\n";
                push( @matched_prebuiltpackages, "$File::Find::dir/$_" );
            }

            if ( $opt{O} && $pkgver->var('OSVERSION_SPECIFIC') ) {
                print "$File::Find::dir/$_\n";
                push( @matched_prebuiltpackages, "$File::Find::dir/$_" );
            }
        }

    }
    elsif ( -d $_ ) {
        if ( $prebuilt_pkgdir_cache{"$File::Find::dir/$_"} ) {
            $File::Find::prune = 1;
            return;
        }

        $prebuilt_pkgdir_cache{"$File::Find::dir/$_"} = 1;
        if ( -l $_ ) {
            my ($dest) = readlink($_);

            if ( substr( $dest, 0, 1 ) ne '/' ) {
                $dest = "$File::Find::dir/$dest";
            }
            if ( !$prebuilt_pkgdir_cache{$dest} ) {
                push( @prebuilt_pkgdirs, $dest );
            }
        }
    }
}

# Dewey decimal verson number matching - or thereabouts
# Also handles 'nb<N>' suffix (checked iff values otherwise identical)
#
sub deweycmp($$$) {
    my ( $match, $test, $val ) = @_;
    my ( $cmp, $match_nb, $val_nb );

    $match_nb = $val_nb = 0;
    if ( $match =~ /(.*)nb(.*)/ ) {

        # Handle nb<N> suffix
        $match    = $1;
        $match_nb = $2;
    }

    if ( $val =~ /(.*)nb(.*)/ ) {

        # Handle nb<N> suffix
        $val    = $1;
        $val_nb = $2;
    }

    $cmp = deweycmp_extract( $match, $val );

    if ( !$cmp ) {

        # Iff otherwise identical, check nb suffix
        $cmp = deweycmp_extract( $match_nb, $val_nb );
    }

    eval "$cmp $test 0";
}

sub convert_to_standard_dewey(@) {
    my ( $elem, $underscore, @temp );

    # According to the current implementation in pkg_install/lib/str.c
    # as of 2002/06/02, '_' before a number, '.', and 'pl' get treated as 0,
    # while 'rc' and 'pre' get treated as -1; beta as '-2', alpha as '-3'.
    # Other characters are converted to lower
    # case and then to a number: a->1, b->2, c->3, etc. Numbers stay the same.
    # 'nb' is a special case that's already been handled when we are here.
    foreach $elem (@_) {
        if ( $elem =~ /\d+/ ) {
            push( @temp, $elem );

        }
        elsif ( $elem =~ /^pl$/ or $elem =~ /^\.$/ ) {
            push( @temp, 0 );

        }
        elsif ( $elem =~ /^_$/ ) {
            push( @temp, 0 );

        }
        elsif ( $elem =~ /^pre$/ ) {
            push( @temp, -1 );

        }
        elsif ( $elem =~ /^rc$/ ) {
            push( @temp, -1 );

        }
        elsif ( $elem =~ /^beta$/ ) {
            push( @temp, -2 );

        }
        elsif ( $elem =~ /^alpha$/ ) {
            push( @temp, -3 );

        }
        else {
            push( @temp, 0 );
            push( @temp, ord($elem) - ord("a") + 1 );
        }
    }
    @temp;
}

sub deweycmp_extract($$) {
    my ( $match, $val ) = @_;
    my ( $cmp, @matchlist, @vallist, $i, $len );

    @matchlist = convert_to_standard_dewey( split( /(\D+)/, lc($match) ) );
    @vallist   = convert_to_standard_dewey( split( /(\D+)/, lc($val) ) );
    $cmp       = 0;
    $i         = 0;
    if ( $#matchlist > $#vallist ) {
        $len = $#matchlist;
    }
    else {
        $len = $#vallist;
    }
    while ( !$cmp && ( $i++ <= $len ) ) {
        if ( !@matchlist ) {
            push( @matchlist, 0 );
        }
        if ( !@vallist ) {
            push( @vallist, 0 );
        }
        $cmp = ( shift @matchlist <=> shift @vallist );
    }
    $cmp;
}

sub fail(@) {

    print STDERR @_, "\n";
    exit(3);
}

sub get_default_makefile_vars() {

    chomp( $pkg_installver = `pkg_info -V 2>/dev/null || echo 20010302` );

    chomp( $_ = `uname -srm` );
    (
        $default_vars->{OPSYS},
        $default_vars->{OS_VERSION},
        $default_vars->{MACHINE}
    ) = (split);
    if ( !$default_vars->{MACHINE} ) {
        die('Unable to extract machine from uname');
    }

    # Handle systems without uname -p  (NetBSD pre 1.4)
    chomp( $default_vars->{MACHINE_ARCH} = `uname -p 2>/dev/null` );

    if ( !$default_vars->{MACHINE_ARCH}
        && $default_vars->{OS_VERSION} eq 'NetBSD' )
    {
        chomp( $default_vars->{MACHINE_ARCH} = `sysctl -n hw.machine_arch` );
    }

    if ( !$default_vars->{MACHINE_ARCH} ) {
        $default_vars->{MACHINE_ARCH} = $default_vars->{MACHINE};
    }

    $default_vars->{OBJECT_FMT}  = 'x';
    $default_vars->{LOWER_OPSYS} = lc( $default_vars->{OPSYS} );

    if ( $opt{P} ) {
        $default_vars->{PKGSRCDIR} = $opt{P};
    }
    else {
        $default_vars->{PKGSRCDIR} = $conf_pkgsrcdir;
    }

    $default_vars->{DESTDIR}   = '';
    $default_vars->{LOCALBASE} = '/usr/pkg';
    $default_vars->{X11BASE}   = '/usr/X11R6';

    my ($vars);
    if ( -f '/etc/mk.conf' && ( $vars = parse_makefile_vars('/etc/mk.conf') ) )
    {
        foreach my $var ( keys %{$vars} ) {
            $default_vars->{$var} = $vars->{$var};
        }
    }

    if ( $opt{P} ) {
        $default_vars->{PKGSRCDIR} = $opt{P};
    }

    if ( $opt{M} ) {
        $default_vars->{DISTDIR} = $opt{M};
    }
    else {
        $default_vars->{DISTDIR} ||= $default_vars->{PKGSRCDIR} . '/distfiles';
    }

    if ( $opt{K} ) {
        $default_vars->{PACKAGES} = $opt{K};
    }

    # Extract some variables from bsd.pkg.mk
    my ($mkvars);
    $mkvars = parse_makefile_vars(
        "$default_vars->{PKGSRCDIR}/mk/bsd.pkg.mk",
        "$default_vars->{PKGSRCDIR}/mk/scripts"
    );
    foreach my $varname ( keys %{$mkvars} ) {
        if ( $varname =~ /_REQD$/ || $varname eq 'EXTRACT_SUFX' ) {
            $default_vars->{$varname} = $mkvars->{$varname};
        }
    }

    $default_vars->{PACKAGES} ||= $default_vars->{PKGSRCDIR} . '/packages';
}

# Determine if a package version is current. If not, report correct version
# if found
#
sub invalid_version($) {
    my ($pkgmatch) = @_;
    my ( $fail,       $ok );
    my ( @pkgmatches, @todo );

    @todo = ($pkgmatch);

    # We handle {} here, everything else in package_globmatch
    while ( $pkgmatch = shift @todo ) {
        if ( $pkgmatch =~ /(.*){([^{}]+)}(.*)/ ) {
            foreach ( split( ',', $2 ) ) {
                push( @todo, "$1$_$3" );
            }
        }
        else {
            push( @pkgmatches, $pkgmatch );
        }
    }

    foreach $pkgmatch (@pkgmatches) {
        my ( $pkg, $badver ) = package_globmatch($pkgmatch);

        if ( defined($badver) ) {
            my ($pkgs);

            if ( $pkgs = $pkglist->pkgs($pkg) ) {
                $fail .=
                  "Version mismatch: '$pkg' $badver vs "
                  . join( ',', $pkgs->versions ) . "\n";
            }
            else {
                $fail .= "Unknown package: '$pkg' version $badver\n";
            }
        }
        else {

            # If we find one match, don't bitch about others
            $ok = 1;
        }
    }
    $ok && ( $fail = undef );
    $fail;
}

# List (recursive) non directory contents of specified directory
#
sub listdir($$) {
    my ( $base, $dir ) = @_;
    my ($thisdir);
    my ( @list, @thislist );

    $thisdir = $base;
    if ( defined($dir) ) {
        $thisdir .= "/$dir";
        $dir     .= '/';
    }
    else {
        $dir = '';
    }

    opendir( DIR, $thisdir ) || fail("Unable to opendir($thisdir): $!");
    @thislist = grep( substr( $_, 0, 1 ) ne '.' && $_ ne 'CVS', readdir(DIR) );
    closedir(DIR);
    foreach my $entry (@thislist) {
        if ( -d "$thisdir/$entry" ) {
            push( @list, listdir( $base, "$dir$entry" ) );
        }
        else {
            push( @list, "$dir$entry" );
        }
    }
    @list;
}

# Use pkg_info to list installed packages
#
sub list_installed_packages() {
    my (@pkgs);

    open(PKG_INFO, 'pkg_info -e "*" |') || fail("Unable to run pkg_info: $!");
    while (defined(my $pkg = <PKG_INFO>)) {
        chomp($pkg);
        push(@pkgs, canonicalize_pkgname($pkg));
    }
    close(PKG_INFO);

    @pkgs;
}

# List top level pkgsrc categories
#
sub list_pkgsrc_categories($) {
    my ($pkgsrcdir) = @_;
    my (@categories);

    opendir( BASE, $pkgsrcdir ) || die("Unable to opendir($pkgsrcdir): $!");
    @categories =
      grep( substr( $_, 0, 1 ) ne '.'
          && $_ ne 'CVS'
          && -f "$pkgsrcdir/$_/Makefile",
        readdir(BASE) );
    closedir(BASE);
    @categories;
}

# For a given category, list potentially valid pkgdirs
#
sub list_pkgsrc_pkgdirs($$) {
    my ( $pkgsrcdir, $cat ) = @_;
    my (@pkgdirs);

    if ( !opendir( CAT, "$pkgsrcdir/$cat" ) ) {
        die("Unable to opendir($pkgsrcdir/cat): $!");
    }
    @pkgdirs =
      sort grep( $_ ne 'Makefile'
          && $_ ne 'pkg'
          && $_ ne 'CVS'
          && substr( $_, 0, 1 ) ne '.',
        readdir(CAT) );
    close(CAT);
    @pkgdirs;
}

sub glob2regex($) {
    my ($glob) = @_;
    my ( @chars, $in_alt );
    my ($regex);

    @chars = split( //, $glob );
    while ( defined( $_ = shift @chars ) ) {
        if ( $_ eq '*' ) {
            $regex .= '.*';
        }
        elsif ( $_ eq '?' ) {
            $regex .= '.';
        }
        elsif ( $_ eq '+' ) {
            $regex .= '.';
        }
        elsif ( $_ eq '\\+' ) {
            $regex .= $_ . shift @chars;
        }
        elsif ( $_ eq '.' || $_ eq '|' ) {
            $regex .= quotemeta;
        }
        elsif ( $_ eq '{' ) {
            $regex .= '(';
            ++$in_alt;
        }
        elsif ( $_ eq '}' ) {
            if ( !$in_alt ) {

                # Error
                return undef;
            }
            $regex .= ')';
            --$in_alt;
        }
        elsif ( $_ eq ',' && $in_alt ) {
            $regex .= '|';
        }
        else {
            $regex .= $_;
        }
    }

    if ($in_alt) {

        # Error
        return undef;
    }
    if ( $regex eq $glob ) {
        return ('');
    }
    if ( $opt{D} ) {
        print "glob2regex: $glob -> $regex\n";
    }
    '^' . $regex . '$';
}

# Perform some (reasonable) subset of 'pkg_info -e' / glob(3)
# Returns (sometimes best guess at) package name,
# and either 'problem version' or undef if all OK
#
sub package_globmatch($) {
    my ($pkgmatch) = @_;
    my ( $matchpkgname, $matchver, $regex );

    if ( $pkgmatch =~ /^([^*?[]+)(<|>|<=|>=|-)(\d[^*?[{]*)$/ ) {

        # (package)(cmp)(dewey)
        my ( $test, @pkgvers );

        ( $matchpkgname, $test, $matchver ) = ( $1, $2, $3 );
        if ( @pkgvers = $pkglist->pkgver($matchpkgname) ) {
            foreach my $pkgver (@pkgvers) {
                if ( $test eq '-' ) {
                    if ( $pkgver->ver eq $matchver ) {
                        $matchver = undef;
                        last;
                    }
                }
                else {
                    if ( deweycmp( $pkgver->ver, $test, $matchver ) ) {
                        $matchver = undef;
                        last;
                    }
                }
            }

            if ( $matchver && $test ne '-' ) {
                $matchver = "$test$matchver";
            }
        }

    }
    elsif ( $pkgmatch =~ /^([^[]+)-([\d*?{[].*)$/ ) {

        # (package)-(globver)
        my (@pkgnames);

        ( $matchpkgname, $matchver ) = ( $1, $2 );

        if ( defined $pkglist->pkgs($matchpkgname) ) {
            push( @pkgnames, $matchpkgname );

        }
        elsif ( $regex = glob2regex($matchpkgname) ) {
            foreach my $pkg ( $pkglist->pkgs ) {
                ( $pkg->pkg() =~ /$regex/ ) && push( @pkgnames, $pkg->pkg() );
            }
        }

        # Try to convert $matchver into regex version
        #
        $regex = glob2regex($matchver);

        foreach my $pkg (@pkgnames) {
            if ( defined $pkglist->pkgver( $pkg, $matchver ) ) {
                return ($matchver);
            }

            if ($regex) {
                foreach my $ver ( $pkglist->pkgs($pkg)->versions ) {
                    if ( $ver =~ /$regex/ ) {
                        $matchver = undef;
                        last;
                    }
                }
            }

            $matchver || last;
        }

        # last ditch attempt to handle the whole DEPENDS as a glob
        #
        if ( $matchver && ( $regex = glob2regex($pkgmatch) ) ) {

            # (large-glob)
            foreach my $pkgver ( $pkglist->pkgver ) {
                if ( $pkgver->pkgname =~ /$regex/ ) {
                    $matchver = undef;
                    last;
                }
            }
        }

    }
    else {
        ( $matchpkgname, $matchver ) = ( $pkgmatch, 'missing' );
    }

    ( $matchpkgname, $matchver );
}

# Parse a pkgsrc package makefile and return the pkgname and set variables
#
sub parse_makefile_pkgsrc($) {
    my ($file) = @_;
    my ( $pkgname, $vars );

    $vars = parse_makefile_vars($file);

    if ( !$vars ) {

        # Missing Makefile
        return undef;
    }

    if ( defined $vars->{PKGNAME} ) {
        $pkgname = $vars->{PKGNAME};

    }
    elsif ( defined $vars->{DISTNAME} ) {
        $pkgname = $vars->{DISTNAME};
    }

    if ( defined $vars->{PKGNAME} ) {
        debug("$file: PKGNAME=$vars->{PKGNAME}\n");
    }
    if ( defined $vars->{DISTNAME} ) {
        debug("$file: DISTNAME=$vars->{DISTNAME}\n");
    }

    if ( !defined $pkgname || $pkgname !~ /(.*)-(\d.*)/ ) {

        # invoke make here as a last resort
        my ($pkgsrcdir) = ( $file =~ m:(/.*)/: );
        my $pid = open3( \*WTR, \*RDR, \*ERR,
            "cd $pkgsrcdir ; ${conf_make} show-vars VARNAMES=PKGNAME" );
        if ( !$pid ) {
            warn "$file: Unable to run make: $!";
        }
        else {
            close(WTR);
            my @errors = <ERR>;
            close(ERR);
            my ($makepkgname) = <RDR>;
            close(RDR);
            wait;
            chomp @errors;
            if (@errors) { warn "\n$file: @errors\n"; }

            if ( $makepkgname =~ /(.*)-(\d.*)/ ) {
                $pkgname = $makepkgname;
            }
        }
    }

    if ( defined $pkgname ) {
        if ( $pkgname =~ /^pkg_install-(\d+)$/ && $1 < $pkg_installver ) {
            $pkgname = "pkg_install-$pkg_installver";
        }

	$pkgname = canonicalize_pkgname($pkgname);

        if ( defined $vars->{PKGREVISION}
            and not $vars->{PKGREVISION} =~ /^\s*$/ )
        {
            if ( $vars->{PKGREVISION} =~ /\D/ ) {
                print
                  "\nBogus: PKGREVISION $vars->{PKGREVISION} (from $file)\n";

            }
            elsif ( $vars->{PKGREVISION} ) {
                $pkgname .= "nb";
                $pkgname .= $vars->{PKGREVISION};
            }
        }

        if ( $pkgname =~ /\$/ ) {
            print "\nBogus: $pkgname (from $file)\n";

        }
        elsif ( $pkgname =~ /(.*)-(\d.*)/ ) {
            if ($pkglist) {
                my ($pkgver) = $pkglist->add( $1, $2 );

                debug("add $1 $2\n");

                foreach
                  my $var (qw(DEPENDS RESTRICTED OSVERSION_SPECIFIC BROKEN))
                {
                    $pkgver->var( $var, $vars->{$var} );
                }

                if ( defined $vars->{NO_BIN_ON_FTP} ) {
                    $pkgver->var( 'RESTRICTED', 'NO_BIN_ON_FTP' );
                }

                if ( $file =~ m:([^/]+/[^/]+)/Makefile$: ) {
                    $pkgver->var( 'dir', $1 );
                }
                else {
                    $pkgver->var( 'dir', 'unknown' );
                }
            }
        }
        else {
            print "Cannot extract $pkgname version ($file)\n";
        }

        return ( $pkgname, $vars );

    }
    else {
        return (undef);
    }
}

# Extract variable assignments from Makefile
# Much unpalatable magic to avoid having to use make (all for speed)
#
sub parse_makefile_vars($$) {
    my ( $file, $cwd ) = @_;
    my (
        $pkgname, %vars, $plus, $value, @data,
        %incfiles,    # Cache of previously included fils
        %incdirs,     # Directories in which to check for includes
        @if_false
    );                # 0:true 1:false 2:nested-false&nomore-elsif

    if ( !open( FILE, $file ) ) {
        return (undef);
    }
    @data = map { chomp; $_ } <FILE>;
    close(FILE);

    $incdirs{"."} = 1;
    $incdirs{ dirname($file) } = 1;

    # Some Makefiles depend on these being set
    if ( $file eq '/etc/mk.conf' ) {
        $vars{LINTPKGSRC} = 'YES';
    }
    else {
        %vars = %{$default_vars};
    }
    $vars{BSD_PKG_MK} = 'YES';

    if ($cwd) {
        $vars{'.CURDIR'} = $cwd;

    }
    elsif ( $file =~ m#(.*)/# ) {
        $vars{'.CURDIR'} = $1;

    }
    else {
        $vars{'.CURDIR'} = getcwd;
    }

    $incdirs{ $vars{'.CURDIR'} } = 1;
    if ( $opt{L} ) {
        print "$file\n";
    }

    while ( defined( $_ = shift(@data) ) ) {
        s/\s*#.*//;

        # Continuation lines
        #
        while ( substr( $_, -1 ) eq "\\" ) {
            substr( $_, -2 ) = shift @data;
        }

        # Conditionals
        #
        if (m#^\.\s*if(|def|ndef)\s+(.*)#) {
            my ( $type, $false );

            $type = $1;
            if ( $if_false[$#if_false] ) {
                push( @if_false, 2 );

            }
            elsif ( $type eq '' ) {

                # Straight if
                push( @if_false, parse_eval_make_false( $2, \%vars ) );

            }
            else {
                $false = !defined( $vars{ parse_expand_vars( $2, \%vars ) } );
                if ( $type eq 'ndef' ) {
                    $false = !$false;
                }
                push( @if_false, $false ? 1 : 0 );
            }
            debug("$file: .if$type (! @if_false)\n");
            next;
        }

        if ( m#^\.\s*elif\s+(.*)# && @if_false ) {
            if ( $if_false[$#if_false] == 0 ) {
                $if_false[$#if_false] = 2;
            }
            elsif ( $if_false[$#if_false] == 1
                && !parse_eval_make_false( $1, \%vars ) )
            {
                $if_false[$#if_false] = 0;
            }
            debug("$file: .elif (! @if_false)\n");
            next;
        }

        if ( m#^\.\s*else\b# && @if_false ) {
            $if_false[$#if_false] = $if_false[$#if_false] == 1 ? 0 : 1;
            debug("$file: .else (! @if_false)\n");
            next;
        }

        if (m#^\.\s*endif\b#) {
            pop(@if_false);
            debug("$file: .endif (! @if_false)\n");
            next;
        }

        $if_false[$#if_false] && next;

        # Included files (just unshift onto @data)
        #
        if (m#^\.\s*include\s+"([^"]+)"#) {
            my ($incfile) = parse_expand_vars( $1, \%vars );

            # At this point just skip any includes which we were not able to
            # fully expand
            if (   $incfile =~ m#/mk/bsd#
                || $incfile =~ /$magic_undefined/
                || ( !$opt{d} && $incfile =~ m#/(buildlink[^/]*\.mk)# ) )
            {
                debug("$file: .include \"$incfile\" skipped\n");
            }
            else {
                debug("$file: .include \"$incfile\"\n");

                # Expand any simple vars in $incfile
                #

                if ( substr( $incfile, 0, 1 ) ne '/' ) {
                    foreach my $dir ( keys %incdirs ) {
                        if ( -f "$dir/$incfile" ) {
                            $incfile = "$dir/$incfile";
                            last;
                        }
                    }
                }

                # perl 5.6.1 realpath() cannot handle files, only directories
                # If the last component is a symlink this will give a false
                # negative, but that is not a problem as the duplicate check
                # is for performance
                $incfile =~ m#^(.+)(/[^/]+)$#;

                if ( !-f $incfile ) {
                    if ( !$opt{L} ) {
                        verbose("\n");
                    }

                    verbose("$file: Cannot locate $incfile in "
                          . join( " ", sort keys %incdirs )
                          . "\n" );

                }
                else {
                    $incfile = realpath($1) . $2;

                    if ( !$incfiles{$incfile} ) {
                        if ( $opt{L} ) {
                            print "inc $incfile\n";
                        }
                        $incfiles{$incfile} = 1;

                        if ( !open( FILE, $incfile ) ) {
                            verbose(
                                "Cannot open '$incfile' (from $file): $_ $!\n");
                        }
                        else {
                            my $NEWCURDIR = $incfile;
                            $NEWCURDIR =~ s#/[^/]*$##;
                            $incdirs{$NEWCURDIR} = 1;
                            unshift( @data, ".CURDIR=$vars{'.CURDIR'}" );
                            unshift( @data, map { chomp; $_ } <FILE> );
                            unshift( @data, ".CURDIR=$NEWCURDIR" );
                            close(FILE);
                        }
                    }
                }
            }
            next;
        }

        if (/^ *([-\w\.]+)\s*([:+?]?)=\s*(.*)/) {
            my ($key);

            $key   = $1;
            $plus  = $2;
            $value = $3;

            if ( $plus eq ':' ) {
                $vars{$key} = parse_expand_vars( $value, \%vars );
            }
            elsif ( $plus eq '+' && defined $vars{$key} ) {
                $vars{$key} .= " $value";
            }
            elsif ( $plus ne '?' || !defined $vars{$key} ) {
                $vars{$key} = $value;
            }
            debug("assignment: $key$plus=[$value] ($vars{$key})\n");

            # Give python a little hand (XXX - do we wanna consider actually
            # implementing make .for loops, etc?
            #
            if ( $key eq "PYTHON_VERSIONS_ACCEPTED" ) {
                my ($pv);

                foreach $pv ( split( /\s+/, $vars{PYTHON_VERSIONS_ACCEPTED} ) )
                {
                    $vars{"_PYTHON_VERSION_FIRSTACCEPTED"} ||= $pv;
                    $vars{"_PYTHON_VERSION_${pv}_OK"} = "yes";
                }
            }
        }
    }

    debug("$file: expand\n");

    # Handle variable substitutions  FRED = a-${JIM:S/-/-b-/}
    #
    my ($loop);

    for ( $loop = 1 ; $loop ; ) {
        $loop = 0;
        foreach my $key ( keys %vars ) {
            if ( index( $vars{$key}, '$' ) == -1 ) {
                next;
            }

            $_ = parse_expand_vars( $vars{$key}, \%vars );
            if ( $_ ne $vars{$key} ) {
                $vars{$key} = $_;
                $loop = 1;

            }
            elsif ( $vars{$key} =~
                m#\${(\w+):([CS]([^{}])[^{}\3]+\3[^{}\3]*\3[g1]*(|:[^{}]+))}# )
            {
                my ( $left, $subvar, $right ) = ( $`, $1, $' );
                my (@patterns) = split( ':', $2 );
                my ($result);

                $result = $vars{$subvar};
                $result ||= '';

                # If $vars{$subvar} contains a $ skip it on this pass.
                # Hopefully it will get substituted and we can catch it
                # next time around.
                if ( index( $result, '${' ) != -1 ) {
                    next;
                }

                debug(
                    "$file: substitutelist $key ($result) $subvar (@patterns)\n"
                );
                foreach (@patterns) {
                    if ( !m#([CS])(.)([^/]+)\2([^/]*)\2([1g]*)# ) {
                        next;
                    }

                    my ( $how, $from, $to, $global ) = ( $1, $3, $4, $5 );

                    debug(
"$file: substituteglob $subvar, $how, $from, $to, $global\n"
                    );
                    if ( $how eq 'S' ) {

                        # Limited substitution - keep ^ and $
                        $from =~ s/([?.{}\]\[*+])/\\$1/g;
                    }
                    $to =~ s/\\(\d)/\$$1/g;    # Change \1 etc to $1
                    $to =~ s/\&/\$&/g;         # Change & to $1

                    my ($notfirst);
                    if ( $global =~ s/1// ) {
                        ( $from, $notfirst ) = split( '\s', $from, 2 );
                    }

                    debug("$file: substituteperl $subvar, $how, $from, $to\n");
                    eval "\$result =~ s/$from/$to/$global";
                    if ( defined $notfirst ) {
                        $result .= " $notfirst";
                    }
                }

                $vars{$key} = $left . $result . $right;
                $loop = 1;
            }
        }
    }

    foreach my $key ( keys %vars ) {
        $vars{$key} =~ s/$magic_undefined//;
    }
    \%vars;
}

sub parse_expand_vars($$) {
    my ( $line, $vars ) = @_;

    while ( $line =~ /\$\{([-\w.]+)\}/ ) {
        if ( defined( ${$vars}{$1} ) ) {
            $line = $` . ${$vars}{$1} . $';
        }
        else {
            $line = $` . $magic_undefined . $';
        }
    }
    $line;
}

sub parse_expand_vars_dumb($$) {
    my ( $line, $vars ) = @_;

    while ( $line =~ /\$\{([-\w.]+)\}/ ) {
        if ( defined( ${$vars}{$1} ) ) {
            $line = $` . ${$vars}{$1} . $';
        }
        else {
            $line = $` . $magic_undefined . $';
        }
    }
    $line;
}

sub parse_eval_make_false($$) {
    my ( $line, $vars ) = @_;
    my ( $false, $test );

    $false = 0;
    $test = parse_expand_vars_dumb( $line, $vars );

    # XXX This is _so_ wrong - need to parse this correctly
    $test =~ s/""/\r/g;
    $test =~ s/"//g;      # "
    $test =~ s/\r/""/g;

    debug("conditional: $test\n");

    # XXX Could do something with target
    while ( $test =~ /(target|empty|make|defined|exists)\s*\(([^()]+)\)/ ) {
        my $testname = $1;
        my $varname  = $2;
        my $var;

        # Implement (some of) make's :M modifier
        if ( $varname =~ /^([^:]+):M(.+)$/ ) {
            $varname = $1;
            my $match = $2;

            $var = $${vars}{$varname};
            $var = parse_expand_vars( $var, $vars ) if defined $var;

            $match =~ s/([.+])/\\$1/g;
            $match =~ s/\*/.*/g;
            $match =~ s/\?/./g;
            $match = '^' . $match . '$';
            $var = ( $var =~ /$match/ ) if defined $var;
        }
        else {
            $var = $${vars}{$varname};
            $var = parse_expand_vars( $var, $vars ) if defined $var;
        }

        if ( defined $var && $var eq $magic_undefined ) {
            $var = undef;
        }

        if ( $testname eq 'exists' ) {
            $_ = ( -e $varname ) ? 1 : 0;

        }
        elsif ( $testname eq 'defined' ) {
            $_ = defined($var) ? 1 : 0;

        }
        elsif ( $testname eq 'empty' ) {
            $_ = ( ( not defined($var) or ( length($var) == 0 ) ) ? 1 : 0 );

        }
        else {
            $_ = 0;
        }

        $test =~ s/$testname\s*\([^()]+\)/$_/;
        debug("conditional: update to $test\n");
    }

    while ( $test =~ /([^\s()\|\&]+)\s+(!=|==)\s+([^\s()]+)/ ) {
        if ( $2 eq '==' ) {
            $_ = ( $1 eq $3 ) ? 1 : 0;
        }
        else {
            $_ = ( $1 ne $3 ) ? 1 : 0;
        }
        $test =~ s/[^\s()\|\&]+\s+(!=|==)\s+[^\s()]+/$_/;
    }

    if ( $test !~ /[^<>\d()\s&|.!]/ ) {
        $false = eval "($test)?0:1";
        if ( !defined $false ) {
            fail("Eval failed $line - $test");
        }
        debug( "conditional: evaluated to " . ( $false ? 0 : 1 ) . "\n" );

    }
    else {
        $false = 0;
        debug("conditional: defaulting to 0\n");
    }
    $false;
}

# chdir() || fail()
#
sub safe_chdir($) {
    my ($dir) = @_;

    debug("chdir: $dir");
    if ( !chdir($dir) ) {
        fail("Unable to chdir($dir): $!");
    }
}

# Generate pkgname->category/pkg mapping, optionally check DEPENDS
#
sub scan_pkgsrc_makefiles($$) {
    my ( $pkgsrcdir, $check_depends ) = @_;
    my (@categories);

    if ($pkglist) {

        # Already done
        return;
    }

    if ( $opt{I} ) {
        load_pkgsrc_makefiles( $opt{I} );
        return;
    }

    $pkglist    = new PkgList;
    @categories = list_pkgsrc_categories($pkgsrcdir);
    verbose('Scan Makefiles: ');

    if ( !$opt{L} ) {
        verbose( '_' x @categories . "\b" x @categories );
    }
    else {
        verbose("\n");
    }

    foreach my $cat ( sort @categories ) {
        foreach my $pkgdir ( list_pkgsrc_pkgdirs( $pkgsrcdir, $cat ) ) {
            my ( $pkg, $vars ) =
              parse_makefile_pkgsrc("$pkgsrcdir/$cat/$pkgdir/Makefile");
        }

        if ( !$opt{L} ) {
            verbose('.');
        }
    }

    if ( !$opt{L} ) {
        my ($len);

        $_   = $pkglist->numpkgver() . ' packages';
        $len = @categories - length($_);
        verbose( "\b" x @categories, $_, ' ' x $len, "\b" x $len, "\n" );
    }
}

# Cross reference all depends
#
sub pkgsrc_check_depends() {

    foreach my $pkgver ( $pkglist->pkgver ) {
        my ( $err, $msg );

        defined $pkgver->var('DEPENDS') || next;
        foreach my $depend ( split( " ", $pkgver->var('DEPENDS') ) ) {

            $depend =~ s/:.*// || next;

	    $depend = canonicalize_pkgname($depend);
            if ( ( $msg = invalid_version($depend) ) ) {
                if ( !defined($err) ) {
                    print $pkgver->pkgname . " DEPENDS errors:\n";
                }
                $err = 1;
                $msg =~ s/(\n)(.)/$1\t$2/g;
                print "\t$msg";
            }
        }
    }
}

# Extract all distinfo entries, then verify contents of distfiles
#
sub scan_pkgsrc_distfiles_vs_distinfo($$$$) {
    my ( $pkgsrcdir, $pkgdistdir, $check_unref, $check_distinfo ) = @_;
    my (@categories);
    my ( %distfiles, %sumfiles, @distwarn, $numpkg );
    my (%bad_distfiles);

    @categories = list_pkgsrc_categories($pkgsrcdir);

    verbose( 'Scan distinfo: ' . '_' x @categories . "\b" x @categories );
    $numpkg = 0;
    foreach my $cat ( sort @categories ) {
        foreach my $pkgdir ( list_pkgsrc_pkgdirs( $pkgsrcdir, $cat ) ) {
            if ( open( DISTINFO, "$pkgsrcdir/$cat/$pkgdir/distinfo" ) ) {
                ++$numpkg;
                while (<DISTINFO>) {
                    if (m/^(\w+) ?\(([^\)]+)\) = (\S+)/) {
                        my ( $dn, $ds, $dt );
                        $dt = $1;
                        $dn = $2;
                        $ds = $3;
                        if ( $dn =~ /^patch-[\w.\-]+$/ ) {
                            next;
                        }

                        # Strip leading ./ which sometimes gets added
                        # because of DISTSUBDIR=.
                        $dn =~ s/^(\.\/)*//;
                        if ( !defined $distfiles{$dn} ) {
                            $distfiles{$dn}{sumtype} = $dt;
                            $distfiles{$dn}{sum}     = $ds;
                            $distfiles{$dn}{path}    = "$cat/$pkgdir";

                        }
                        elsif ($distfiles{$dn}{sumtype} eq $dt
                            && $distfiles{$dn}{sum} ne $ds )
                        {
                            push( @distwarn,
                                    "checksum mismatch between '$dt' for '$dn' "
                                  . "in $cat/$pkgdir and $distfiles{$dn}{path}\n"
                            );
                        }
                    }
                }
                close(DISTINFO);
            }
        }
        verbose('.');
    }
    verbose(" ($numpkg packages)\n");

    # Do not mark the vulnerabilities file as unknown
    $distfiles{'pkg-vulnerabilities'} = {
        path => 'pkg-vulnerabilities',
        sum  => 'IGNORE'
    };

    foreach my $file ( listdir( "$pkgdistdir", undef ) ) {
        my ($dist);

        if ( !defined( $dist = $distfiles{$file} ) ) {
            $bad_distfiles{$file} = 1;

        }
        else {
            if ( $dist->{sum} ne 'IGNORE' ) {
                push( @{ $sumfiles{ $dist->{sumtype} } }, $file );
            }
        }
    }

    if ( $check_unref && %bad_distfiles ) {
        verbose( scalar( keys %bad_distfiles ),
            " unreferenced file(s) in '$pkgdistdir':\n" );
        print join( "\n", sort keys %bad_distfiles ), "\n";
    }

    if ($check_distinfo) {
        if (@distwarn) {
            verbose(@distwarn);
        }

        verbose("checksum mismatches\n");
        safe_chdir($pkgdistdir);
        foreach my $sum ( keys %sumfiles ) {
            if ( $sum eq 'Size' ) {
                foreach my $file ( @{ $sumfiles{$sum} } ) {
                    if ( !-f $file || -S $file != $distfiles{$file}{sum} ) {
                        print $file, " (Size)\n";
                        $bad_distfiles{$file} = 1;
                    }
                }
                next;
            }

            open( DIGEST, "digest $sum @{$sumfiles{$sum}}|" )
              || fail("Run digest: $!");
            while (<DIGEST>) {
                if (m/^$sum ?\(([^\)]+)\) = (\S+)/) {
                    if ( $distfiles{$1}{sum} ne $2 ) {
                        print $1, " ($sum)\n";
                        $bad_distfiles{$1} = 1;
                    }
                }
            }
            close(DIGEST);
        }
        safe_chdir('/');    # Do not want to stay in $pkgdistdir
    }
    ( sort keys %bad_distfiles );
}

sub load_pkgsrc_makefiles() {

    open( STORE, "<$_[0]" ) || die("Cannot read pkgsrc store from $_[0]: $!\n");
    my ($pkgver);
    our ( $pkgcnt, $pkgnum, $subpkgcnt, $subpkgnum );
    $pkglist = new PkgList;
    while (<STORE>) {
        eval $_;
    }
    close(STORE);
}

sub store_pkgsrc_makefiles() {
    open( STORE, ">$_[0]" ) || die("Cannot save pkgsrc store to $_[0]: $!\n");
    my $was = select(STORE);
    print(
        'sub __pkgcount { $subpkgnum += $_[0]; ',
        'verbose("\rReading pkgsrc database: ',
        '$pkgnum / $pkgcnt ($subpkgnum / $subpkgcnt) pkgs"); }',
        "\n"
    );
    $pkglist->store;
    print("verbose(\"...done\\n\");\n");
    select($was);
    close(STORE);
}

# Remember to update manual page when modifying option list
#
sub usage_and_exit() {
    print "Usage: lintpkgsrc [opts] [makefiles]
opts:
  -h : This help.	 [see lintpkgsrc(1) for more information]

Installed package options:		Distfile options:
  -i : Check version against pkgsrc	  -m : List distinfo mismatches
  -u : As -i + fetch dist (may change)	  -o : List obsolete (no distinfo)

Prebuilt package options:		Makefile options:
  -p : List old/obsolete		  -B : List packages marked as 'BROKEN'
  -O : List OSVERSION_SPECIFIC		  -d : Check 'DEPENDS' up to date
  -R : List NO_BIN_ON_FTP/RESTRICTED	  -S : List packages not in 'SUBDIRS'
  -V : List known vulnerabilities

Misc:
  -E file : Export the internal pkgsrc database to file
  -I file : Import the internal pkgsrc database to file (for use with -i)
  -g file : Generate 'pkgname pkgdir pkgver' map in file
  -r	  : Remove bad files (Without -m -o -p or -V implies all, can use -R)

Modifiers:
  -K path : Set PACKAGES basedir (default PKGSRCDIR/packages)
  -M path : Set DISTDIR		 (default PKGSRCDIR/distfiles)
  -P path : Set PKGSRCDIR	 (default $conf_pkgsrcdir)
  -D      : Debug makefile and glob parsing
  -L      : List each Makefile when scanned
";
    exit;
}

sub verbose(@) {

    if ( -t STDERR ) {
        print STDERR @_;
    }
}

sub debug(@) {

    ( $opt{D} ) && print STDERR 'DEBUG: ', @_;
}

# PkgList is the master list of all packages in pkgsrc.
#
package PkgList;

sub add($@) {
    my $self = shift;

    if ( !$self->pkgs( $_[0] ) ) {
        $self->{_pkgs}{ $_[0] } = new Pkgs $_[0];
    }
    $self->pkgs( $_[0] )->add(@_);
}

sub new($) {
    my $class = shift;
    my $self  = {};
    bless $self, $class;
    return $self;
}

sub numpkgver($) {
    my $self = shift;
    scalar( $self->pkgver );
}

sub pkgver($@) {
    my $self = shift;

    if ( @_ == 0 ) {
        my (@list);
        foreach my $pkg ( $self->pkgs ) {
            push( @list, $pkg->pkgver );
        }
        return (@list);
    }

    if ( defined $self->{_pkgs}{ $_[0] } ) {
        return ( @_ > 1 )
          ? $self->{_pkgs}{ $_[0] }->pkgver( $_[1] )
          : $self->{_pkgs}{ $_[0] }->pkgver();
    }
    return;
}

sub pkgs($@) {
    my $self = shift;

    if (@_) {
        return $self->{_pkgs}{ $_[0] };
    }
    else {
        return ( sort { $a->pkg cmp $b->pkg } values %{ $self->{_pkgs} } );
    }
    return;
}

sub store($) {
    my $self = shift;
    my @pkgs = keys %{ $self->{_pkgs} };
    my ( $cnt, $subcnt ) = $self->count;

    print("\$pkgcnt = $cnt;\n");
    print("\$subpkgcnt = $subcnt;\n");
    map( $self->{_pkgs}{$_}->store, keys %{ $self->{_pkgs} } );
}

sub count($) {
    my $self = shift;
    my ( $pkgcnt, $pkgsubcnt );

    map {
        $pkgcnt++;
        $pkgsubcnt += $self->{_pkgs}{$_}->count;
    } keys %{ $self->{_pkgs} };
    wantarray ? ( $pkgcnt, $pkgsubcnt ) : $pkgcnt;
}

# Pkgs is all versions of a given package (eg: apache-1.x and apache-2.x)
#
package Pkgs;

sub add($@) {
    my $self = shift;

    $self->{_pkgver}{ $_[1] } = new PkgVer @_;
}

sub new($@) {
    my $class = shift;
    my $self  = {};

    bless $self, $class;
    $self->{_pkg} = $_[0];
    return $self;
}

sub versions($) {
    my $self = shift;

    return sort { $b cmp $a } keys %{ $self->{_pkgver} };
}

sub pkg($) {
    my $self = shift;
    $self->{_pkg};
}

sub pkgver($@) {
    my $self = shift;

    if (@_) {
        if ( $self->{_pkgver}{ $_[0] } ) {
            return ( $self->{_pkgver}{ $_[0] } );
        }
        return;
    }
    return sort { $b->ver() cmp $a->ver() } values %{ $self->{_pkgver} };
}

sub latestver($) {
    my $self = shift;

    ( $self->pkgver() )[0];
}

sub store($) {
    my $self = shift;

    print("\$pkgnum++;\n");
    map( $self->{_pkgver}{$_}->store, keys %{ $self->{_pkgver} } );
}

sub count($) {
    my $self = shift;

    scalar( keys %{ $self->{_pkgver} } );
}

# PkgVer is a unique package+version
#
package PkgVer;

sub new($$$) {
    my $class = shift;
    my $self  = {};

    bless $self, $class;
    $self->{_pkg} = $_[0];
    $self->{_ver} = $_[1];
    return $self;
}

sub pkgname($) {
    my $self = shift;

    $self->pkg . '-' . $self->ver;
}

sub pkg($) {
    my $self = shift;

    $self->{_pkg};
}

sub var($$$) {
    my $self = shift;
    my ( $key, $val ) = @_;

    ( defined $val )
      ? ( $self->{$key} = $val )
      : $self->{$key};
}

sub ver($) {
    my $self = shift;

    $self->{_ver};
}

sub vars($) {
    my $self = shift;

    grep( !/^_(pkg|ver)$/, keys %{$self} );
}

sub store($) {
    my $self = shift;
    my $data;

    ( $data = $self->{_pkg} ) =~ s/([\\\$\@\%\"])/\\$1/g;
    print("\$pkgver = \$pkglist->add(\"$data\", \"");

    ( $data = $self->{_ver} ) =~ s/([\\\$\@\%\"])/\\$1/g;
    print("$data\"); __pkgcount(1);\n");

    foreach ( $self->vars ) {
        ( $data = $self->{$_} ) =~ s/([\\\$\@\%\"])/\\$1/g;
        print("\$pkgver->var(\"$_\", \"$data\");\n");
    }
}

package main;

main();