OpenPKG CVS Repository http://cvs.openpkg.org/ ____________________________________________________________________________
Server: cvs.openpkg.org Name: Ralf S. Engelschall Root: /v/openpkg/cvs Email: [EMAIL PROTECTED] Module: openpkg-tools Date: 08-Nov-2006 14:12:23 Branch: HEAD Handle: 2006110813122300 Modified files: openpkg-tools/cmd build.pl Log: use the more explicit match style Summary: Revision Changes Path 1.39 +45 -45 openpkg-tools/cmd/build.pl ____________________________________________________________________________ patch -p0 <<'@@ .' Index: openpkg-tools/cmd/build.pl ============================================================================ $ cvs diff -u -r1.38 -r1.39 build.pl --- openpkg-tools/cmd/build.pl 12 Oct 2006 15:55:38 -0000 1.38 +++ openpkg-tools/cmd/build.pl 8 Nov 2006 13:12:23 -0000 1.39 @@ -168,7 +168,7 @@ # determine RPM package repository information if (defined $opt_r) { $url = $opt_r; - $url .= '/' unless $url =~ /\/$/; + $url .= '/' unless $url =~ m/\/$/; } else { $url = rpm_release_url(); } @@ -293,7 +293,7 @@ # home-brewn getopt(3) style option parser sub getopts ($) { my ($opts) = @_; - my (%optf) = map { /(\w)/; $1 => $_ } $opts =~ /(\w:|\w)/g; + my (%optf) = map { m/(\w)/; $1 => $_ } $opts =~ m/(\w:|\w)/g; my (%opts, @argv, $optarg); foreach (@ARGV) { @@ -390,7 +390,7 @@ # expand RPM rc information about tools $c = run("$rpm --showrc"); - my @g = ($c =~ /\%\{l_tool_locate\s+([^\s\}]+)/g); + my @g = ($c =~ m/\%\{l_tool_locate\s+([^\s\}]+)/g); # return accumulated information return { @@ -418,10 +418,10 @@ # guess the release URL the older way if ($url !~ m/^(?:file|ftp|https?):\/\//) { - ($rel) = run($config->{"rpm"} . " -qi openpkg") =~ /Version:\s*(\S+)/m; - if ($rel =~ /^\d+$/) { + ($rel) = run($config->{"rpm"} . " -qi openpkg") =~ m/Version:\s*(\S+)/m; + if ($rel =~ m/^\d+$/) { $url = "ftp://ftp.openpkg.org/current/"; - } elsif ($rel =~ /^(\d+\.\d+)/) { + } elsif ($rel =~ m/^(\d+\.\d+)/) { $rel = $1; $url = "ftp://ftp.openpkg.org/release/$rel/"; } else { @@ -454,11 +454,11 @@ # compare as long as components exist while (@a && @b) { - if ($a[0] =~ /^\d+$/ && $b[0] =~ /^\d+$/) { + if ($a[0] =~ m/^\d+$/ && $b[0] =~ m/^\d+$/) { # numerical comparison $c = $a[0] <=> $b[0]; - } elsif ((($a, $ax) = $a[0] =~ /^(\d+)(.*)$/) && - (($b, $bx) = $b[0] =~ /^(\d+)(.*)$/)) { + } elsif ((($a, $ax) = $a[0] =~ m/^(\d+)(.*)$/) && + (($b, $bx) = $b[0] =~ m/^(\d+)(.*)$/)) { # numerical comparison for prefix, # string comparison for remainder $c = $a <=> $b; @@ -507,8 +507,8 @@ return 0 if ($a eq $b); # split into "version" and "release" - my ($av, $ar) = ($a =~ /^(.*?)(?:\-([\d\.]+))?$/); - my ($bv, $br) = ($b =~ /^(.*?)(?:\-([\d\.]+))?$/); + my ($av, $ar) = ($a =~ m/^(.*?)(?:\-([\d\.]+))?$/); + my ($bv, $br) = ($b =~ m/^(.*?)(?:\-([\d\.]+))?$/); # compare "release" if (defined($ar) and defined($br)) { @@ -558,14 +558,14 @@ my ($s) = @_; my ($nam, $val, $pre, $with, $pxy, $ver, $rel); - ($nam, $val) = ($s =~ /^([^\s\(]+(?:\([^\)]*\))?)\s*(?:=\s*(\S*?))?$/); - if (($pre, $with) = ($nam =~ /^(\S+?)::(\S*)$/)) { + ($nam, $val) = ($s =~ m/^([^\s\(]+(?:\([^\)]*\))?)\s*(?:=\s*(\S*?))?$/); + if (($pre, $with) = ($nam =~ m/^(\S+?)::(\S*)$/)) { # build option $val =~ s/(?:\%([0-9a-fA-F][0-9a-fA-F]))/chr(hex($1))/eg; # hex decode ($ver, $rel, $pxy) = ($val, undef, undef); } else { # virtual or real package - ($ver, $rel, $pxy) = ($val =~ /^([^\s\-]+)-([^\s\+]+)(\+PROXY)?$/); + ($ver, $rel, $pxy) = ($val =~ m/^([^\s\-]+)-([^\s\+]+)(\+PROXY)?$/); } # return accumulated information @@ -598,8 +598,8 @@ my ($dep) = @_; my ($ver, $rel, $pxy, $pre, $with); - ($ver, $rel, $pxy) = ($dep->{val} =~ /^([^\s\-]+)-([^\s\+]+)(\+PROXY)?$/); - ($pre, $with) = ($dep->{name} =~ /^(\S+?)::(\S*)$/); + ($ver, $rel, $pxy) = ($dep->{val} =~ m/^([^\s\-]+)-([^\s\+]+)(\+PROXY)?$/); + ($pre, $with) = ($dep->{name} =~ m/^(\S+?)::(\S*)$/); return { name => $dep->{name}, @@ -635,10 +635,10 @@ if (defined($op)) { $val = $dep->{$op}; } - } elsif ($dep =~ /\S/) { + } elsif ($dep =~ m/\S/) { # dependency from old index stored as text string # "name operator operand" or "name" - ($name, $op, $val) = ($dep =~ /(\S+)\s*(?:(\S+)\s*(\S+))?\s*$/); + ($name, $op, $val) = ($dep =~ m/(\S+)\s*(?:(\S+)\s*(\S+))?\s*$/); if (defined($op)) { $op = { '==' => 'equ', '=' => 'equ', @@ -735,7 +735,7 @@ $p = parse_provides($_) or next; # short-circuit processing for RPM special case - next if ($p->{name} =~ /^gpg\(/); + next if ($p->{name} =~ m/^gpg\(/); # is this an option? if (defined($p->{with})) { @@ -798,13 +798,13 @@ @l = run($config->{"rpm"} . " --qf '%{NAME} %{VERSION} %{RELEASE}[ .%{REQUIRENAME} .%{REQUIREFLAGS:depflags} .%{REQUIREVERSION}]\\n' -qa"); @list = (); foreach (@l) { - ($name, $version, $release, $req) = /^(\S+)\s+(\S+)\s+(\S+)\s*(.*?)\s*$/; + ($name, $version, $release, $req) = m/^(\S+)\s+(\S+)\s+(\S+)\s*(.*?)\s*$/; next if ($name eq 'gpg-pubkey'); $release =~ s/\+PROXY$//; # for each requirement triple... - while ($req =~ /\.(\S+)\s+\.(\S*)\s+\.(\S*)/g) { + while ($req =~ m/\.(\S+)\s+\.(\S*)\s+\.(\S*)/g) { $p = parse_depends("$1 $2 $3"); - next if ($p->{name} =~ /^(rpmlib|gpg)\(/); + next if ($p->{name} =~ m/^(rpmlib|gpg)\(/); $vs = vs({ version => $version, release => $release }); $p = { cond => '', value => $p }; foreach $rec (@{$map{$name}->{$vs}}) { @@ -838,16 +838,16 @@ # determine command/path to fetch/open index $bzip2 = $config->{"bzip2"}; $fetch = defined($fn) ? $fn : $url; - $fetch !~ /\.bz2$/ || -x $bzip2 + $fetch !~ m/\.bz2$/ || -x $bzip2 or die "openpkg:build:FATAL: $bzip2 not found\n"; - if ($fetch =~ /^\w+:/) { + if ($fetch =~ m/^\w+:/) { # looks like URL scheme print "# fetching XML/RDF index from URL $fetch\n"; $path = $config->{"curl"} . " -s -o - \"$fetch\" |"; - $path .= "$bzip2 -dc |" if ($fetch =~ /\.bz2$/); + $path .= "$bzip2 -dc |" if ($fetch =~ m/\.bz2$/); } else { - print "# reading XML/RDF index from file $fn\n"; - if ($fetch =~ /\.bz2$/) { + print "# reading XML/RDF index from file $fetch\n"; + if ($fetch =~ m/\.bz2$/) { $path = "$bzip2 -dc $fetch |"; } else { $path = "<$fetch"; @@ -926,9 +926,9 @@ my ($url, $fn, $suburl) = @_; my ($subfn); - if ($suburl =~ /^\w+:\/\//) { + if ($suburl =~ m/^\w+:\/\//) { # NOP - } elsif ($suburl =~ /^\//) { + } elsif ($suburl =~ m/^\//) { $subfn = $suburl; } else { if (defined($fn)) { @@ -1296,7 +1296,7 @@ sub goodpf ($$) { my ($l, $p) = @_; return 1 if $l eq ''; - return $l =~ /(?:^|\s)\Q$p\E(?:\s|$)/; + return ($l =~ m/(?:^|\s)\Q$p\E(?:\s|$)/); } @@ -1448,7 +1448,7 @@ my ($k); foreach $k (keys(%$new)) { - if ((exists($old->{$k}) && $old->{$k} ne $new->{$k}) || $k =~ /^$reg$/) { + if ((exists($old->{$k}) && $old->{$k} ne $new->{$k}) || $k =~ m/^$reg$/) { $old->{$k} = $new->{$k}; } } @@ -1462,11 +1462,11 @@ if ($global) { push(@keys, grep { !/::/ } keys %$with); } - push(@keys, grep { /::/ } keys %$with); + push(@keys, grep { m/::/ } keys %$with); return { map { my ($k) = $_; - $k !~ /::/ || $k =~ s/^\Q$name\E::// + $k !~ m/::/ || $k =~ s/^\Q$name\E::// ? ( $k => $with->{$_} ) : ( ) } @keys @@ -1706,7 +1706,7 @@ # limit list to exact matches if provided by "-e" if (defined($select)) { @recs = grep { - vsn($_) =~ /^\Q$select\E/ + vsn($_) =~ m/^\Q$select\E/ } @recs; } @@ -1767,7 +1767,7 @@ } @recs; unless (@nrecs) { @nrecs = grep { - $_->{href} !~ /\.nosrc.rpm$/ + $_->{href} !~ m/\.nosrc.rpm$/ } @recs; } @recs = @nrecs if (@nrecs); @@ -1993,7 +1993,7 @@ return if (not defined($iwith)); $with = name_with($target->{name}, $with); while (($k,$v) = each %$with) { - if (not ($k =~ /^$c->{optreg}$/ || exists $iwith->{$k})) { + if (not ($k =~ m/^$c->{optreg}$/ || exists $iwith->{$k})) { print "# ATTENTION: $target->{name} ignores option '$k'\n"; } } @@ -2292,7 +2292,7 @@ my ($w,$s) = @_; if (!defined($w)) { return $s; - } elsif ($w =~ /^-(.*)/) { + } elsif ($w =~ m/^-(.*)/) { return "$1 \"$s\""; } else { return "$w $s"; @@ -2350,14 +2350,14 @@ # augment map with additional information # about conflicting and binary only (temporary) packages foreach (@$list, @$clist) { - next if (not $_->{release} =~ /\S/); + next if (not $_->{release} =~ m/\S/); $map{$_->{name}} = { rel => "$_->{version}-$_->{release}", status => $_->{STATUS} }; } foreach (@$bonly) { - next if (not $_->{release} =~ /\S/); + next if (not $_->{release} =~ m/\S/); $map{$_->{name}} = { rel => "$_->{version}-$_->{release}", status => 'TEMP' @@ -2368,14 +2368,14 @@ # about up-to-date and new packages @names = keys(%map); foreach $n (keys(%$installed)) { - next if ($n =~ /::/); + next if ($n =~ m/::/); next if (exists($map{$n})); next if (not (grep { $_ ne '' } keys(%{$installed->{$n}}))); $map{$n}->{'status'} = 'OK'; push(@names, $n); } foreach $n (keys(%$repository)) { - next if ($n =~ /::/); + next if ($n =~ m/::/); next if (exists($map{$n})); next if (not (grep { $_ ne '' } keys(%{$repository->{$n}}))); $t = find_target($n, $repository, 0); @@ -2435,8 +2435,8 @@ $with = join(' ', map { "--define '$_ $old->{$_}'" } sort grep { - $old->{$_} =~ /\S/ && - $old->{$_} !~ /^%/ && + $old->{$_} =~ m/\S/ && + $old->{$_} !~ m/^%/ && $old->{$_} ne $def->{$_} } keys %$old ); @@ -2462,7 +2462,7 @@ sub find_proxy ($$) { my ($t, $bpkg) = @_; my (@l) = run($config->{"rpm"} . " -ql $t->{name}"); - my ($link) = (grep { $_ =~ /\/\.prefix-$t->{name}$/ } @l)[0]; + my ($link) = (grep { $_ =~ m/\/\.prefix-$t->{name}$/ } @l)[0]; return if (not defined($link)); chomp $link; my ($prefix) = readlink($link); @@ -2490,7 +2490,7 @@ foreach (@$list) { $pkg = $_->{name}; $spkg = $_->{href}; - unless ($spkg =~ /\S/) { + unless ($spkg =~ m/\S/) { die "openpkg:build:FATAL: internal error, ",vsn($_)," without source URL\n"; } $bpkg = target2rpm($_, $c); @@ . ______________________________________________________________________ The OpenPKG Project www.openpkg.org CVS Repository Commit List openpkg-cvs@openpkg.org