farkuhar/pkg-get
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

pre-load some data structures for dependency lookups

Browse Source
This commit is contained in:
John McQuah 2025-01-04 15:06:18 +00:00
parent deaa06e52c
commit 54e485e20b
2 changed files with 278 additions and 308 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

546
scripts/pkg-get.pl
View File

@ -26,8 +26,9 @@ $SIG{QUIT} = \&trap; $SIG{TERM} = \&trap;
# Global vars # Global vars
my @repos = (); # package repositories my @repos = (); # package repositories
my @donetasks; my @failtasks; my @prevtasks; my %pptasks; my %readmetasks; my @donetasks; my @failtasks; my @prevtasks; my %pptasks; my %readmetasks;
my $curraction = ""; my %deps; my @dependencies; my %missingdeps; my $curraction = ""; my %depmap; my %locked; my %checksumsize;
my %locked; my %installed; my %fullpath; my %remote; my %prepostread; my %description;
my %instver; my %repver; my %shortstatus;
# CL Options # CL Options
my $download_only; my $pre_install; my $post_install; my $root=""; 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 =~ /^(isinst|current)$/) { current(); last SWITCH; }
if ($command =~ /^(diff|quickdiff|sysup)$/) { diff($1); last SWITCH; } if ($command =~ /^(diff|quickdiff|sysup)$/) { diff($1); last SWITCH; }
if ($command eq "dup") { dup(); 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 =~ /^(install|update)$/) { upinst(@ARGV); last SWITCH; }
if ($command eq "dependent") { dependent(); 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); 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 # Populate a hash of locked packages
sub get_locked { sub get_locked {
open (my $fL, $LOCKFILE) or return; open (my $fL, $LOCKFILE) or return;
@ -146,6 +158,40 @@ sub get_locked {
close ($fL); 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 # Parse a line describing a package
sub parsepackage { sub parsepackage {
my $type=shift; my @p = split(/\:/, $_[0]); my $type=shift; my @p = split(/\:/, $_[0]);
@ -171,55 +217,43 @@ sub parsepackage {
# Print info about the given package # Print info about the given package
sub printinfo { sub printinfo {
my %pkg = @_; my $pkgname = shift;
print "Name : " . $pkg{'name'} . "\n"; my ($path, $version, $release) = ($1,$2,$3)
print "Version : " . $pkg{'version'} . "\n"; if ($fullpath{$pkgname} =~ m/(.*)\/$pkgname#(.*)-([0-9]*)\.pkg\.tar/);
print "Release : " . $pkg{'release'} . "\n"; my ($du, $md5sum) = ($1,$2) if ($checksumsize{$pkgname} =~ m/([0-9]*):(.*)/);
print "Description : " . $pkg{'description'} . "\n"; my $url = ($remote{$pkgname}) ? $remote{$pkgname} : $path;
print "URL : " . $pkg{'url'} . "\n"; print "Name : " . $pkgname . "\n";
print "Md5sum : " . $pkg{'md5sum'} . "\n"; print "Version : " . $version . "\n";
print "Size : " . $pkg{'size'} . "\n"; print "Release : " . $release . "\n";
my $deps = getdirectdeps($pkg{'name'}, $pkg{'path'}); print "Description : " . $description{$pkgname} . "\n";
if ($deps ne "") { print "Depends on : $deps\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 = ""; my $files = "";
if ($pkg{'readme'} eq "yes") {$files .= "README,"}; if ($prepostread{$pkgname} =~ /:yes$/) {$files .= "README,"};
if ($pkg{'pre_install'} eq "yes") {$files .= "pre-install,"}; if ($prepostread{$pkgname} =~ /^yes:/) {$files .= "pre-install,"};
if ($pkg{'post_install'} eq "yes") {$files .= "post-install,"}; if ($prepostread{$pkgname} =~ /:yes:/) {$files .= "post-install,"};
$files =~ s/\,$//; $files =~ s/\,$//;
if ($files ne "") { print "Files : $files\n";}; ($files eq "") or 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 "";
} }
# Prints the README file to stdout # Prints the README file to stdout
sub printreadme { sub printreadme {
my %pkg = @_; my $pkgname = shift;
my ($found, $finished) = (0, 0); my ($found, $finished) = (0, 0);
open(READ, "$pkg{'path'}/PKGREAD") my $path = $fullpath{$pkgname};
or exiterr("could not open $pkg{'path'}/PKGREAD"); $path =~ s/[^\/]*$//;
open(READ, "$path/PKGREAD")
or exiterr("could not open $path/PKGREAD");
while (<READ>) { while (<READ>) {
chomp; chomp;
if ( ($found == 1) and (/PKGREADME\:/) ) { if ( ($found == 1) and (/PKGREADME\:/) ) {
$finished = 1; $finished = 1;
} elsif ($found == 1) { } elsif ($found == 1) {
print "$_\n"; print "$_\n";
} elsif ( /PKGREADME\: $pkg{'name'}$/ ) { } elsif ( /PKGREADME\: $pkgname$/ ) {
$found = 1; $found = 1;
} }
last if ($finished == 1); last if ($finished == 1);
@ -268,136 +302,92 @@ sub printresults {
print "\npkg-get: $okaction successfully\n"; 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) # Initialize a hash of dependencies
sub getpackage { sub load_depmap {
my $pkgname = $_[0];
my $found; my @maybe; my %repver; my %res;
foreach my $repo(@repos) { foreach my $repo(@repos) {
my ($dir, $url) = split(/\|/, $repo); my ($dir, $url) = split(/\|/, $repo);
open(REPO, "$dir/PKGREPO") or exiterr("could not open $dir/PKGREPO"); open(DEPS, "$dir/PKGDEPS") or exiterr("could not open $dir/PKGDEPS");
while (<REPO>) { while (<DEPS>) {
chomp; chomp;
my %pkg = parsepackage("full",$_, $dir, $url); my ($pkgname,$pkgdep) = ($1,$2) if ( m/([^\s]*)\s*:\s*(.*)$/ );
next if ($pkg{'name'} ne $pkgname); next if ($depmap{$pkgname});
$found = 1; $depmap{$pkgname} = $pkgdep;
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);
} }
return %res;
} }
# Get short status for package, e.g. [i] # Return a sorted list of packages required to satisfy all dependencies.
sub getshortstatus { sub deporder {
my %pkg = @_; my $type=shift; my @seeds=@_; our @treewalk=(); our @result; our %missing;
($installed{$pkg{'name'}}) or return "[ ]"; our %given = map { $_ => 1 } @seeds; our %imark=(); our %fmark=();
($installed{$pkg{'name'}} eq "$pkg{'version'}-$pkg{'release'}") or return "[u]";
return "[i]";
}
# Get (recursive) dependencies for pkgname foreach my $t (@seeds) { recurse_deptree($t,""); }
sub getdependencies {
my ($pkgname, $checkver, $pkgparent) = @_;
my $depstring = "";
# no need to continue if there's already a value for this key sub recurse_deptree {
return if ($deps{$pkgname}); my $s=shift; my $pkgparent=shift; my %curdeps=();
my %pkg = getpackage($pkgname); # early return if this node has been visited already
if (%pkg) { if ($fmark{$s}) { return; }
my $ddeps = getdirectdeps($pkg{'name'}, $pkg{'path'});
my @d = split(/,/, $ddeps); # detect targets that are not present among the repositories
foreach my $dep(@d) { if (! $repver{$s}) {
getdependencies($dep, $checkver, $pkgname); $missing{$pkgparent} .= "$s from $pkgparent;";
} $fmark{$s}=0;
$depstring = getshortstatus(%pkg)." " if ($checkver); return;
$depstring .= $pkgname; }
$deps{$pkgname} = $depstring;
push(@dependencies, $depstring); # dependency cycle detection
} elsif ($installed{$pkgname}) { if ($imark{$s}) {
$depstring = ($checkver) ? "[i] $pkgname" : $pkgname; print "Dependency cycle found: ";
push(@dependencies, $depstring); foreach (@treewalk) { print "$_ => "; }
} else { print "$s\n";
return 0 if ($pkgparent eq ""); return;
$missingdeps{$pkgname} = $pkgparent; }
}
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 # Download given package (if needed), check md5sum
sub downloadpkg { sub downloadpkg {
my %pkg = @_; my $pkgname = shift;
my $url = $pkg{'url'}; $url =~ s/\#/\%23/; my $url = "$remote{$pkgname}";
my $fullpath = $pkg{'path'}."/".$pkg{'name'}."#".$pkg{'version'}."-".$pkg{'release'}.".pkg.tar.".$pkg{'compression'}; if ($url) {
return 0 if (($url eq "") and (! -f $fullpath)); # repo is local and pkg does not exist $url =~ s/\#/\%23/;
my $downloadcmd = "curl --retry 3 --retry-delay 3 -o $fullpath $url"; } 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; (! $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 # by now there should be a file in the expected location
my $md5 = digest_file_hex($fullpath,"MD5"); my $md5found = digest_file_hex($fullpath{$pkgname},"MD5");
if ($md5 ne $pkg{'md5sum'} and not $ignore_md5sum) { my $md5expected = $1 if ($checksumsize{$pkgname} =~ m/:(.*)/);
print STDERR "=======> ERROR: md5sum mismatch for $pkg{'name'}:\n"; if ($md5found ne $md5expected and not $ignore_md5sum) {
print STDERR "required : $pkg{'md5sum'}\n"; print STDERR "=======> ERROR: md5sum mismatch for $pkgname:\n";
print STDERR "found : $md5\n"; print STDERR "required : $md5expected\n";
print STDERR "found : $md5found\n";
return 0; return 0;
} }
return 1; return 1;
@ -405,30 +395,30 @@ sub downloadpkg {
# Install given package # Install given package
sub installpkg { sub installpkg {
my ($upgrade, %pkg) = @_; my ($upgrade, $pkgname) = @_;
my $aa = $aargs." "; my $aa = $aargs." ";
if ($pkg{'readme'} eq "yes") {$readmetasks{$pkg{'name'}} = 1}; if ($prepostread{$pkgname} =~ m/:yes$/) {$readmetasks{$pkgname} = 1};
$pptasks{$pkg{'name'}} = ""; $pptasks{$pkgname} = "";
if ($force){$aa = $aa."-f ";} if ($force){$aa = $aa."-f ";}
if ($root ne "") {$aa = $aa."-r ".$root." ";} if ($root ne "") {$aa = $aa."-r ".$root." ";}
if ($install_scripts or $pre_install) {doscript("pre",%pkg);} if ($install_scripts and $prepostread{$pkgname} =~ m/^yes/) {doscript("pre",$pkgname);}
my $fullpath = $pkg{'path'}."/".$pkg{'name'}."#".$pkg{'version'}."-".$pkg{'release'}.".pkg.tar.".$pkg{'compression'}; print "pkg-get: /usr/bin/pkgadd $upgrade $aa$fullpath{$pkgname}\n";
print "pkg-get: /usr/bin/pkgadd $upgrade $aa$fullpath\n"; system ("/usr/bin/pkgadd $upgrade $aa$fullpath{$pkgname}") == 0 or return 0;
system ("/usr/bin/pkgadd $upgrade $aa$fullpath") == 0 or return 0; if ($install_scripts and $prepostread{$pkgname} =~ m/:yes:/) {doscript("post",$pkgname);}
if ($install_scripts or $post_install) {doscript("post",%pkg);}
return 1; return 1;
} }
# Execute pre- or post-install script # Execute pre- or post-install script
sub doscript { sub doscript {
my ($when, %pkg) = @_; my ($when, $pkgname) = @_;
($pkg{$when . "_install"} eq "yes") or return; my $path = $fullpath{$pkgname};
$path =~ s/[^\/]*$//;
my $cmd = ($root ne "") ? "chroot $root " : ""; my $cmd = ($root ne "") ? "chroot $root " : "";
$cmd .= "/bin/bash $pkg{'path'}/PKGINST $pkg{'name'} $when"; $cmd .= "/bin/bash $path/PKGINST $pkgname $when";
if ((-e "$root$pkg{'path'}/PKGINST") and (system($cmd) == 0)) { if ((-e "$root$path/PKGINST") and (system($cmd) == 0)) {
$pptasks{$pkg{'name'}} .= " [$when: ok]"; $pptasks{$pkgname} .= " [$when: ok]";
} else { } 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 { sub info {
my ($type, $arg) = @ARGV; my ($type, @args) = @ARGV;
foreach my $repo(@repos) { (%repver) or load_repos();
my ($dir, $url) = split(/\|/, $repo); ($type ne "info") or load_depmap();
open(REPO, "$dir/PKGREPO") or exiterr("could not open $dir/PKGREPO"); foreach my $arg (@args) {
while (<REPO>) { ($fullpath{$arg}) or next;
chomp; if ($type eq "info") {
my %pkg = parsepackage("full",$_, $dir, $url); printinfo($arg);
if ($pkg{'name'} eq $arg) { } elsif ($type eq "readme") {
($type ne "info") or printinfo(%pkg); printreadme($arg);
($type ne "readme") or printreadme(%pkg); } else {
($type ne "path") or print $pkg{'path'} . "\n"; my $path = $fullpath{$arg};
close(REPO); return; $path =~ s/[^\/]*$//;
} print $path . "\n";
} }
close(REPO);
} }
print "Package '$arg' not found\n";
} }
# List packages containing given string (name/description) ################# # List packages containing given string (name/description) #################
@ -523,11 +511,8 @@ sub search {
chomp; chomp;
my %pkg = parsepackage($parsetype,$_, $dir, $url); my %pkg = parsepackage($parsetype,$_, $dir, $url);
next if ($found{$pkg{'name'}}); next if ($found{$pkg{'name'}});
(index($pkg{'name'}, $arg) < 0) or $found{$pkg{'name'}} = 1; (index($pkg{'name'}, $arg) < 0) or ($parsetype eq "full") or $found{$pkg{'name'}} = 1;
(! $found{$pkg{'name'}}) or ($found{$pkg{'name'}}==1) ($parsetype ne "full") or (index($pkg{'description'}, $arg) < 0) or $found{$pkg{'name'}} = 1;
or ($parsetype ne "full")
or (index($pkg{'description'}, $arg) < 0)
or $found{$pkg{'name'}} = 1;
} }
close(REPO); close(REPO);
} }
@ -536,20 +521,10 @@ sub search {
} }
# List all available packages ############################################## # List all available packages ##############################################
# (requires a previous run of load_repos)
sub list { sub list {
my $arg = $ARGV[1]; (%repver) or load_repos();
my %found; foreach my $key(sort keys %repver) { print "$key\n"; }
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"; }
} }
# Remove given packages #################################################### # Remove given packages ####################################################
@ -571,17 +546,17 @@ sub remove {
# List installed packages ################################################## # List installed packages ##################################################
sub listinst { sub listinst {
getinstalled() if (! %installed); getinstalled() if (! %instver);
foreach my $key (sort keys %installed) { print "$key\n"; } foreach my $key (sort keys %instver) { print "$key\n"; }
} }
# Print package version, or install status ################################# # Print package version, or install status #################################
sub current { sub current {
getinstalled() if (! %installed); getinstalled() if (! %instver);
my $type = shift(@ARGV); my $result; my $type = shift(@ARGV); my $result;
foreach my $pkg(@ARGV) { foreach my $pkg(@ARGV) {
if ($installed{$pkg}) { if ($instver{$pkg}) {
$result = ($type eq "current") ? ": version $installed{$pkg}\n" $result = ($type eq "current") ? ": version $instver{$pkg}\n"
: " is installed\n"; : " is installed\n";
} else { } else {
$result = " not installed\n"; $result = " not installed\n";
@ -593,31 +568,14 @@ sub current {
# Lock given packages ###################################################### # Lock given packages ######################################################
sub dolock { sub dolock {
shift(@ARGV); shift(@ARGV);
open(LCK, ">> $LOCKFILE") or exiterr("could not write to lock file");
foreach my $arg(@ARGV) { foreach my $arg(@ARGV) {
if ($locked{$arg}) { if ($locked{$arg}) {
print "Already locked: $arg\n"; next; print "Already locked: $arg\n"; next;
} }
my $found = 0; print LCK "$arg\n";
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"};
} }
close(LCK);
} }
# Unlock given packages #################################################### # Unlock given packages ####################################################
@ -642,49 +600,61 @@ sub listlocked {
# Print formatted info ##################################################### # Print formatted info #####################################################
sub doprintf { sub doprintf {
my %repver; my %found; my %printed;
my $fmt = $ARGV[1];
foreach my $repo(@repos) { foreach my $repo(@repos) {
my @toprint=();
my ($dir, $url) = split(/\|/, $repo); my ($dir, $url) = split(/\|/, $repo);
open(REPO, "$dir/PKGREPO") or exiterr("could not open $dir/PKGREPO"); open(REPO, "$dir/PKGREPO") or exiterr("could not open $dir/PKGREPO");
while (<REPO>) { while (<REPO>) {
chomp; chomp;
my %pkg = parsepackage("full",$_, $dir, $url); my %pkg = parsepackage("full",$_, $dir, $url);
next if ($found{$pkg{'name'}}); next if ($printed{$pkg{'name'}});
(! $filter) or $filter =~ s/\*/\.\*/; (! $filter) or $filter =~ s/\*/\.\*/;
if (($filter) and ($pkg{'name'} !~ /^$filter$/)) { if (($filter) and ($pkg{'name'} !~ /^$filter$/)) {
$found{$pkg{'name'}} = 1; next; $printed{$pkg{'name'}} = 1; next;
} }
my $printstring = $fmt;
push @toprint, join("^", $pkg{'name'}, $pkg{'path'}, $pkg{'url'}, $printstring =~ s|%n|$pkg{'name'}|;
$pkg{'version'}, $pkg{'release'}, $pkg{'description'}, $printstring =~ s|%p|$pkg{'path'}|;
$pkg{'md5sum'}, $pkg{'size'}, $printstring =~ s|%v|$pkg{'version'}|;
$pkg{'pre_install'}, $pkg{'post_install'}, $pkg{'readme'}); $printstring =~ s|%r|$pkg{'release'}|;
$printstring =~ s|%d|$pkg{'description'}|;
( ($repver{$pkg{'name'}}) and $printstring =~ s|%u|$pkg{'url'}|;
($repver{$pkg{'name'}} gt "$pkg{'version'}-$pkg{'release'}") ) $printstring =~ s|%R|$pkg{'readme'}|;
or $repver{$pkg{'name'}} = "$pkg{'version'}-$pkg{'release'}"; $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); 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 ##### # Show or resolve differences between installed and available packages #####
sub diff { sub diff {
my $format = shift; my %found; my @diff; my $format = shift; my %found; my @diff;
my $strf= ($format =~ /^quick/) ? "%s " : "%-19s %-19s %-19s\n"; my $strf= ($format =~ /^quick/) ? "%s " : "%-19s %-19s %-19s\n";
(%installed) or getinstalled(); (%instver) or getinstalled();
foreach my $repo(@repos) { foreach my $repo(@repos) {
my ($dir, $url) = split(/\|/, $repo); my ($dir, $url) = split(/\|/, $repo);
@ -693,13 +663,13 @@ sub diff {
while (<REPO>) { while (<REPO>) {
chomp; chomp;
my %pkg = parsepackage("full",$_, $dir, $url); 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) ); next if ( ($locked{$pkg{'name'}}) and (! $all) );
my $lastcol = ($locked{$pkg{'name'}}) ? "locked" : ""; 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" : eq $pkg{'version'}."-".$pkg{'release'}) ? "uptodate" :
$pkg{'version'}."-".$pkg{'release'}; $pkg{'version'}."-".$pkg{'release'};
push @multip, "$pkg{'name'}^$installed{$pkg{'name'}}^$lastcol"; push @multip, "$pkg{'name'}^$instver{$pkg{'name'}}^$lastcol";
} }
close(REPO); close(REPO);
while (my $mp = shift @multip) { while (my $mp = shift @multip) {
@ -751,24 +721,20 @@ sub dup {
# Show list of dependencies for package #################################### # Show list of dependencies for package ####################################
sub depends { sub depends {
my ($j, $checkver) = ($ARGV[0] =~ /^quick/) ? (" ",0) : ("\n",1); my ($j, $type) = ($ARGV[0] =~ /^quick/) ? (" ","quick") : ("\n","full");
($checkver == 0) or (%installed) or getinstalled(); ($type eq "quick") or (%instver) or getinstalled();
getdependencies($ARGV[1], $checkver, "") or exiterr("package '$ARGV[1]' not found"); (%repver) or load_repos();
(! @dependencies) or (! $checkver) or print "-- dependencies ([i] = installed, [u] = updatable)\n"; my @args = @ARGV; shift @args;
print join($j, @dependencies); my @result=deporder($type,@args) or exiterr("package '$ARGV[1]' not found");
if ((%missingdeps) and ($j ne " ")) { (! @result) or ($type = "quick") or print "-- dependencies ([i] = installed, [u] = updatable)\n";
print "\n-- missing packages\n"; foreach my $res (@result) { print $res . $j; }
foreach my $dep(sort keys %missingdeps) { ($type ne "quick") or print "\n";
print "$dep from $missingdeps{$dep}\n";
}
}
print "\n";
} }
# Show packages directly depending from given package ###################### # Show packages directly depending from given package ######################
sub dependent { sub dependent {
my $arg = $ARGV[1]; my %dp; my $arg = $ARGV[1]; my %dp;
getinstalled() unless (($all) or (%installed)); getinstalled() unless (($all) or (%instver));
foreach my $repo(@repos) { foreach my $repo(@repos) {
my ($dir, $url) = split(/\|/, $repo); my ($dir, $url) = split(/\|/, $repo);
open(DEPS, "$dir/PKGDEPS") open(DEPS, "$dir/PKGDEPS")
@ -786,7 +752,7 @@ sub dependent {
close(DEPS); close(DEPS);
} }
foreach my $res(keys %dp) { 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) { foreach my $pkgname(@args) {
my %pkg = getpackage($pkgname); my $failed=0; my $failed=0;
if (not %pkg) { if (not $repver{$pkgname}) {
push(@failtasks, "not found,$pkgname"); push(@failtasks, "not found,$pkgname");
} elsif ( ($cmd . getshortstatus(%pkg)) } elsif ( ($cmd . $shortstatus{$pkgname})
=~ /^(update. |install.u|install.i)/ ) { =~ /^(update. |install.u|install.i)/ ) {
push(@prevtasks, "$pkgname"); push(@prevtasks, "$pkgname");
} elsif ( (($cmd . getshortstatus(%pkg)) =~ /^update.i/) and (! $force_reinst) ) { } elsif ( (($cmd . $shortstatus{$pkgname}) =~ /^update.i/) and (! $force_reinst) ) {
push(@prevtasks, "$pkgname"); push(@prevtasks, "$pkgname");
} elsif (downloadpkg(%pkg)) { } elsif (downloadpkg($pkgname)) {
($download_only) or installpkg($aa, %pkg) or $failed=1; ($download_only) or installpkg($aa, $pkgname) or $failed=1;
($failed == 1) ? push(@failtasks, "where $cmd failed,$pkgname") ($failed == 1) ? push(@failtasks, "where $cmd failed,$pkgname")
: push(@donetasks, $pkgname); : push(@donetasks, $pkgname);
} else { } else {
@ -831,19 +799,17 @@ sub upinst {
# Install given package, along with dependencies ########################### # Install given package, along with dependencies ###########################
sub depinst { sub depinst {
my @toinst; my %seen; my @toinst;
$curraction = "installed"; $curraction = "installed";
my @args = @ARGV; shift(@args); my @args = @ARGV; shift(@args);
getinstalled() if (! %installed); getinstalled() if (! %instver);
foreach my $pkgname(@args) { (%repver) or load_repos();
getdependencies($pkgname, 0, "");
foreach my $dep(@dependencies) { my @maybeinst = deporder("quick",@args);
next if ($seen{$dep}); $seen{$dep} = 1; foreach my $pkg (@maybeinst) {
next if ($locked{$dep}); next if (($locked{$pkg}) or (! $repver{$pkg}));
my %pkg = getpackage($dep); if (! $instver{$pkg}) {
if ((%pkg) and (getshortstatus(%pkg) eq "[ ]")) { push(@toinst, $pkg);
push(@toinst, $pkg{'name'});
}
} }
} }
upinst("install",@toinst) if (@toinst); upinst("install",@toinst) if (@toinst);

40
scripts/pkg-repgen.pl
View File

@ -87,8 +87,8 @@ while (<$ppf>) {
next if (! $printme{$name}); next if (! $printme{$name});
$path{$name} = $repo . "/" . $name; $path{$name} = $repo . "/" . $name;
$depends{$name} = $deps; $depends{$name} = $deps;
$desc =~ s/\:/ /g;
$descrip{$name} = $desc; $descrip{$name} = $desc;
$desc =~ s/:/ /g;
$flags{$name} = $prepostread; $flags{$name} = $prepostread;
} }
close ($ppf); close ($ppf);
@ -131,9 +131,9 @@ sub pkg_single {
$oname =~ s/\#.*//; $oname =~ s/\#.*//;
print $nR "$oline\n" if ($oname lt $pname{$p}); 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 # 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) { while ($pname{$p} le $oname) {
printf $nR "%-s:%-s:%-s:%-s:%-s\n", $basename, $du, $md5, $desc, $ppr; printf $nR "%-s:%-s:%-s:%-s:%-s\n", $basename, $du, $md5, $desc, $ppr;
next RPKG if (! $isDup{$p}); next RPKG if (! $isDup{$p});
@ -141,7 +141,7 @@ sub pkg_single {
($basename, $du, $md5, $ppr) = repodata($p); ($basename, $du, $md5, $ppr) = repodata($p);
$desc = (! $descrip{$pname{$p}}) ? "N.A." : $descrip{$pname{$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. # print it now, but don't save packages that match the same glob.
$followR{$pname{$p}} = "$oline\n" if ($pname{$p} lt $oname); $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"; print "+ Updating specified entries in the html index\n";
HPKG: while (my $p =shift @idx_packages) { 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) { if ($firstrun{"index.html"} == 1) {
$count++; $count++;
htmlrow($nH,$count,$pname{$p},$url,$pver,$desc,$date); htmlrow($nH,$count,$pname{$p},$url,$pver,$desc,$date);
next HPKG; next HPKG;
} }
# Shift entries from the old html index until we find # Shift entries from the old html index until we find
# a successor to the current package. # a successor to the current package.
@ -194,19 +196,21 @@ sub pkg_single {
if ($oname lt $pname{$p}) { $count++; print $nH "$oline\n"; } if ($oname lt $pname{$p}) { $count++; print $nH "$oline\n"; }
# 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 # from the globbed queue that are lexographically earlier
# than the current entry in the old html index. # than the current entry in the old html index.
while ($pname{$p} le $oname) { while ($pname{$p} le $oname) {
$count++; $count++;
htmlrow($nH,$count,$pname{$p},$url,$pver,$desc,$date); htmlrow($nH,$count,$pname{$p},$url,$pver,$desc,$date);
next HPKG if (! $isDup{$p}); next HPKG if (! $isDup{$p});
$p = shift @idx_packages; $p = shift @idx_packages;
($url, $pver, $desc, $date) = htmldata($p); ($pver, $desc, $date) = htmldata($p);
$url = $p;
$url =~ s/#/%23/;
# save what got shifted from the index if we're not going to print # 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); $followH{$pname{$p}} = "$oline\n" if ($pname{$p} lt $oname);
} }
} }
# if the current package comes after everything in the old html index, # if the current package comes after everything in the old html index,
@ -321,8 +325,10 @@ sub pkg_dir {
my $count = 0; my $count = 0;
open (my $ih, ">>$pkgdir/index.html"); open (my $ih, ">>$pkgdir/index.html");
foreach my $p (@packages) { foreach my $p (@packages) {
my ($basename, $du, $md5, $ppr) = repodata($p); my ($basename, $du, $md5, $ppr) = repodata($p);
my ($url, $pver, $desc, $date) = htmldata($p); my ($pver, $desc, $date) = htmldata($p);
my $url = $basename;
$url =~ s/#/%23/;
(! $depends{$pname{$p}}) or ($isDup{$p}) (! $depends{$pname{$p}}) or ($isDup{$p})
or printf $iD "%-30s : %-s\n", $pname{$p}, $depends{$pname{$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; printf $iR "%-s:%-s:%-s:%-s:%-s\n", $basename,$du,$md5,$desc,$ppr;
@ -437,12 +443,10 @@ EOH
sub htmldata { sub htmldata {
my $p = shift; my $p = shift;
my ($pver, $url) = ($p, $p); my $pver = $1 if ($p =~ m/.*\#(.*)\.pkg\.tar\.*/);
$pver =~ s/.*\#//; $pver =~ s/\.pkg\.tar.*//;
$url = (split /\//, $p)[-1]; $url =~ s/\#/\%23/;
my $date = isotime( (stat($p))[9] ); my $date = isotime( (stat($p))[9] );
my $desc = (! $descrip{$pname{$p}}) ? "N.A." : $descrip{$pname{$p}}; my $desc = (! $descrip{$pname{$p}}) ? "N.A." : $descrip{$pname{$p}};
return $url, $pver, $desc, $date; return $pver, $desc, $date;
} }
sub repodata { sub repodata {