From cd6360a15cf42f01b0e4457b80f4c917e3f24fb2 Mon Sep 17 00:00:00 2001 From: rillig Date: Sat, 30 Jul 2022 08:18:31 +0000 Subject: lintpkgsrc: cleanup: sort subs from small to big This way, perl properly checks the sub prototypes. No functional change. --- pkgtools/lintpkgsrc/files/lintpkgsrc.pl | 1718 +++++++++++++++---------------- 1 file changed, 857 insertions(+), 861 deletions(-) (limited to 'pkgtools') diff --git a/pkgtools/lintpkgsrc/files/lintpkgsrc.pl b/pkgtools/lintpkgsrc/files/lintpkgsrc.pl index ea0165c46f7..4cc07aba351 100755 --- a/pkgtools/lintpkgsrc/files/lintpkgsrc.pl +++ b/pkgtools/lintpkgsrc/files/lintpkgsrc.pl @@ -1,6 +1,6 @@ #!@PERL5@ -# $NetBSD: lintpkgsrc.pl,v 1.27 2022/07/30 07:37:03 rillig Exp $ +# $NetBSD: lintpkgsrc.pl,v 1.28 2022/07/30 08:18:31 rillig Exp $ # Written by David Brownlee . # @@ -22,321 +22,250 @@ 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 $conf_sysconfdir = '@PKG_SYSCONFDIR@'; - -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 - @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 -); +# PkgList is the master list of all packages in pkgsrc. +# +package PkgList; -sub usage_and_exit(); -sub listdir($$); -sub get_default_makefile_vars(); -sub fail($); -sub parse_makefile_pkgsrc($); +sub add($@) { + my $self = shift; -# 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'; + if (!$self->pkgs($_[0])) { + $self->{_pkgs}{ $_[0] } = new Pkgs $_[0]; + } + $self->pkgs($_[0])->add(@_); +} -sub canonicalize_pkgname($) { - my ($pkgname) = @_; +sub new($) { + my $class = shift; + my $self = {}; + bless $self, $class; + return $self; +} - $pkgname =~ s,^py\d+(?:pth|)-,py-,; - $pkgname =~ s,^ruby\d+-,ruby-,; - $pkgname =~ s,^php\d+-,php-,; - return $pkgname; +sub numpkgver($) { + my $self = shift; + scalar($self->pkgver); } -# 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() { +sub pkgver($@) { + my $self = shift; - if ($_ eq 'distfiles' || $_ eq 'pkgsrc') { - # Skip these subdirs if present - $File::Find::prune = 1; + if (@_ == 0) { + my (@list); + foreach my $pkg ($self->pkgs) { + push(@list, $pkg->pkgver); + } + return (@list); + } - } elsif (/(.+)-(\d.*)\.t[bg]z$/) { - my ($pkg, $ver) = ($1, $2); + if (defined $self->{_pkgs}{$_[0]}) { + return (@_ > 1) + ? $self->{_pkgs}{$_[0]}->pkgver($_[1]) + : $self->{_pkgs}{$_[0]}->pkgver(); + } + return; +} - $pkg = canonicalize_pkgname($pkg); +sub pkgs($@) { + my $self = shift; - my ($pkgs); - if ($pkgs = $pkglist->pkgs($pkg)) { - my ($pkgver) = $pkgs->pkgver($ver); + if (@_) { + return $self->{_pkgs}{$_[0]}; + } else { + return (sort { $a->pkg cmp $b->pkg } values %{$self->{_pkgs}}); + } +} - if (!defined $pkgver) { - if ($opt{p}) { - print "$File::Find::dir/$_\n"; - push(@matched_prebuiltpackages, "$File::Find::dir/$_"); - } +sub store($) { + my $self = shift; + my @pkgs = keys %{$self->{_pkgs}}; + my ($cnt, $subcnt) = $self->count; - # Pick probably the last version - $pkgver = $pkgs->latestver; - } + print("\$pkgcnt = $cnt;\n"); + print("\$subpkgcnt = $subcnt;\n"); + map($self->{_pkgs}{$_}->store, keys %{$self->{_pkgs}}); +} - if ($opt{R} && $pkgver->var('RESTRICTED')) { - print "$File::Find::dir/$_\n"; - push(@matched_prebuiltpackages, "$File::Find::dir/$_"); - } +sub count($) { + my $self = shift; + my ($pkgcnt, $pkgsubcnt); - if ($opt{O} && $pkgver->var('OSVERSION_SPECIFIC')) { - print "$File::Find::dir/$_\n"; - push(@matched_prebuiltpackages, "$File::Find::dir/$_"); - } - } + map { + $pkgcnt++; + $pkgsubcnt += $self->{_pkgs}{$_}->count; + } keys %{$self->{_pkgs}}; + wantarray ? ($pkgcnt, $pkgsubcnt) : $pkgcnt; +} - } elsif (-d $_) { - if ($prebuilt_pkgdir_cache{"$File::Find::dir/$_"}) { - $File::Find::prune = 1; - return; - } +# Pkgs is all versions of a given package (eg: apache-1.x and apache-2.x) +# +package Pkgs; - $prebuilt_pkgdir_cache{"$File::Find::dir/$_"} = 1; - if (-l $_) { - my ($dest) = readlink($_); +sub add($@) { + my $self = shift; - if (substr($dest, 0, 1) ne '/') { - $dest = "$File::Find::dir/$dest"; - } - if (!$prebuilt_pkgdir_cache{$dest}) { - push(@prebuilt_pkgdirs, $dest); - } - } - } + $self->{_pkgver}{$_[1]} = new PkgVer @_; } -# Dewey decimal verson number matching - or thereabouts -# Also handles 'nb' 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 suffix - $match = $1; - $match_nb = $2; - } +sub new($@) { + my $class = shift; + my $self = {}; - if ($val =~ /(.*)nb(.*)/) { - # Handle nb suffix - $val = $1; - $val_nb = $2; - } + bless $self, $class; + $self->{_pkg} = $_[0]; + return $self; +} - $cmp = deweycmp_extract($match, $val); +sub versions($) { + my $self = shift; - if (!$cmp) { - # Iff otherwise identical, check nb suffix - $cmp = deweycmp_extract($match_nb, $val_nb); - } + return sort { $b cmp $a } keys %{$self->{_pkgver}}; +} - debug("eval deweycmp $cmp $test 0\n"); - eval "$cmp $test 0"; +sub pkg($) { + my $self = shift; + $self->{_pkg}; } -sub convert_to_standard_dewey(@) { - my ($elem, $underscore, @temp); +sub pkgver($@) { + my $self = shift; - # 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); + if (@_) { + if ($self->{_pkgver}{$_[0]}) { + return ($self->{_pkgver}{$_[0]}); } + return; } - @temp; + return sort { $b->ver() cmp $a->ver() } values %{$self->{_pkgver}}; } -sub deweycmp_extract($$) { - my ($match, $val) = @_; - my ($cmp, @matchlist, @vallist, $i, $len); +sub latestver($) { + my $self = shift; - @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; + ($self->pkgver())[0]; } -sub fail($) { +sub store($) { + my $self = shift; - print STDERR shift(), "\n"; - exit(3); + print("\$pkgnum++;\n"); + map($self->{_pkgver}{$_}->store, keys %{$self->{_pkgver}}); } -sub get_default_makefile_vars() { - - chomp($pkg_installver = `pkg_info -V 2>/dev/null || echo 20010302`); +sub count($) { + my $self = shift; - 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'); - } + scalar(keys %{$self->{_pkgver}}); +} - # Handle systems without uname -p (NetBSD pre 1.4) - chomp($default_vars->{MACHINE_ARCH} = `uname -p 2>/dev/null`); +# PkgVer is a unique package+version +# +package PkgVer; - if (!$default_vars->{MACHINE_ARCH} - && $default_vars->{OS_VERSION} eq 'NetBSD') { - chomp($default_vars->{MACHINE_ARCH} = `sysctl -n hw.machine_arch`); - } +sub new($$$) { + my $class = shift; + my $self = {}; - if (!$default_vars->{MACHINE_ARCH}) { - $default_vars->{MACHINE_ARCH} = $default_vars->{MACHINE}; - } + bless $self, $class; + $self->{_pkg} = $_[0]; + $self->{_ver} = $_[1]; + return $self; +} - $default_vars->{OBJECT_FMT} = 'x'; - $default_vars->{LOWER_OPSYS} = lc($default_vars->{OPSYS}); +sub pkgname($) { + my $self = shift; - if ($opt{P}) { - $default_vars->{PKGSRCDIR} = realpath($opt{P}); - } else { - $default_vars->{PKGSRCDIR} = $conf_pkgsrcdir; - } + $self->pkg . '-' . $self->ver; +} - $default_vars->{DESTDIR} = ''; - $default_vars->{LOCALBASE} = '/usr/pkg'; - $default_vars->{X11BASE} = '/usr/X11R6'; +sub pkg($) { + my $self = shift; - my ($vars); - if (-f '/etc/mk.conf' && ($vars = parse_makefile_vars('/etc/mk.conf', undef))) { - foreach my $var (keys %{$vars}) { - $default_vars->{$var} = $vars->{$var}; - } - } elsif (-f "$conf_sysconfdir/mk.conf" && - ($vars = parse_makefile_vars("$conf_sysconfdir/mk.conf", undef))) { - foreach my $var (keys %{$vars}) { - $default_vars->{$var} = $vars->{$var}; - } - } + $self->{_pkg}; +} - if ($opt{P}) { - $default_vars->{PKGSRCDIR} = realpath($opt{P}); - } +sub var($$$) { + my $self = shift; + my ($key, $val) = @_; - if ($opt{M}) { - $default_vars->{DISTDIR} = realpath($opt{M}); - } else { - $default_vars->{DISTDIR} ||= $default_vars->{PKGSRCDIR} . '/distfiles'; - } + (defined $val) + ? ($self->{$key} = $val) + : $self->{$key}; +} - if ($opt{K}) { - $default_vars->{PACKAGES} = realpath($opt{K}); - } +sub ver($) { + my $self = shift; - # 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}; - } - } + $self->{_ver}; +} - $default_vars->{PACKAGES} ||= $default_vars->{PKGSRCDIR} . '/packages'; +sub vars($) { + my $self = shift; + + grep(!/^_(pkg|ver)$/, keys %{$self}); } -# 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); +sub store($) { + my $self = shift; + my $data; - @todo = ($pkgmatch); + ($data = $self->{_pkg}) =~ s/([\\\$\@\%\"])/\\$1/g; + print("\$pkgver = \$pkglist->add(\"$data\", \""); - # 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); - } + ($data = $self->{_ver}) =~ s/([\\\$\@\%\"])/\\$1/g; + print("$data\"); __pkgcount(1);\n"); + + foreach ($self->vars) { + ($data = $self->{$_}) =~ s/([\\\$\@\%\"])/\\$1/g; + print("\$pkgver->var(\"$_\", \"$data\");\n"); } +} - foreach $pkgmatch (@pkgmatches) { - my ($pkg, $badver) = package_globmatch($pkgmatch); +package main; - if (defined($badver)) { - my ($pkgs); +# Buildtime configuration +my $conf_make = '@MAKE@'; +my $conf_pkgsrcdir = '@PKGSRCDIR@'; +my $conf_prefix = '@PREFIX@'; +my $conf_sysconfdir = '@PKG_SYSCONFDIR@'; - if ($pkgs = $pkglist->pkgs($pkg)) { - $fail .= - "Version mismatch: '$pkg' $badver vs " - . join(',', $pkgs->versions) . "\n"; - } else { - $fail .= "Unknown package: '$pkg' version $badver\n"; - } - } else { +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 + @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 +); - # If we find one match, don't bitch about others - $ok = 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'; + +sub debug(@) { + + ($opt{D}) && print STDERR 'DEBUG: ', @_; +} + +sub verbose(@) { + + if (-t STDERR) { + print STDERR @_; } - $ok && ($fail = undef); - $fail; +} + +sub fail($) { + + print STDERR shift(), "\n"; + exit(3); } # List (recursive) non directory contents of specified directory # #TODO this entire sub should be replaced with direct calls to # File::Find +sub listdir($$); sub listdir($$) { my ($base, $dir) = @_; my ($thisdir); @@ -363,321 +292,236 @@ sub listdir($$) { @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 = )) { - chomp($pkg); - push(@pkgs, canonicalize_pkgname($pkg)); - } - close(PKG_INFO); - - @pkgs; -} - -# List top level pkgsrc categories -# -sub list_pkgsrc_categories($) { - my ($pkgsrcdir) = @_; - my (@categories); +sub canonicalize_pkgname($) { + my ($pkgname) = @_; - opendir(BASE, $pkgsrcdir) || die("Unable to opendir($pkgsrcdir): $!"); - @categories = - grep(substr($_, 0, 1) ne '.' - && $_ ne 'CVS' - && -f "$pkgsrcdir/$_/Makefile", - readdir(BASE)); - closedir(BASE); - @categories; + $pkgname =~ s,^py\d+(?:pth|)-,py-,; + $pkgname =~ s,^ruby\d+-,ruby-,; + $pkgname =~ s,^php\d+-,php-,; + return $pkgname; } -# For a given category, list potentially valid pkgdirs -# -sub list_pkgsrc_pkgdirs($$) { - my ($pkgsrcdir, $cat) = @_; - my (@pkgdirs); +sub convert_to_standard_dewey(@) { + my ($elem, $underscore, @temp); - if (!opendir(CAT, "$pkgsrcdir/$cat")) { - die("Unable to opendir($pkgsrcdir/cat): $!"); + # 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); + } } - @pkgdirs = - sort grep($_ ne 'Makefile' - && $_ ne 'pkg' - && $_ ne 'CVS' - && substr($_, 0, 1) ne '.', - readdir(CAT)); - closedir(CAT); - @pkgdirs; + @temp; } -sub glob2regex($) { - my ($glob) = @_; - my (@chars, $in_alt); - my ($regex); +sub deweycmp_extract($$) { + my ($match, $val) = @_; + my ($cmp, @matchlist, @vallist, $i, $len); - @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 .= $_; + @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; +} - if ($in_alt) { - # Error - return undef; +# Dewey decimal version number matching - or thereabouts +# Also handles 'nb' 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 suffix + $match = $1; + $match_nb = $2; } - if ($regex eq $glob) { - return (''); + + if ($val =~ /(.*)nb(.*)/) { + # Handle nb suffix + $val = $1; + $val_nb = $2; } - if ($opt{D}) { - print "glob2regex: $glob -> $regex\n"; + + $cmp = deweycmp_extract($match, $val); + + if (!$cmp) { + # Iff otherwise identical, check nb suffix + $cmp = deweycmp_extract($match_nb, $val_nb); } - '^' . $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); + debug("eval deweycmp $cmp $test 0\n"); + eval "$cmp $test 0"; +} - if ($pkgmatch =~ /^([^*?[]+)(<|>|<=|>=|-)(\d[^*?[{]*)$/) { +sub parse_expand_vars_dumb($$) { + my ($line, $vars) = @_; - # (package)(cmp)(dewey) - my ($test, @pkgvers); + while ($line =~ /\$\{([-\w.]+)\}/) { + if (defined(${$vars}{$1})) { + $line = $` . ${$vars}{$1} . $'; + } else { + $line = $` . $magic_undefined . $'; + } + } + $line; +} - ($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; - } - } - } +sub parse_expand_vars($$) { + my ($line, $vars) = @_; - if ($matchver && $test ne '-') { - $matchver = "$test$matchver"; - } + while ($line =~ /\$\{([-\w.]+)\}/) { + if (defined(${$vars}{$1})) { + $line = $` . ${$vars}{$1} . $'; + } else { + $line = $` . $magic_undefined . $'; } + } + $line; +} - } elsif ($pkgmatch =~ /^([^[]+)-([\d*?{[].*)$/) { +sub parse_eval_make_false($$) { + my ($line, $vars) = @_; + my ($false, $test); - # (package)-(globver) - my (@pkgnames); + $false = 0; + $test = parse_expand_vars_dumb($line, $vars); - ($matchpkgname, $matchver) = ($1, $2); + # XXX This is _so_ wrong - need to parse this correctly + $test =~ s/""/\r/g; + $test =~ s/"//g; # " + $test =~ s/\r/""/g; - if (defined $pkglist->pkgs($matchpkgname)) { - push(@pkgnames, $matchpkgname); + debug("conditional: $test\n"); - } elsif ($regex = glob2regex($matchpkgname)) { - foreach my $pkg ($pkglist->pkgs) { - ($pkg->pkg() =~ /$regex/) && push(@pkgnames, $pkg->pkg()); - } + # 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; } - # Try to convert $matchver into regex version - # - $regex = glob2regex($matchver); + if (defined $var && $var eq $magic_undefined) { + $var = undef; + } - foreach my $pkg (@pkgnames) { - if (defined $pkglist->pkgver($pkg, $matchver)) { - return ($matchver); - } + if ($testname eq 'exists') { + $_ = (-e $varname) ? 1 : 0; - if ($regex) { - foreach my $ver ($pkglist->pkgs($pkg)->versions) { - if ($ver =~ /$regex/) { - $matchver = undef; - last; - } - } - } + } elsif ($testname eq 'defined') { + $_ = defined($var) ? 1 : 0; - $matchver || last; + } elsif ($testname eq 'empty') { + $_ = ((not defined($var) or (length($var) == 0)) ? 1 : 0); + + } else { + $_ = 0; } - # last ditch attempt to handle the whole DEPENDS as a glob - # - if ($matchver && ($regex = glob2regex($pkgmatch))) { + $test =~ s/$testname\s*\([^()]+\)/$_/; + debug("conditional: update to $test\n"); + } - # (large-glob) - foreach my $pkgver ($pkglist->pkgver) { - if ($pkgver->pkgname =~ /$regex/) { - $matchver = undef; - last; - } - } + 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&|.!]/) { + debug("eval test $test\n"); + $false = eval "($test)?0:1"; + if (!defined $false) { + fail("Eval failed $line - $test"); } + debug("conditional: evaluated to " . ($false ? 0 : 1) . "\n"); } else { - ($matchpkgname, $matchver) = ($pkgmatch, 'missing'); + $false = 0; + debug("conditional: defaulting to 0\n"); } - - ($matchpkgname, $matchver); + $false; } -# Parse a pkgsrc package makefile and return the pkgname and set variables +# Extract variable assignments from Makefile +# Much unpalatable magic to avoid having to use make (all for speed) # -sub parse_makefile_pkgsrc($) { - my ($file) = @_; - my ($pkgname, $vars); - - $vars = parse_makefile_vars($file, undef); - - if (!$vars) { +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 - # Missing Makefile - return undef; + if (!open(FILE, $file)) { + 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 =~ /\$/ || $pkgname !~ /(.*)-(\d.*)/) { - - # invoke make here as a last resort - my ($pkgsrcdir) = ($file =~ m:(/.*)/:); - debug("Running '$conf_make' in '$pkgsrcdir'\n"); - my $pid = open3(\*WTR, \*RDR, \*ERR, - "cd $pkgsrcdir || exit 1; $conf_make show-vars VARNAMES=PKGNAME"); - if (!$pid) { - warn "$file: Unable to run make: $!"; - } else { - close(WTR); - my @errors = ; - close(ERR); - my ($makepkgname) = ; - 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} =~ /^\$\{(_(CVS|GIT|HG|SVN)_PKGVERSION):.*\}$/) { - # See wip/mk/*-package.mk. - } elsif ($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; - $_; } ; - close(FILE); + @data = map { chomp; + $_; } ; + close(FILE); $incdirs{"."} = 1; - $incdirs{ dirname($file) } = 1; + $incdirs{dirname($file)} = 1; # Some Makefiles depend on these being set if ($file eq '/etc/mk.conf') { @@ -695,7 +539,7 @@ sub parse_makefile_vars($$) { $vars{'.CURDIR'} = getcwd; } - $incdirs{ $vars{'.CURDIR'} } = 1; + $incdirs{$vars{'.CURDIR'}} = 1; if ($opt{L}) { print "$file\n"; } @@ -876,176 +720,483 @@ sub parse_makefile_vars($$) { $vars{$key} = $_; $loop = 1; - } elsif ($vars{$key} =~ m#\$\{([\w.]+):([CS]([^{}])[^{}\3]+\3[^{}\3]*\3[g1]*(|:[^{}]+)|U[^{}]+)\}#) { - my ($left, $subvar, $right) = ($`, $1, $'); - my (@patterns) = split(':', $2); - my ($result); + } elsif ($vars{$key} =~ m#\$\{([\w.]+):([CS]([^{}])[^{}\3]+\3[^{}\3]*\3[g1]*(|:[^{}]+)|U[^{}]+)\}#) { + 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#(U)(.*)#) { + $result ||= $2; + } elsif (m#([CS])(.)([^/@]+)\2([^/@]*)\2([1g]*)#) { + 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"); + debug("eval substitute <$from> <$to> <$global>\n"); + eval "\$result =~ s/$from/$to/$global"; + if (defined $notfirst) { + $result .= " $notfirst"; + } + } else { + next; + } + } + + $vars{$key} = $left . $result . $right; + $loop = 1; + } + } + } + + foreach my $key (keys %vars) { + $vars{$key} =~ s/$magic_undefined//; + } + \%vars; +} + +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} = realpath($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', undef))) { + foreach my $var (keys %{$vars}) { + $default_vars->{$var} = $vars->{$var}; + } + } elsif (-f "$conf_sysconfdir/mk.conf" && + ($vars = parse_makefile_vars("$conf_sysconfdir/mk.conf", undef))) { + foreach my $var (keys %{$vars}) { + $default_vars->{$var} = $vars->{$var}; + } + } + + if ($opt{P}) { + $default_vars->{PKGSRCDIR} = realpath($opt{P}); + } + + if ($opt{M}) { + $default_vars->{DISTDIR} = realpath($opt{M}); + } else { + $default_vars->{DISTDIR} ||= $default_vars->{PKGSRCDIR} . '/distfiles'; + } + + if ($opt{K}) { + $default_vars->{PACKAGES} = realpath($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; +} + +# 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 = )) { + 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)); + closedir(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*?{[].*)$/) { - $result = $vars{$subvar}; - $result ||= ''; + # (package)-(globver) + my (@pkgnames); - # 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; - } + ($matchpkgname, $matchver) = ($1, $2); - debug("$file: substitutelist $key ($result) $subvar (@patterns)\n"); - foreach (@patterns) { - if (m#(U)(.*)#) { - $result ||= $2; - } elsif (m#([CS])(.)([^/@]+)\2([^/@]*)\2([1g]*)#) { - my ($how, $from, $to, $global) = ($1, $3, $4, $5); + if (defined $pkglist->pkgs($matchpkgname)) { + push(@pkgnames, $matchpkgname); - 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 + } elsif ($regex = glob2regex($matchpkgname)) { + foreach my $pkg ($pkglist->pkgs) { + ($pkg->pkg() =~ /$regex/) && push(@pkgnames, $pkg->pkg()); + } + } - my ($notfirst); - if ($global =~ s/1//) { - ($from, $notfirst) = split('\s', $from, 2); - } + # Try to convert $matchver into regex version + # + $regex = glob2regex($matchver); - debug("$file: substituteperl $subvar, $how, $from, $to\n"); - debug("eval substitute <$from> <$to> <$global>\n"); - eval "\$result =~ s/$from/$to/$global"; - if (defined $notfirst) { - $result .= " $notfirst"; - } - } else { - next; + 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; } } + } - $vars{$key} = $left . $result . $right; - $loop = 1; + $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; + } } } - } - foreach my $key (keys %vars) { - $vars{$key} =~ s/$magic_undefined//; + } else { + ($matchpkgname, $matchver) = ($pkgmatch, 'missing'); } - \%vars; + + ($matchpkgname, $matchver); } -sub parse_expand_vars($$) { - my ($line, $vars) = @_; +# Parse a pkgsrc package makefile and return the pkgname and set variables +# +sub parse_makefile_pkgsrc($) { + my ($file) = @_; + my ($pkgname, $vars); - while ($line =~ /\$\{([-\w.]+)\}/) { - if (defined(${$vars}{$1})) { - $line = $` . ${$vars}{$1} . $'; - } else { - $line = $` . $magic_undefined . $'; - } - } - $line; -} + $vars = parse_makefile_vars($file, undef); -sub parse_expand_vars_dumb($$) { - my ($line, $vars) = @_; + if (!$vars) { - while ($line =~ /\$\{([-\w.]+)\}/) { - if (defined(${$vars}{$1})) { - $line = $` . ${$vars}{$1} . $'; - } else { - $line = $` . $magic_undefined . $'; - } + # Missing Makefile + return undef; } - $line; -} -sub parse_eval_make_false($$) { - my ($line, $vars) = @_; - my ($false, $test); + if (defined $vars->{PKGNAME}) { + $pkgname = $vars->{PKGNAME}; + } elsif (defined $vars->{DISTNAME}) { + $pkgname = $vars->{DISTNAME}; + } - $false = 0; - $test = parse_expand_vars_dumb($line, $vars); + if (defined $vars->{PKGNAME}) { + debug("$file: PKGNAME=$vars->{PKGNAME}\n"); + } + if (defined $vars->{DISTNAME}) { + debug("$file: DISTNAME=$vars->{DISTNAME}\n"); + } - # XXX This is _so_ wrong - need to parse this correctly - $test =~ s/""/\r/g; - $test =~ s/"//g; # " - $test =~ s/\r/""/g; + if (!defined $pkgname || $pkgname =~ /\$/ || $pkgname !~ /(.*)-(\d.*)/) { - debug("conditional: $test\n"); + # invoke make here as a last resort + my ($pkgsrcdir) = ($file =~ m:(/.*)/:); + debug("Running '$conf_make' in '$pkgsrcdir'\n"); + my $pid = open3(\*WTR, \*RDR, \*ERR, + "cd $pkgsrcdir || exit 1; $conf_make show-vars VARNAMES=PKGNAME"); + if (!$pid) { + warn "$file: Unable to run make: $!"; + } else { + close(WTR); + my @errors = ; + close(ERR); + my ($makepkgname) = ; + close(RDR); + wait; + chomp @errors; + if (@errors) { warn "\n$file: @errors\n"; } - # XXX Could do something with target - while ($test =~ /(target|empty|make|defined|exists)\s*\(([^()]+)\)/) { - my $testname = $1; - my $varname = $2; - my $var; + if ($makepkgname =~ /(.*)-(\d.*)/) { + $pkgname = $makepkgname; + } + } + } - # Implement (some of) make's :M modifier - if ($varname =~ /^([^:]+):M(.+)$/) { - $varname = $1; - my $match = $2; + if (defined $pkgname) { + if ($pkgname =~ /^pkg_install-(\d+)$/ && $1 < $pkg_installver) { + $pkgname = "pkg_install-$pkg_installver"; + } - $var = $${vars}{$varname}; - $var = parse_expand_vars($var, $vars) - if defined $var; + $pkgname = canonicalize_pkgname($pkgname); - $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 $vars->{PKGREVISION} + and not $vars->{PKGREVISION} =~ /^\s*$/) { + if ($vars->{PKGREVISION} =~ /^\$\{(_(CVS|GIT|HG|SVN)_PKGVERSION):.*\}$/) { + # See wip/mk/*-package.mk. + } elsif ($vars->{PKGREVISION} =~ /\D/) { + print "\nBogus: PKGREVISION $vars->{PKGREVISION} (from $file)\n"; - if (defined $var && $var eq $magic_undefined) { - $var = undef; + } elsif ($vars->{PKGREVISION}) { + $pkgname .= "nb"; + $pkgname .= $vars->{PKGREVISION}; + } } - if ($testname eq 'exists') { - $_ = (-e $varname) ? 1 : 0; + if ($pkgname =~ /\$/) { + print "\nBogus: $pkgname (from $file)\n"; - } elsif ($testname eq 'defined') { - $_ = defined($var) ? 1 : 0; + } elsif ($pkgname =~ /(.*)-(\d.*)/) { + if ($pkglist) { + my ($pkgver) = $pkglist->add($1, $2); - } elsif ($testname eq 'empty') { - $_ = ((not defined($var) or (length($var) == 0)) ? 1 : 0); + debug("add $1 $2\n"); - } else { - $_ = 0; - } + foreach my $var (qw(DEPENDS RESTRICTED OSVERSION_SPECIFIC BROKEN)) { + $pkgver->var($var, $vars->{$var}); + } - $test =~ s/$testname\s*\([^()]+\)/$_/; - debug("conditional: update to $test\n"); - } + if (defined $vars->{NO_BIN_ON_FTP}) { + $pkgver->var('RESTRICTED', 'NO_BIN_ON_FTP'); + } - while ($test =~ /([^\s()\|\&]+)\s+(!=|==)\s+([^\s()]+)/) { - if ($2 eq '==') { - $_ = ($1 eq $3) ? 1 : 0; + if ($file =~ m:([^/]+/[^/]+)/Makefile$:) { + $pkgver->var('dir', $1); + } else { + $pkgver->var('dir', 'unknown'); + } + } } else { - $_ = ($1 ne $3) ? 1 : 0; + print "Cannot extract $pkgname version ($file)\n"; } - $test =~ s/[^\s()\|\&]+\s+(!=|==)\s+[^\s()]+/$_/; - } - if ($test !~ /[^<>\d()\s&|.!]/) { - debug("eval test $test\n"); - $false = eval "($test)?0:1"; - if (!defined $false) { - fail("Eval failed $line - $test"); - } - debug("conditional: evaluated to " . ($false ? 0 : 1) . "\n"); + return ($pkgname, $vars); } else { - $false = 0; - debug("conditional: defaulting to 0\n"); + return (undef); } - $false; } + # chdir() || fail() # sub safe_chdir($) { @@ -1057,6 +1208,19 @@ sub safe_chdir($) { } } +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 () { + debug("eval store $_"); + eval $_; + } + close(STORE); +} + # Generate pkgname->category/pkg mapping, optionally check DEPENDS # sub scan_pkgsrc_makefiles($) { @@ -1192,7 +1356,7 @@ sub scan_pkgsrc_distfiles_vs_distinfo($$$$) { push(@{$sumfiles{ $dist->{sumtype} }}, $distn); } } - } }, + } }, ($pkgdistdir)); if ($check_unref && %bad_distfiles) { @@ -1246,19 +1410,6 @@ sub scan_pkgsrc_distfiles_vs_distinfo($$$$) { (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 () { - debug("eval store $_"); - eval $_; - } - close(STORE); -} - sub store_pkgsrc_makefiles($) { open(STORE, ">$_[0]") || die("Cannot save pkgsrc store to $_[0]: $!\n"); my $was = select(STORE); @@ -1308,219 +1459,64 @@ Modifiers: exit; } -sub verbose(@) { - - if (-t STDERR) { - print STDERR @_; - } -} - -sub debug(@) { +# 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() { - ($opt{D}) && print STDERR 'DEBUG: ', @_; -} + if ($_ eq 'distfiles' || $_ eq 'pkgsrc') { + # Skip these subdirs if present + $File::Find::prune = 1; -# PkgList is the master list of all packages in pkgsrc. -# -package PkgList; + } elsif (/(.+)-(\d.*)\.t[bg]z$/) { + my ($pkg, $ver) = ($1, $2); -sub add($@) { - my $self = shift; + $pkg = canonicalize_pkgname($pkg); - if (!$self->pkgs($_[0])) { - $self->{_pkgs}{ $_[0] } = new Pkgs $_[0]; - } - $self->pkgs($_[0])->add(@_); -} + my ($pkgs); + if ($pkgs = $pkglist->pkgs($pkg)) { + my ($pkgver) = $pkgs->pkgver($ver); -sub new($) { - my $class = shift; - my $self = {}; - bless $self, $class; - return $self; -} + if (!defined $pkgver) { + if ($opt{p}) { + print "$File::Find::dir/$_\n"; + push(@matched_prebuiltpackages, "$File::Find::dir/$_"); + } -sub numpkgver($) { - my $self = shift; - scalar($self->pkgver); -} + # Pick probably the last version + $pkgver = $pkgs->latestver; + } -sub pkgver($@) { - my $self = shift; + if ($opt{R} && $pkgver->var('RESTRICTED')) { + print "$File::Find::dir/$_\n"; + push(@matched_prebuiltpackages, "$File::Find::dir/$_"); + } - if (@_ == 0) { - my (@list); - foreach my $pkg ($self->pkgs) { - push(@list, $pkg->pkgver); + if ($opt{O} && $pkgver->var('OSVERSION_SPECIFIC')) { + print "$File::Find::dir/$_\n"; + push(@matched_prebuiltpackages, "$File::Find::dir/$_"); + } } - 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}}); - } -} - -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]}); + } elsif (-d $_) { + if ($prebuilt_pkgdir_cache{"$File::Find::dir/$_"}) { + $File::Find::prune = 1; + return; } - 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"); + $prebuilt_pkgdir_cache{"$File::Find::dir/$_"} = 1; + if (-l $_) { + my ($dest) = readlink($_); - foreach ($self->vars) { - ($data = $self->{$_}) =~ s/([\\\$\@\%\"])/\\$1/g; - print("\$pkgver->var(\"$_\", \"$data\");\n"); + if (substr($dest, 0, 1) ne '/') { + $dest = "$File::Find::dir/$dest"; + } + if (!$prebuilt_pkgdir_cache{$dest}) { + push(@prebuilt_pkgdirs, $dest); + } + } } } -package main; - sub main() { $ENV{PATH} .= -- cgit v1.2.3