pre-load some data structures for dependency lookups
This commit is contained in:
parent
deaa06e52c
commit
54e485e20b
@ -26,8 +26,9 @@ $SIG{QUIT} = \&trap; $SIG{TERM} = \&trap;
|
||||
# Global vars
|
||||
my @repos = (); # package repositories
|
||||
my @donetasks; my @failtasks; my @prevtasks; my %pptasks; my %readmetasks;
|
||||
my $curraction = ""; my %deps; my @dependencies; my %missingdeps;
|
||||
my %locked; my %installed;
|
||||
my $curraction = ""; my %depmap; my %locked; my %checksumsize;
|
||||
my %fullpath; my %remote; my %prepostread; my %description;
|
||||
my %instver; my %repver; my %shortstatus;
|
||||
|
||||
# CL Options
|
||||
my $download_only; my $pre_install; my $post_install; my $root="";
|
||||
@ -72,10 +73,10 @@ SWITCH: {
|
||||
if ($command =~ /^(isinst|current)$/) { current(); last SWITCH; }
|
||||
if ($command =~ /^(diff|quickdiff|sysup)$/) { diff($1); last SWITCH; }
|
||||
if ($command eq "dup") { dup(); last SWITCH; }
|
||||
if ($command =~ /^(depends|quickdep)$/) { depends($1); last SWITCH; }
|
||||
if ($command =~ /^(install|update)$/) { upinst(@ARGV); last SWITCH; }
|
||||
if ($command eq "dependent") { dependent(); last SWITCH; }
|
||||
if ($command eq "depinst") { depinst(); last SWITCH; }
|
||||
if ($command =~ /^(depends|quickdep)$/) { load_depmap(); depends($1); last SWITCH; }
|
||||
if ($command eq "depinst") { load_depmap(); depinst(); last SWITCH; }
|
||||
}
|
||||
|
||||
############################################################################
|
||||
@ -139,6 +140,17 @@ sub readconfig {
|
||||
close(CFG);
|
||||
}
|
||||
|
||||
# Populate a hash of installed packages
|
||||
sub getinstalled {
|
||||
local $/ = ""; # read files paragraph-wise; see ``perldoc perlvar''
|
||||
open(DB, $PKGDB) or exiterr("could not open ".$PKGDB);
|
||||
while (<DB>) {
|
||||
my ($name, $version, @files) = split /\n/, $_;
|
||||
$instver{$name} = $version;
|
||||
}
|
||||
close(DB);
|
||||
}
|
||||
|
||||
# Populate a hash of locked packages
|
||||
sub get_locked {
|
||||
open (my $fL, $LOCKFILE) or return;
|
||||
@ -146,6 +158,40 @@ sub get_locked {
|
||||
close ($fL);
|
||||
}
|
||||
|
||||
# Populate hashes for the available packages
|
||||
# (requires a previous run of getinstalled)
|
||||
sub load_repos {
|
||||
(%instver) or ($command eq "list") or getinstalled();
|
||||
foreach my $repo(@repos) {
|
||||
my ($dir, $url) = split(/\|/, $repo);
|
||||
open(REPO, "$dir/PKGREPO") or exiterr("could not open $dir/PKGREPO");
|
||||
while (<REPO>) {
|
||||
chomp;
|
||||
my ($filename,$du,$checksum,$desc,$pre,$post,$read)=split(/:/,$_);
|
||||
my $pkgname = $filename;
|
||||
$pkgname =~ s/#.*//;
|
||||
next if ($repver{$pkgname}); # only consider the first matching entry
|
||||
$repver{$pkgname} = $1 if ($filename =~ m/.*#(.*)\.pkg\.tar\./);
|
||||
|
||||
# no need to populate the remaining hashes if the user only asked for a list
|
||||
next if ($command eq "list");
|
||||
$remote{$pkgname} = ($url) ? $url : "";
|
||||
$fullpath{$pkgname} = "$dir/$filename";
|
||||
$checksumsize{$pkgname} = "$du:$checksum";
|
||||
($command ne "info") or $description{$pkgname} = $desc;
|
||||
$prepostread{$pkgname} = "$pre:$post:$read";
|
||||
if (! $instver{$pkgname}) {
|
||||
$shortstatus{$pkgname} = "[ ]";
|
||||
} elsif ($instver{$pkgname} eq $repver{$pkgname}) {
|
||||
$shortstatus{$pkgname} = "[i]";
|
||||
} else {
|
||||
$shortstatus{$pkgname} = "[u]";
|
||||
}
|
||||
}
|
||||
close (REPO);
|
||||
}
|
||||
}
|
||||
|
||||
# Parse a line describing a package
|
||||
sub parsepackage {
|
||||
my $type=shift; my @p = split(/\:/, $_[0]);
|
||||
@ -171,55 +217,43 @@ sub parsepackage {
|
||||
|
||||
# Print info about the given package
|
||||
sub printinfo {
|
||||
my %pkg = @_;
|
||||
print "Name : " . $pkg{'name'} . "\n";
|
||||
print "Version : " . $pkg{'version'} . "\n";
|
||||
print "Release : " . $pkg{'release'} . "\n";
|
||||
print "Description : " . $pkg{'description'} . "\n";
|
||||
print "URL : " . $pkg{'url'} . "\n";
|
||||
print "Md5sum : " . $pkg{'md5sum'} . "\n";
|
||||
print "Size : " . $pkg{'size'} . "\n";
|
||||
my $deps = getdirectdeps($pkg{'name'}, $pkg{'path'});
|
||||
if ($deps ne "") { print "Depends on : $deps\n";};
|
||||
my $pkgname = shift;
|
||||
my ($path, $version, $release) = ($1,$2,$3)
|
||||
if ($fullpath{$pkgname} =~ m/(.*)\/$pkgname#(.*)-([0-9]*)\.pkg\.tar/);
|
||||
my ($du, $md5sum) = ($1,$2) if ($checksumsize{$pkgname} =~ m/([0-9]*):(.*)/);
|
||||
my $url = ($remote{$pkgname}) ? $remote{$pkgname} : $path;
|
||||
print "Name : " . $pkgname . "\n";
|
||||
print "Version : " . $version . "\n";
|
||||
print "Release : " . $release . "\n";
|
||||
print "Description : " . $description{$pkgname} . "\n";
|
||||
print "URL : " . $url . "\n";
|
||||
print "Md5sum : " . $md5sum . "\n";
|
||||
print "Size : " . $du . "\n";
|
||||
my $deps = ($depmap{$pkgname}) ? $depmap{$pkgname} : "";
|
||||
($deps eq "") or print "Depends on : $deps\n";
|
||||
my $files = "";
|
||||
if ($pkg{'readme'} eq "yes") {$files .= "README,"};
|
||||
if ($pkg{'pre_install'} eq "yes") {$files .= "pre-install,"};
|
||||
if ($pkg{'post_install'} eq "yes") {$files .= "post-install,"};
|
||||
if ($prepostread{$pkgname} =~ /:yes$/) {$files .= "README,"};
|
||||
if ($prepostread{$pkgname} =~ /^yes:/) {$files .= "pre-install,"};
|
||||
if ($prepostread{$pkgname} =~ /:yes:/) {$files .= "post-install,"};
|
||||
$files =~ s/\,$//;
|
||||
if ($files ne "") { print "Files : $files\n";};
|
||||
}
|
||||
|
||||
# Get direct dependencies for package
|
||||
sub getdirectdeps {
|
||||
my ($pkgname, $dir) = @_;
|
||||
open(DEPS, "$dir/PKGDEPS")
|
||||
or exiterr("could not open $dir/PKGDEPS");
|
||||
while (<DEPS>) {
|
||||
chomp;
|
||||
if ( /^\Q$pkgname\E\s+/ ) {
|
||||
my $dep = $_;
|
||||
$dep =~ s/^.*\: //;
|
||||
close(DEPS);
|
||||
return $dep;
|
||||
}
|
||||
}
|
||||
close(DEPS);
|
||||
return "";
|
||||
($files eq "") or print "Files : $files\n";
|
||||
}
|
||||
|
||||
# Prints the README file to stdout
|
||||
sub printreadme {
|
||||
my %pkg = @_;
|
||||
my $pkgname = shift;
|
||||
my ($found, $finished) = (0, 0);
|
||||
open(READ, "$pkg{'path'}/PKGREAD")
|
||||
or exiterr("could not open $pkg{'path'}/PKGREAD");
|
||||
my $path = $fullpath{$pkgname};
|
||||
$path =~ s/[^\/]*$//;
|
||||
open(READ, "$path/PKGREAD")
|
||||
or exiterr("could not open $path/PKGREAD");
|
||||
while (<READ>) {
|
||||
chomp;
|
||||
if ( ($found == 1) and (/PKGREADME\:/) ) {
|
||||
$finished = 1;
|
||||
} elsif ($found == 1) {
|
||||
print "$_\n";
|
||||
} elsif ( /PKGREADME\: $pkg{'name'}$/ ) {
|
||||
} elsif ( /PKGREADME\: $pkgname$/ ) {
|
||||
$found = 1;
|
||||
}
|
||||
last if ($finished == 1);
|
||||
@ -268,136 +302,92 @@ sub printresults {
|
||||
print "\npkg-get: $okaction successfully\n";
|
||||
}
|
||||
|
||||
# Get the list of installed packages
|
||||
sub getinstalled {
|
||||
local $/ = ""; # read files paragraph-wise; see ``perldoc perlvar''
|
||||
open(DB, $PKGDB) or exiterr("could not open ".$PKGDB);
|
||||
while (<DB>) {
|
||||
my ($name, $version, @files) = split /\n/, $_;
|
||||
$installed{$name} = $version;
|
||||
}
|
||||
close(DB);
|
||||
}
|
||||
|
||||
# Print formatted info for given package
|
||||
sub formattedprint {
|
||||
my %pkg = @_;
|
||||
my $fmt = $ARGV[1];
|
||||
$fmt =~ s|%n|$pkg{'name'}|;
|
||||
$fmt =~ s|%p|$pkg{'path'}|;
|
||||
$fmt =~ s|%v|$pkg{'version'}|;
|
||||
$fmt =~ s|%r|$pkg{'release'}|;
|
||||
$fmt =~ s|%d|$pkg{'description'}|;
|
||||
$fmt =~ s|%u|$pkg{'url'}|;
|
||||
$fmt =~ s|%R|$pkg{'readme'}|;
|
||||
$fmt =~ s|%E|$pkg{'pre_install'}|;
|
||||
$fmt =~ s|%O|$pkg{'post_install'}|;
|
||||
$fmt =~ s|%M|None|; # for prt-get compatibility
|
||||
$fmt =~ s|%P|None|; # for prt-get compatibility
|
||||
$fmt =~ s|\\n|\n|;
|
||||
$fmt =~ s|\\t|\t|;
|
||||
if (index($fmt,"%e") >=0) {
|
||||
my $deps = getdirectdeps($pkg{'name'}, $pkg{'path'});
|
||||
$fmt =~ s|%e|$deps|;
|
||||
}
|
||||
if (index($fmt,"%l") >=0) {
|
||||
my $locked = ($locked{$pkg{'name'}}) ? "yes" : "no";
|
||||
$fmt =~ s|%l|$locked|;
|
||||
}
|
||||
if (index($fmt,"%i") >=0) {
|
||||
(%installed) or getinstalled();
|
||||
my $inst = ($installed{$pkg{'name'}}) ? "yes" : "no";
|
||||
($inst eq "no") or
|
||||
($installed{$pkg{'name'}} eq "$pkg{'version'}-$pkg{'release'}")
|
||||
or $inst = "diff";
|
||||
$fmt =~ s|%i|$inst|;
|
||||
}
|
||||
print "$fmt";
|
||||
}
|
||||
|
||||
# Get package from the repo(s)
|
||||
sub getpackage {
|
||||
my $pkgname = $_[0];
|
||||
my $found; my @maybe; my %repver; my %res;
|
||||
# Initialize a hash of dependencies
|
||||
sub load_depmap {
|
||||
foreach my $repo(@repos) {
|
||||
my ($dir, $url) = split(/\|/, $repo);
|
||||
open(REPO, "$dir/PKGREPO") or exiterr("could not open $dir/PKGREPO");
|
||||
while (<REPO>) {
|
||||
chomp;
|
||||
my %pkg = parsepackage("full",$_, $dir, $url);
|
||||
next if ($pkg{'name'} ne $pkgname);
|
||||
$found = 1;
|
||||
push @maybe, join("^", $pkg{'path'}, $pkg{'url'},
|
||||
$pkg{'version'}, $pkg{'release'}, $pkg{'description'},
|
||||
$pkg{'md5sum'}, $pkg{'size'}, $pkg{'compression'},
|
||||
$pkg{'pre_install'}, $pkg{'post_install'}, $pkg{'readme'});
|
||||
$repver{$pkgname} = "$pkg{'version'}-$pkg{'release'}";
|
||||
}
|
||||
close (REPO);
|
||||
while (my $match = shift @maybe) {
|
||||
my ($p,$u,$v,$r,$d,$m,$s,$C,$E,$O,$R) = split /\^/, $match;
|
||||
next if ("$v-$r" ne $repver{$pkgname});
|
||||
%res = ('name' => $pkgname, 'path' => $p, 'url' => $u,
|
||||
'version' => $v, 'release' => $r, 'compression' => $C,
|
||||
'description' => $d, 'md5sum' => $m, 'size' => $s,
|
||||
'pre_install' => $E, 'post_install' => $O, 'readme' => $R);
|
||||
}
|
||||
last if ($found);
|
||||
open(DEPS, "$dir/PKGDEPS") or exiterr("could not open $dir/PKGDEPS");
|
||||
while (<DEPS>) {
|
||||
chomp;
|
||||
my ($pkgname,$pkgdep) = ($1,$2) if ( m/([^\s]*)\s*:\s*(.*)$/ );
|
||||
next if ($depmap{$pkgname});
|
||||
$depmap{$pkgname} = $pkgdep;
|
||||
}
|
||||
}
|
||||
return %res;
|
||||
}
|
||||
|
||||
# Get short status for package, e.g. [i]
|
||||
sub getshortstatus {
|
||||
my %pkg = @_;
|
||||
($installed{$pkg{'name'}}) or return "[ ]";
|
||||
($installed{$pkg{'name'}} eq "$pkg{'version'}-$pkg{'release'}") or return "[u]";
|
||||
return "[i]";
|
||||
}
|
||||
# Return a sorted list of packages required to satisfy all dependencies.
|
||||
sub deporder {
|
||||
my $type=shift; my @seeds=@_; our @treewalk=(); our @result; our %missing;
|
||||
our %given = map { $_ => 1 } @seeds; our %imark=(); our %fmark=();
|
||||
|
||||
# Get (recursive) dependencies for pkgname
|
||||
sub getdependencies {
|
||||
my ($pkgname, $checkver, $pkgparent) = @_;
|
||||
my $depstring = "";
|
||||
foreach my $t (@seeds) { recurse_deptree($t,""); }
|
||||
|
||||
# no need to continue if there's already a value for this key
|
||||
return if ($deps{$pkgname});
|
||||
|
||||
my %pkg = getpackage($pkgname);
|
||||
if (%pkg) {
|
||||
my $ddeps = getdirectdeps($pkg{'name'}, $pkg{'path'});
|
||||
my @d = split(/,/, $ddeps);
|
||||
foreach my $dep(@d) {
|
||||
getdependencies($dep, $checkver, $pkgname);
|
||||
}
|
||||
$depstring = getshortstatus(%pkg)." " if ($checkver);
|
||||
$depstring .= $pkgname;
|
||||
$deps{$pkgname} = $depstring;
|
||||
push(@dependencies, $depstring);
|
||||
} elsif ($installed{$pkgname}) {
|
||||
$depstring = ($checkver) ? "[i] $pkgname" : $pkgname;
|
||||
push(@dependencies, $depstring);
|
||||
} else {
|
||||
return 0 if ($pkgparent eq "");
|
||||
$missingdeps{$pkgname} = $pkgparent;
|
||||
}
|
||||
sub recurse_deptree {
|
||||
my $s=shift; my $pkgparent=shift; my %curdeps=();
|
||||
|
||||
# early return if this node has been visited already
|
||||
if ($fmark{$s}) { return; }
|
||||
|
||||
# detect targets that are not present among the repositories
|
||||
if (! $repver{$s}) {
|
||||
$missing{$pkgparent} .= "$s from $pkgparent;";
|
||||
$fmark{$s}=0;
|
||||
return;
|
||||
}
|
||||
|
||||
# dependency cycle detection
|
||||
if ($imark{$s}) {
|
||||
print "Dependency cycle found: ";
|
||||
foreach (@treewalk) { print "$_ => "; }
|
||||
print "$s\n";
|
||||
return;
|
||||
}
|
||||
|
||||
push(@treewalk, $s); $imark{$s}=1;
|
||||
|
||||
# assemble the list of dependencies that must be visited next
|
||||
(! $depmap{$s}) or %curdeps = map { $_ => 1 } split / /, $depmap{$s};
|
||||
|
||||
foreach my $sd (keys %curdeps) {
|
||||
recurse_deptree($sd,$s);
|
||||
}
|
||||
delete $imark{$s}; pop(@treewalk);
|
||||
$fmark{$s} = 1;
|
||||
push(@result, $s);
|
||||
}
|
||||
|
||||
if ((%missing) and ($type ne "quick")) {
|
||||
push (@result, "--- missing deps:");
|
||||
foreach my $mdep (sort(keys %missing)) {
|
||||
push (@result, split /;/, $missing{$mdep});
|
||||
}
|
||||
}
|
||||
return @result;
|
||||
}
|
||||
|
||||
# Download given package (if needed), check md5sum
|
||||
sub downloadpkg {
|
||||
my %pkg = @_;
|
||||
my $url = $pkg{'url'}; $url =~ s/\#/\%23/;
|
||||
my $fullpath = $pkg{'path'}."/".$pkg{'name'}."#".$pkg{'version'}."-".$pkg{'release'}.".pkg.tar.".$pkg{'compression'};
|
||||
return 0 if (($url eq "") and (! -f $fullpath)); # repo is local and pkg does not exist
|
||||
my $downloadcmd = "curl --retry 3 --retry-delay 3 -o $fullpath $url";
|
||||
my $pkgname = shift;
|
||||
my $url = "$remote{$pkgname}";
|
||||
if ($url) {
|
||||
$url =~ s/\#/\%23/;
|
||||
} else {
|
||||
my $saved = (-f $fullpath{$pkgname}) ? 1 : 0;
|
||||
return $saved;
|
||||
}
|
||||
my $downloadcmd = "curl --retry 3 --retry-delay 3 -o $fullpath{$pkgname} $url";
|
||||
(! $force_reinst) or system ($downloadcmd) == 0 or return 0;
|
||||
(-f $fullpath) or system ($downloadcmd) == 0 or return 0;
|
||||
(-f $fullpath{$pkgname}) or system ($downloadcmd) == 0 or return 0;
|
||||
# by now there should be a file in the expected location
|
||||
my $md5 = digest_file_hex($fullpath,"MD5");
|
||||
if ($md5 ne $pkg{'md5sum'} and not $ignore_md5sum) {
|
||||
print STDERR "=======> ERROR: md5sum mismatch for $pkg{'name'}:\n";
|
||||
print STDERR "required : $pkg{'md5sum'}\n";
|
||||
print STDERR "found : $md5\n";
|
||||
my $md5found = digest_file_hex($fullpath{$pkgname},"MD5");
|
||||
my $md5expected = $1 if ($checksumsize{$pkgname} =~ m/:(.*)/);
|
||||
if ($md5found ne $md5expected and not $ignore_md5sum) {
|
||||
print STDERR "=======> ERROR: md5sum mismatch for $pkgname:\n";
|
||||
print STDERR "required : $md5expected\n";
|
||||
print STDERR "found : $md5found\n";
|
||||
return 0;
|
||||
}
|
||||
return 1;
|
||||
@ -405,30 +395,30 @@ sub downloadpkg {
|
||||
|
||||
# Install given package
|
||||
sub installpkg {
|
||||
my ($upgrade, %pkg) = @_;
|
||||
my ($upgrade, $pkgname) = @_;
|
||||
my $aa = $aargs." ";
|
||||
if ($pkg{'readme'} eq "yes") {$readmetasks{$pkg{'name'}} = 1};
|
||||
$pptasks{$pkg{'name'}} = "";
|
||||
if ($prepostread{$pkgname} =~ m/:yes$/) {$readmetasks{$pkgname} = 1};
|
||||
$pptasks{$pkgname} = "";
|
||||
if ($force){$aa = $aa."-f ";}
|
||||
if ($root ne "") {$aa = $aa."-r ".$root." ";}
|
||||
if ($install_scripts or $pre_install) {doscript("pre",%pkg);}
|
||||
my $fullpath = $pkg{'path'}."/".$pkg{'name'}."#".$pkg{'version'}."-".$pkg{'release'}.".pkg.tar.".$pkg{'compression'};
|
||||
print "pkg-get: /usr/bin/pkgadd $upgrade $aa$fullpath\n";
|
||||
system ("/usr/bin/pkgadd $upgrade $aa$fullpath") == 0 or return 0;
|
||||
if ($install_scripts or $post_install) {doscript("post",%pkg);}
|
||||
if ($install_scripts and $prepostread{$pkgname} =~ m/^yes/) {doscript("pre",$pkgname);}
|
||||
print "pkg-get: /usr/bin/pkgadd $upgrade $aa$fullpath{$pkgname}\n";
|
||||
system ("/usr/bin/pkgadd $upgrade $aa$fullpath{$pkgname}") == 0 or return 0;
|
||||
if ($install_scripts and $prepostread{$pkgname} =~ m/:yes:/) {doscript("post",$pkgname);}
|
||||
return 1;
|
||||
}
|
||||
|
||||
# Execute pre- or post-install script
|
||||
sub doscript {
|
||||
my ($when, %pkg) = @_;
|
||||
($pkg{$when . "_install"} eq "yes") or return;
|
||||
my ($when, $pkgname) = @_;
|
||||
my $path = $fullpath{$pkgname};
|
||||
$path =~ s/[^\/]*$//;
|
||||
my $cmd = ($root ne "") ? "chroot $root " : "";
|
||||
$cmd .= "/bin/bash $pkg{'path'}/PKGINST $pkg{'name'} $when";
|
||||
if ((-e "$root$pkg{'path'}/PKGINST") and (system($cmd) == 0)) {
|
||||
$pptasks{$pkg{'name'}} .= " [$when: ok]";
|
||||
$cmd .= "/bin/bash $path/PKGINST $pkgname $when";
|
||||
if ((-e "$root$path/PKGINST") and (system($cmd) == 0)) {
|
||||
$pptasks{$pkgname} .= " [$when: ok]";
|
||||
} else {
|
||||
$pptasks{$pkg{'name'}} .= " [$when: failed]";
|
||||
$pptasks{$pkgname} .= " [$when: failed]";
|
||||
}
|
||||
}
|
||||
|
||||
@ -490,25 +480,23 @@ sub sync {
|
||||
}
|
||||
}
|
||||
|
||||
# Show info/path/readme for the package ####################################
|
||||
# Show info/readme/path for specific packages ####################################
|
||||
sub info {
|
||||
my ($type, $arg) = @ARGV;
|
||||
foreach my $repo(@repos) {
|
||||
my ($dir, $url) = split(/\|/, $repo);
|
||||
open(REPO, "$dir/PKGREPO") or exiterr("could not open $dir/PKGREPO");
|
||||
while (<REPO>) {
|
||||
chomp;
|
||||
my %pkg = parsepackage("full",$_, $dir, $url);
|
||||
if ($pkg{'name'} eq $arg) {
|
||||
($type ne "info") or printinfo(%pkg);
|
||||
($type ne "readme") or printreadme(%pkg);
|
||||
($type ne "path") or print $pkg{'path'} . "\n";
|
||||
close(REPO); return;
|
||||
}
|
||||
}
|
||||
close(REPO);
|
||||
my ($type, @args) = @ARGV;
|
||||
(%repver) or load_repos();
|
||||
($type ne "info") or load_depmap();
|
||||
foreach my $arg (@args) {
|
||||
($fullpath{$arg}) or next;
|
||||
if ($type eq "info") {
|
||||
printinfo($arg);
|
||||
} elsif ($type eq "readme") {
|
||||
printreadme($arg);
|
||||
} else {
|
||||
my $path = $fullpath{$arg};
|
||||
$path =~ s/[^\/]*$//;
|
||||
print $path . "\n";
|
||||
}
|
||||
}
|
||||
print "Package '$arg' not found\n";
|
||||
}
|
||||
|
||||
# List packages containing given string (name/description) #################
|
||||
@ -523,11 +511,8 @@ sub search {
|
||||
chomp;
|
||||
my %pkg = parsepackage($parsetype,$_, $dir, $url);
|
||||
next if ($found{$pkg{'name'}});
|
||||
(index($pkg{'name'}, $arg) < 0) or $found{$pkg{'name'}} = 1;
|
||||
(! $found{$pkg{'name'}}) or ($found{$pkg{'name'}}==1)
|
||||
or ($parsetype ne "full")
|
||||
or (index($pkg{'description'}, $arg) < 0)
|
||||
or $found{$pkg{'name'}} = 1;
|
||||
(index($pkg{'name'}, $arg) < 0) or ($parsetype eq "full") or $found{$pkg{'name'}} = 1;
|
||||
($parsetype ne "full") or (index($pkg{'description'}, $arg) < 0) or $found{$pkg{'name'}} = 1;
|
||||
}
|
||||
close(REPO);
|
||||
}
|
||||
@ -536,20 +521,10 @@ sub search {
|
||||
}
|
||||
|
||||
# List all available packages ##############################################
|
||||
# (requires a previous run of load_repos)
|
||||
sub list {
|
||||
my $arg = $ARGV[1];
|
||||
my %found;
|
||||
foreach my $repo(@repos) {
|
||||
my ($dir, $url) = split(/\|/, $repo);
|
||||
open(REPO, "$dir/PKGREPO") or exiterr("could not open $dir/PKGREPO");
|
||||
while (<REPO>) {
|
||||
chomp;
|
||||
my %pkg = parsepackage("light",$_, $dir, $url);
|
||||
$found{$pkg{'name'}} = 1;
|
||||
}
|
||||
close(REPO);
|
||||
}
|
||||
foreach my $key (sort keys %found) { print "$key\n"; }
|
||||
(%repver) or load_repos();
|
||||
foreach my $key(sort keys %repver) { print "$key\n"; }
|
||||
}
|
||||
|
||||
# Remove given packages ####################################################
|
||||
@ -571,17 +546,17 @@ sub remove {
|
||||
|
||||
# List installed packages ##################################################
|
||||
sub listinst {
|
||||
getinstalled() if (! %installed);
|
||||
foreach my $key (sort keys %installed) { print "$key\n"; }
|
||||
getinstalled() if (! %instver);
|
||||
foreach my $key (sort keys %instver) { print "$key\n"; }
|
||||
}
|
||||
|
||||
# Print package version, or install status #################################
|
||||
sub current {
|
||||
getinstalled() if (! %installed);
|
||||
getinstalled() if (! %instver);
|
||||
my $type = shift(@ARGV); my $result;
|
||||
foreach my $pkg(@ARGV) {
|
||||
if ($installed{$pkg}) {
|
||||
$result = ($type eq "current") ? ": version $installed{$pkg}\n"
|
||||
if ($instver{$pkg}) {
|
||||
$result = ($type eq "current") ? ": version $instver{$pkg}\n"
|
||||
: " is installed\n";
|
||||
} else {
|
||||
$result = " not installed\n";
|
||||
@ -593,31 +568,14 @@ sub current {
|
||||
# Lock given packages ######################################################
|
||||
sub dolock {
|
||||
shift(@ARGV);
|
||||
open(LCK, ">> $LOCKFILE") or exiterr("could not write to lock file");
|
||||
foreach my $arg(@ARGV) {
|
||||
if ($locked{$arg}) {
|
||||
print "Already locked: $arg\n"; next;
|
||||
}
|
||||
my $found = 0;
|
||||
foreach my $repo(@repos) {
|
||||
my ($dir, $url) = split(/\|/, $repo);
|
||||
open(REPO, "$dir/PKGREPO") or exiterr("could not open $dir/PKGREPO");
|
||||
while (<REPO>) {
|
||||
chomp;
|
||||
my %pkg = parsepackage("light",$_);
|
||||
if ($pkg{'name'} eq $arg) {
|
||||
$found = 1;
|
||||
open(LCK, ">> $LOCKFILE")
|
||||
or exiterr("could not write to lock file");
|
||||
print LCK "$arg\n";
|
||||
close(LCK);
|
||||
}
|
||||
last if ($found);
|
||||
}
|
||||
close(REPO);
|
||||
last if ($found);
|
||||
}
|
||||
if ($found == 0) {print "Package '$arg' not found\n"};
|
||||
print LCK "$arg\n";
|
||||
}
|
||||
close(LCK);
|
||||
}
|
||||
|
||||
# Unlock given packages ####################################################
|
||||
@ -642,49 +600,61 @@ sub listlocked {
|
||||
|
||||
# Print formatted info #####################################################
|
||||
sub doprintf {
|
||||
my %repver; my %found;
|
||||
my %printed;
|
||||
my $fmt = $ARGV[1];
|
||||
foreach my $repo(@repos) {
|
||||
my @toprint=();
|
||||
my ($dir, $url) = split(/\|/, $repo);
|
||||
open(REPO, "$dir/PKGREPO") or exiterr("could not open $dir/PKGREPO");
|
||||
while (<REPO>) {
|
||||
chomp;
|
||||
my %pkg = parsepackage("full",$_, $dir, $url);
|
||||
next if ($found{$pkg{'name'}});
|
||||
next if ($printed{$pkg{'name'}});
|
||||
(! $filter) or $filter =~ s/\*/\.\*/;
|
||||
if (($filter) and ($pkg{'name'} !~ /^$filter$/)) {
|
||||
$found{$pkg{'name'}} = 1; next;
|
||||
$printed{$pkg{'name'}} = 1; next;
|
||||
}
|
||||
|
||||
push @toprint, join("^", $pkg{'name'}, $pkg{'path'}, $pkg{'url'},
|
||||
$pkg{'version'}, $pkg{'release'}, $pkg{'description'},
|
||||
$pkg{'md5sum'}, $pkg{'size'},
|
||||
$pkg{'pre_install'}, $pkg{'post_install'}, $pkg{'readme'});
|
||||
|
||||
( ($repver{$pkg{'name'}}) and
|
||||
($repver{$pkg{'name'}} gt "$pkg{'version'}-$pkg{'release'}") )
|
||||
or $repver{$pkg{'name'}} = "$pkg{'version'}-$pkg{'release'}";
|
||||
my $printstring = $fmt;
|
||||
$printstring =~ s|%n|$pkg{'name'}|;
|
||||
$printstring =~ s|%p|$pkg{'path'}|;
|
||||
$printstring =~ s|%v|$pkg{'version'}|;
|
||||
$printstring =~ s|%r|$pkg{'release'}|;
|
||||
$printstring =~ s|%d|$pkg{'description'}|;
|
||||
$printstring =~ s|%u|$pkg{'url'}|;
|
||||
$printstring =~ s|%R|$pkg{'readme'}|;
|
||||
$printstring =~ s|%E|$pkg{'pre_install'}|;
|
||||
$printstring =~ s|%O|$pkg{'post_install'}|;
|
||||
$printstring =~ s|%M|None|; # for prt-get compatibility
|
||||
$printstring =~ s|%P|None|; # for prt-get compatibility
|
||||
$printstring =~ s|\\n|\n|;
|
||||
$printstring =~ s|\\t|\t|;
|
||||
if (index($printstring,"%e") >=0) {
|
||||
my $deps = $depmap{$pkg{'name'}};
|
||||
$printstring =~ s|%e|$deps|;
|
||||
}
|
||||
if (index($printstring,"%l") >=0) {
|
||||
my $locked = ($locked{$pkg{'name'}}) ? "yes" : "no";
|
||||
$printstring =~ s|%l|$locked|;
|
||||
}
|
||||
if (index($printstring,"%i") >=0) {
|
||||
(%instver) or getinstalled();
|
||||
my $inst = ($instver{$pkg{'name'}}) ? "yes" : "no";
|
||||
($inst eq "no") or
|
||||
($instver{$pkg{'name'}} eq "$repver{$pkg{'name'}}")
|
||||
or $inst = "diff";
|
||||
$printstring =~ s|%i|$inst|;
|
||||
}
|
||||
print $printstring;
|
||||
$printed{$pkg{'name'}} = 1;
|
||||
}
|
||||
close(REPO);
|
||||
|
||||
while (my $tpp = shift @toprint) {
|
||||
my ($n,$p,$u,$v,$r,$d,$m,$s,$E,$O,$R) = split /\^/, $tpp;
|
||||
my %printpkg = ('name' => $n, 'path' => $p,
|
||||
'url' => $u, 'version' => $v, 'release' => $r,
|
||||
'description' => $d, 'md5sum' => $m, 'size' => $s,
|
||||
'pre_install' => $E, 'post_install' => $O, 'readme' => $R);
|
||||
next if ("$v-$r" lt $repver{$n});
|
||||
formattedprint(%printpkg);
|
||||
$found{$n} = 1;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
# Show or resolve differences between installed and available packages #####
|
||||
sub diff {
|
||||
my $format = shift; my %found; my @diff;
|
||||
my $strf= ($format =~ /^quick/) ? "%s " : "%-19s %-19s %-19s\n";
|
||||
(%installed) or getinstalled();
|
||||
(%instver) or getinstalled();
|
||||
|
||||
foreach my $repo(@repos) {
|
||||
my ($dir, $url) = split(/\|/, $repo);
|
||||
@ -693,13 +663,13 @@ sub diff {
|
||||
while (<REPO>) {
|
||||
chomp;
|
||||
my %pkg = parsepackage("full",$_, $dir, $url);
|
||||
next if ( ($found{$pkg{'name'}}) or (! $installed{$pkg{'name'}}) );
|
||||
next if ( ($found{$pkg{'name'}}) or (! $instver{$pkg{'name'}}) );
|
||||
next if ( ($locked{$pkg{'name'}}) and (! $all) );
|
||||
my $lastcol = ($locked{$pkg{'name'}}) ? "locked" : "";
|
||||
($lastcol eq "locked") or $lastcol = ($installed{$pkg{'name'}}
|
||||
($lastcol eq "locked") or $lastcol = ($instver{$pkg{'name'}}
|
||||
eq $pkg{'version'}."-".$pkg{'release'}) ? "uptodate" :
|
||||
$pkg{'version'}."-".$pkg{'release'};
|
||||
push @multip, "$pkg{'name'}^$installed{$pkg{'name'}}^$lastcol";
|
||||
push @multip, "$pkg{'name'}^$instver{$pkg{'name'}}^$lastcol";
|
||||
}
|
||||
close(REPO);
|
||||
while (my $mp = shift @multip) {
|
||||
@ -751,24 +721,20 @@ sub dup {
|
||||
|
||||
# Show list of dependencies for package ####################################
|
||||
sub depends {
|
||||
my ($j, $checkver) = ($ARGV[0] =~ /^quick/) ? (" ",0) : ("\n",1);
|
||||
($checkver == 0) or (%installed) or getinstalled();
|
||||
getdependencies($ARGV[1], $checkver, "") or exiterr("package '$ARGV[1]' not found");
|
||||
(! @dependencies) or (! $checkver) or print "-- dependencies ([i] = installed, [u] = updatable)\n";
|
||||
print join($j, @dependencies);
|
||||
if ((%missingdeps) and ($j ne " ")) {
|
||||
print "\n-- missing packages\n";
|
||||
foreach my $dep(sort keys %missingdeps) {
|
||||
print "$dep from $missingdeps{$dep}\n";
|
||||
}
|
||||
}
|
||||
print "\n";
|
||||
my ($j, $type) = ($ARGV[0] =~ /^quick/) ? (" ","quick") : ("\n","full");
|
||||
($type eq "quick") or (%instver) or getinstalled();
|
||||
(%repver) or load_repos();
|
||||
my @args = @ARGV; shift @args;
|
||||
my @result=deporder($type,@args) or exiterr("package '$ARGV[1]' not found");
|
||||
(! @result) or ($type = "quick") or print "-- dependencies ([i] = installed, [u] = updatable)\n";
|
||||
foreach my $res (@result) { print $res . $j; }
|
||||
($type ne "quick") or print "\n";
|
||||
}
|
||||
|
||||
# Show packages directly depending from given package ######################
|
||||
sub dependent {
|
||||
my $arg = $ARGV[1]; my %dp;
|
||||
getinstalled() unless (($all) or (%installed));
|
||||
getinstalled() unless (($all) or (%instver));
|
||||
foreach my $repo(@repos) {
|
||||
my ($dir, $url) = split(/\|/, $repo);
|
||||
open(DEPS, "$dir/PKGDEPS")
|
||||
@ -786,7 +752,7 @@ sub dependent {
|
||||
close(DEPS);
|
||||
}
|
||||
foreach my $res(keys %dp) {
|
||||
print "$res\n" unless ((not $all) and (! $installed{$res}));
|
||||
print "$res\n" unless ((not $all) and (! $instver{$res}));
|
||||
}
|
||||
}
|
||||
|
||||
@ -808,18 +774,20 @@ sub upinst {
|
||||
}
|
||||
}
|
||||
|
||||
getinstalled() if (! %installed);
|
||||
getinstalled() if (! %instver);
|
||||
load_repos() if (! %repver);
|
||||
|
||||
foreach my $pkgname(@args) {
|
||||
my %pkg = getpackage($pkgname); my $failed=0;
|
||||
if (not %pkg) {
|
||||
my $failed=0;
|
||||
if (not $repver{$pkgname}) {
|
||||
push(@failtasks, "not found,$pkgname");
|
||||
} elsif ( ($cmd . getshortstatus(%pkg))
|
||||
} elsif ( ($cmd . $shortstatus{$pkgname})
|
||||
=~ /^(update. |install.u|install.i)/ ) {
|
||||
push(@prevtasks, "$pkgname");
|
||||
} elsif ( (($cmd . getshortstatus(%pkg)) =~ /^update.i/) and (! $force_reinst) ) {
|
||||
} elsif ( (($cmd . $shortstatus{$pkgname}) =~ /^update.i/) and (! $force_reinst) ) {
|
||||
push(@prevtasks, "$pkgname");
|
||||
} elsif (downloadpkg(%pkg)) {
|
||||
($download_only) or installpkg($aa, %pkg) or $failed=1;
|
||||
} elsif (downloadpkg($pkgname)) {
|
||||
($download_only) or installpkg($aa, $pkgname) or $failed=1;
|
||||
($failed == 1) ? push(@failtasks, "where $cmd failed,$pkgname")
|
||||
: push(@donetasks, $pkgname);
|
||||
} else {
|
||||
@ -831,19 +799,17 @@ sub upinst {
|
||||
|
||||
# Install given package, along with dependencies ###########################
|
||||
sub depinst {
|
||||
my @toinst; my %seen;
|
||||
my @toinst;
|
||||
$curraction = "installed";
|
||||
my @args = @ARGV; shift(@args);
|
||||
getinstalled() if (! %installed);
|
||||
foreach my $pkgname(@args) {
|
||||
getdependencies($pkgname, 0, "");
|
||||
foreach my $dep(@dependencies) {
|
||||
next if ($seen{$dep}); $seen{$dep} = 1;
|
||||
next if ($locked{$dep});
|
||||
my %pkg = getpackage($dep);
|
||||
if ((%pkg) and (getshortstatus(%pkg) eq "[ ]")) {
|
||||
push(@toinst, $pkg{'name'});
|
||||
}
|
||||
getinstalled() if (! %instver);
|
||||
(%repver) or load_repos();
|
||||
|
||||
my @maybeinst = deporder("quick",@args);
|
||||
foreach my $pkg (@maybeinst) {
|
||||
next if (($locked{$pkg}) or (! $repver{$pkg}));
|
||||
if (! $instver{$pkg}) {
|
||||
push(@toinst, $pkg);
|
||||
}
|
||||
}
|
||||
upinst("install",@toinst) if (@toinst);
|
||||
|
||||
@ -87,8 +87,8 @@ while (<$ppf>) {
|
||||
next if (! $printme{$name});
|
||||
$path{$name} = $repo . "/" . $name;
|
||||
$depends{$name} = $deps;
|
||||
$desc =~ s/\:/ /g;
|
||||
$descrip{$name} = $desc;
|
||||
$desc =~ s/:/ /g;
|
||||
$flags{$name} = $prepostread;
|
||||
}
|
||||
close ($ppf);
|
||||
@ -131,9 +131,9 @@ sub pkg_single {
|
||||
$oname =~ s/\#.*//;
|
||||
print $nR "$oline\n" if ($oname lt $pname{$p});
|
||||
|
||||
# before breaking out of the loop, append all the packages
|
||||
# before breaking out of the loop, append all the packages
|
||||
# from the globbed queue that are lexographically earlier
|
||||
# than the current entry in the old repository.
|
||||
# than the current entry in the old repository.
|
||||
while ($pname{$p} le $oname) {
|
||||
printf $nR "%-s:%-s:%-s:%-s:%-s\n", $basename, $du, $md5, $desc, $ppr;
|
||||
next RPKG if (! $isDup{$p});
|
||||
@ -141,7 +141,7 @@ sub pkg_single {
|
||||
($basename, $du, $md5, $ppr) = repodata($p);
|
||||
$desc = (! $descrip{$pname{$p}}) ? "N.A." : $descrip{$pname{$p}};
|
||||
|
||||
# save what got shifted from the repository if we're not going to
|
||||
# save what got shifted from the repository if we're not going to
|
||||
# print it now, but don't save packages that match the same glob.
|
||||
$followR{$pname{$p}} = "$oline\n" if ($pname{$p} lt $oname);
|
||||
}
|
||||
@ -175,12 +175,14 @@ sub pkg_single {
|
||||
|
||||
print "+ Updating specified entries in the html index\n";
|
||||
HPKG: while (my $p =shift @idx_packages) {
|
||||
my ($url, $pver, $desc, $date) = htmldata($p);
|
||||
my ($pver, $desc, $date) = htmldata($p);
|
||||
my $url = $p;
|
||||
$url =~ s/#/%23/;
|
||||
|
||||
if ($firstrun{"index.html"} == 1) {
|
||||
$count++;
|
||||
htmlrow($nH,$count,$pname{$p},$url,$pver,$desc,$date);
|
||||
next HPKG;
|
||||
next HPKG;
|
||||
}
|
||||
# Shift entries from the old html index until we find
|
||||
# a successor to the current package.
|
||||
@ -194,19 +196,21 @@ sub pkg_single {
|
||||
if ($oname lt $pname{$p}) { $count++; print $nH "$oline\n"; }
|
||||
|
||||
# before breaking out of the loop, append all the packages
|
||||
# from the globbed queue that are lexographically earlier
|
||||
# from the globbed queue that are lexographically earlier
|
||||
# than the current entry in the old html index.
|
||||
while ($pname{$p} le $oname) {
|
||||
$count++;
|
||||
htmlrow($nH,$count,$pname{$p},$url,$pver,$desc,$date);
|
||||
next HPKG if (! $isDup{$p});
|
||||
$p = shift @idx_packages;
|
||||
($url, $pver, $desc, $date) = htmldata($p);
|
||||
next HPKG if (! $isDup{$p});
|
||||
$p = shift @idx_packages;
|
||||
($pver, $desc, $date) = htmldata($p);
|
||||
$url = $p;
|
||||
$url =~ s/#/%23/;
|
||||
|
||||
# save what got shifted from the index if we're not going to print
|
||||
# it now, but ignore packages that match the same glob.
|
||||
# it now, but ignore packages that match the same glob.
|
||||
$followH{$pname{$p}} = "$oline\n" if ($pname{$p} lt $oname);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
# if the current package comes after everything in the old html index,
|
||||
@ -321,8 +325,10 @@ sub pkg_dir {
|
||||
my $count = 0;
|
||||
open (my $ih, ">>$pkgdir/index.html");
|
||||
foreach my $p (@packages) {
|
||||
my ($basename, $du, $md5, $ppr) = repodata($p);
|
||||
my ($url, $pver, $desc, $date) = htmldata($p);
|
||||
my ($basename, $du, $md5, $ppr) = repodata($p);
|
||||
my ($pver, $desc, $date) = htmldata($p);
|
||||
my $url = $basename;
|
||||
$url =~ s/#/%23/;
|
||||
(! $depends{$pname{$p}}) or ($isDup{$p})
|
||||
or printf $iD "%-30s : %-s\n", $pname{$p}, $depends{$pname{$p}};
|
||||
printf $iR "%-s:%-s:%-s:%-s:%-s\n", $basename,$du,$md5,$desc,$ppr;
|
||||
@ -437,12 +443,10 @@ EOH
|
||||
|
||||
sub htmldata {
|
||||
my $p = shift;
|
||||
my ($pver, $url) = ($p, $p);
|
||||
$pver =~ s/.*\#//; $pver =~ s/\.pkg\.tar.*//;
|
||||
$url = (split /\//, $p)[-1]; $url =~ s/\#/\%23/;
|
||||
my $pver = $1 if ($p =~ m/.*\#(.*)\.pkg\.tar\.*/);
|
||||
my $date = isotime( (stat($p))[9] );
|
||||
my $desc = (! $descrip{$pname{$p}}) ? "N.A." : $descrip{$pname{$p}};
|
||||
return $url, $pver, $desc, $date;
|
||||
return $pver, $desc, $date;
|
||||
}
|
||||
|
||||
sub repodata {
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user