Update of /cvsroot/fink/fink/perlmod/Fink
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv11760/perlmod/Fink
Modified Files:
Tag: dist-up-branch
Bootstrap.pm CLI.pm ChangeLog Config.pm Configure.pm Engine.pm
Package.pm PkgVersion.pm SelfUpdate.pm Services.pm
Validation.pm VirtPackage.pm
Log Message:
synced up to dist-up-branch-5 (HEAD)
Ready for testing, phase 1 done. Also fixed selfupdate logic.
Index: PkgVersion.pm
===================================================================
RCS file: /cvsroot/fink/fink/perlmod/Fink/PkgVersion.pm,v
retrieving revision 1.393.2.6
retrieving revision 1.393.2.7
diff -u -d -r1.393.2.6 -r1.393.2.7
--- PkgVersion.pm 28 May 2005 23:06:39 -0000 1.393.2.6
+++ PkgVersion.pm 28 May 2005 23:28:24 -0000 1.393.2.7
@@ -30,10 +30,12 @@
&file_MD5_checksum &version_cmp
&get_arch &get_system_perl_version
&get_path &eval_conditional
&enforce_gcc
- &dpkg_lockwait &aptget_lockwait);
+ &dpkg_lockwait &aptget_lockwait
&lock_wait
+ &store_rename);
use Fink::CLI qw(&print_breaking &prompt_boolean &prompt_selection
&should_skip_prompt);
-use Fink::Config qw($config $basepath $libpath $debarch $buildpath
$ignore_errors);
+use Fink::Config qw($config $basepath $libpath $debarch $buildpath
+ $dbpath $ignore_errors);
use Fink::NetAccess qw(&fetch_url_to_file);
use Fink::Mirror;
use Fink::Package;
@@ -41,14 +43,15 @@
use Fink::VirtPackage;
use Fink::Bootstrap qw(&get_bsbase);
use Fink::Command qw(mkdir_p rm_f rm_rf symlink_f du_sk chowname touch);
-use File::Basename qw(&dirname &basename);
use Fink::Notify;
use Fink::Validation;
use Fink::Text::DelimMatch;
use Fink::Text::ParseWords qw(&parse_line);
use POSIX qw(uname strftime);
+use DB_File;
use Hash::Util;
+use File::Basename qw(&dirname &basename);
use strict;
use warnings;
@@ -139,12 +142,26 @@
}
return $self unless exists $loaded->{$self->get_fullname};
+
+ # Insert the loaded fields
my $href = $loaded->{$self->get_fullname};
@$self{keys %$href} = values %$href;
+
+ # We need to update %d, %D, %i and %I to adapt to changes in
buildpath
+ my $destdir = $self->get_install_directory();
+ my $pdestdir = $self->has_parent()
+ ? $self->get_parent()->get_install_directory()
+ : $destdir;
+ my %entries = (
+ 'd' => $destdir, 'D' =>
$pdestdir,
+ 'i' => $destdir.$basepath, 'I' =>
$pdestdir.$basepath,
+ );
+ @{$self->{_expand}}{keys %entries} = values %entries;
+
return $self;
}
}
-
+
=item get_init_fields
@@ -249,11 +266,11 @@
# some commonly used stuff
$fullname = $pkgname."-".$version."-".$revision;
# prepare percent-expansion map
- $destdir = "$buildpath/root-$fullname";
+ $destdir = $self->get_install_directory();
if (exists $self->{parent}) {
my $parent = $self->{parent};
$parentpkgname = $parent->get_name();
- $parentdestdir = "$buildpath/root-".$parent->get_fullname();
+ $parentdestdir = $parent->get_install_directory();
$parentinvname = $parent->param_default("package_invariant",
$parentpkgname);
} else {
$parentpkgname = $pkgname;
@@ -779,13 +796,13 @@
my ($destdir);
my $splitoff;
- $destdir = "$buildpath/root-".$self->get_fullname();
+ $destdir = $self->get_install_directory();
$self->{_expand}->{p} = $basepath;
$self->{_expand}->{d} = $destdir;
$self->{_expand}->{i} = $destdir.$basepath;
if ($self->has_parent) {
my $parent = $self->get_parent;
- my $parentdestdir = "$buildpath/root-".$parent->get_fullname();
+ my $parentdestdir = $parent->get_install_directory();
$self->{_expand}->{D} = $parentdestdir;
$self->{_expand}->{I} = $parentdestdir.$basepath;
} else {
@@ -1329,20 +1346,64 @@
return 1;
}
+=item
-### Is this package available via apt?
+ my $hashref = get_aptdb();
+
+Get a hashref with the current packages available via apt-get
-sub is_aptgetable {
- my $self = shift;
- return defined $self->{_aptgetable};
+=cut
+
+sub get_aptdb {
+ my %db;
+
+ my $statusfile = "$basepath/var/lib/dpkg/status";
+ open APTDUMP, "$basepath/bin/apt-cache dump |"
+ or die "Can't run apt-cache dump: $!";
+ my ($pkg, $vers);
+ while(<APTDUMP>) {
+ if (/^\s*Package:\s*(\S+)/) {
+ ($pkg, $vers) = ($1, undef);
+ } elsif (/^\s*Version:\s*(\S+)/) {
+ $vers = $1;
+ } elsif (/^\s+File:\s*(\S+)/) { # Need \s+ so we don't get crap
at end
+
# of apt-cache dump
+ # Avoid using debs that aren't really apt-getable
+ next if $1 eq $statusfile;
+
+ $db{"$pkg-$vers"} = 1 if defined $pkg && defined $vers;
+ }
+ }
+ close APTDUMP;
+
+ return \%db;
}
+=item
-### Note that this package *is* available via apt
+ my $aptgetable = $pv->is_aptgetable;
+
+Get whether or not this package is available via apt-get.
-sub set_aptgetable {
- my $self = shift;
- $self->{_aptgetable} = 1;
+=cut
+
+{
+ my $aptdb = undef;
+
+ sub is_aptgetable {
+ my $self = shift;
+
+ if (!defined $aptdb) { # Load it
+ if ($config->binary_requested()) {
+ $aptdb = get_aptdb();
+ } else {
+ $aptdb = {};
+ }
+ }
+
+ # Return cached value
+ return exists $aptdb->{$self->get_name . "-" .
$self->get_fullversion};
+ }
}
@@ -1588,20 +1649,13 @@
SPECLOOP: foreach $altspecs (@speclist) {
$altlist = [];
- @altspec = split(/\s*\|\s*/, $altspecs);
+ @altspec = $self->get_altspec($altspecs);
$found = 0;
$loopcount = 0;
foreach $depspec (@altspec) {
+ $depname = $depspec->{'depname'};
+ $versionspec = $depspec->{'versionspec'};
$loopcount++;
- if ($depspec =~
/^\s*([0-9a-zA-Z.\+-]+)\s*\((.+)\)\s*$/) {
- $depname = $1;
- $versionspec = $2;
- } elsif ($depspec =~ /^\s*([0-9a-zA-Z.\+-]+)\s*$/) {
- $depname = $1;
- $versionspec = "";
- } else {
- die "Illegal spec format: $depspec\n";
- }
if ($include_build and $self->parent_splitoffs and
($idx >= $split_idx or $include_build == 2)) {
@@ -1611,17 +1665,17 @@
# exception: if we were called by a splitoff to
determine the "meta
# dependencies" of it, then we again filter out
all splitoffs.
# If you've read till here without mental
injuries, congrats :-)
- next SPECLOOP if ($depname eq $self->{_name});
+ next SPECLOOP if ($depspec->{'depname'} eq
$self->{_name});
foreach $splitoff ($self->parent_splitoffs) {
- next SPECLOOP if ($depname eq
$splitoff->get_name());
+ next SPECLOOP if ($depspec->{'depname'}
eq $splitoff->get_name());
}
}
- $package = Fink::Package->package_by_name($depname);
+ $package =
Fink::Package->package_by_name($depspec->{'depname'});
$found = 1 if defined $package;
if (($verbosity > 2 && not defined $package) ||
($forceoff && ($loopcount >= scalar(@altspec) && $found == 0))) {
- print "WARNING: While resolving $oper
\"$depspec\" for package \"".$self->get_fullname()."\", package \"$depname\"
was not found.\n";
+ print "WARNING: While resolving $oper \"" .
$depspec->{'depname'} . " " . $depspec->{'versionspec'} . "\" for package
\"".$self->get_fullname()."\", package \"" . $depspec->{'depname'} . "\" was
not found.\n";
}
if (not defined $package) {
next;
@@ -1635,7 +1689,17 @@
}
}
if (scalar(@$altlist) <= 0 && lc($field) ne "conflicts") {
- die "Can't resolve $oper \"$altspecs\" for package
\"".$self->get_fullname()."\" (no matching packages/versions found)\n";
+ my $package =
Fink::Package->package_by_name($altspec[0]->{'depname'});
+ my $diemessage = "Can't resolve $oper \"$altspecs\" for
package \"".$self->get_fullname()."\" (no matching packages/versions found)\n";
+ if (defined $package and $package->is_virtual()) {
+ my $version =
&latest_version($package->list_versions());
+ $package = $package->get_version($version);
+ $diemessage .= "\nAt least one of the
dependencies required (" . $package->get_name() . ") is a virtual package, you
might need\n" .
+ "to manually upgrade or install it.
The package details below should have more information\n" .
+ "on where to find an installer:\n\n" .
+ $package->get_description() . "\n";
+ }
+ die $diemessage;
}
push @deplist, $altlist;
$idx++;
@@ -1644,6 +1708,31 @@
return @deplist;
}
+sub get_altspec {
+ my $self = shift;
+ my $altspecs = shift;
+
+ my ($depspec, $depname, $versionspec);
+ my @specs;
+
+ my @altspec = split(/\s*\|\s*/, $altspecs);
+ foreach $depspec (@altspec) {
+ $depname = $versionspec = undef;
+ if ($depspec =~ /^\s*([0-9a-zA-Z.\+-]+)\s*\((.+)\)\s*$/) {
+ $depname = $1;
+ $versionspec = $2;
+ } elsif ($depspec =~ /^\s*([0-9a-zA-Z.\+-]+)\s*$/) {
+ $depname = $1;
+ $versionspec = "";
+ }
+ if (defined $depname) {
+ push(@specs, { depname => $depname, versionspec =>
$versionspec });
+ }
+ }
+
+ return @specs;
+}
+
sub resolve_conflicts {
my $self = shift;
my ($confname, $package, @conflist);
@@ -2606,8 +2695,8 @@
}
chdir "$buildpath";
- $ddir = "root-".$self->get_fullname();
- $destdir = "$buildpath/$ddir";
+ $destdir = $self->get_install_directory();
+ $ddir = basename $destdir;
if (not -d "$destdir/DEBIAN") {
my $error = "can't create directory for control files for
package ".$self->get_fullname();
@@ -2630,11 +2719,14 @@
# generate dpkg "control" file
- my ($pkgname, $parentpkgname, $version, $field, $section, $instsize);
+ my ($pkgname, $parentpkgname, $version, $field, $section, $instsize,
$prio);
$pkgname = $self->get_name();
$parentpkgname = $self->get_family_parent->get_name();
$version = $self->get_fullversion();
- $section = $self->get_section();
+
+ $section = $self->get_control_section();
+ $prio = $self->get_priority();
+
$instsize = $self->get_instsize("$destdir$basepath"); # kilobytes!
$control = <<EOF;
Package: $pkgname
@@ -2643,6 +2735,7 @@
Section: $section
Installed-Size: $instsize
Architecture: $debarch
+Priority: $prio
EOF
if ($self->param_boolean("BuildDependsOnly")) {
$control .= "BuildDependsOnly: True\n";
@@ -2875,6 +2968,7 @@
"###\n".
"### check to see if any .pod files exist in
\%p/share/podfiles.\n".
"###\n\n".
+ "echo -n '' >
\%p/lib/perl5$perldirectory/$perlarchdir/perllocal.pod\n".
"perl <<'END_PERL'\n\n".
"if (-e \"\%p/share/podfiles$perldirectory\") {\n".
" [EMAIL PROTECTED] =
<\%p/share/podfiles$perldirectory/*.pod>;\n".
@@ -3287,7 +3381,7 @@
my $lockpkg = "fink-buildlock-$pkgname-" . $self->get_version() . '-' .
$self->get_revision();
my $timestamp = strftime "%Y.%m.%d-%H.%M.%S", localtime;
- my $destdir = "$buildpath/root-$lockpkg";
+ my $destdir = $self->get_install_directory($lockpkg);
if (not -d "$destdir/DEBIAN") {
mkdir_p "$destdir/DEBIAN" or
@@ -3459,21 +3553,18 @@
# remove lockpkg (== clear lock for building $self)
print "Removing build lock...\n";
-
-
- my $old_lock;
- {
- local $SIG{INT} = 'IGNORE';
- $old_lock = `dpkg-query -W $lockpkg 2>/dev/null`;
- }
+ my $old_lock = `dpkg-query -W $lockpkg 2>/dev/null`;
chomp $old_lock;
if ($old_lock eq "$lockpkg\t") {
&print_breaking("WARNING: The lock was removed by some other
process.");
+ } elsif ($old_lock eq '') {
+ # this is weird, man...qpkg-query crashed or lock never got
installed
+ &print_breaking("WARNING: Could not read lock timestamp. Not
removing it.");
} elsif ($old_lock ne "$lockpkg\t$timestamp") {
# don't trample some other timestamp's lock
- &print_breaking("WARNING: The lock has a different timestamp.
Not ".
- "removing it, as it likely
belongs to a different ".
- "fink process. This should not
ever happen.");
+ &print_breaking("WARNING: The lock has a different timestamp
than the ".
+ "one we set. Not removing it,
as it likely belongs to ".
+ "a different fink process.");
} else {
if (&execute(dpkg_lockwait() . " -r $lockpkg", ignore_INT=>1)) {
&print_breaking("WARNING: Can't remove package ".
@@ -3830,6 +3921,59 @@
return $deps;
}
+=item get_install_directory
+
+ my $dir = $pv->get_install_directory;
+ my $dir = $pv->get_install_directory $pkg;
+
+Get the directory into which the install phase will put files. If $pkg is
+specified, will get get the destdir for a package of that full-name.
+
+=cut
+
+sub get_install_directory {
+ my $self = shift;
+ my $pkg = shift || $self->get_fullname();
+ return "$buildpath/root-$pkg";
+}
+
+=item get_control_section
+
+ my $section = $pv->get_control_section();
+
+Get the section of the package for the purposes of .deb control files. May be
+distinct from get_section.
+
+=cut
+
+sub get_control_section {
+ my $self = shift;
+ my $section = $self->get_section();
+ $section = "base" if $section eq "bootstrap";
+ return $section;
+}
+
+=item get_priority
+
+ my $prio = $pv->get_priority();
+
+Get the apt priority of this package.
+
+=cut
+
+sub get_priority {
+ my $self = shift;
+ my $prio = "optional";
+ if (grep { $_ eq $self->get_name() } qw(apt apt-shlibs storable)) {
+ $prio = "important";
+ }
+ if ($self->param_boolean("Essential")) {
+ $prio = "required";
+ }
+ return $prio;
+}
+
+
### EOF
1;
Index: SelfUpdate.pm
===================================================================
RCS file: /cvsroot/fink/fink/perlmod/Fink/SelfUpdate.pm,v
retrieving revision 1.92.2.4
retrieving revision 1.92.2.5
diff -u -d -r1.92.2.4 -r1.92.2.5
--- SelfUpdate.pm 28 May 2005 23:06:40 -0000 1.92.2.4
+++ SelfUpdate.pm 28 May 2005 23:28:24 -0000 1.92.2.5
@@ -285,26 +285,34 @@
$cmd = "cvs ${verbosity} -z3 -d:ext:[EMAIL
PROTECTED]:/cvsroot/fink";
$ENV{CVS_RSH} = "ssh";
}
- $cmdd = "$cmd checkout -d fink dists";
+ $cmdd = "$cmd checkout -l -d fink dists";
if ($username ne "root") {
$cmdd = "/usr/bin/su $username -c '$cmdd'";
}
- &print_breaking("Now downloading package descriptions...");
+ &print_breaking("Setting up base Fink directory...");
if (&execute($cmdd)) {
die "Downloading package descriptions from CVS failed.\n";
}
- if ($distribution eq "10.1") { #must do a second checkout in this case
- chdir "fink" or die "Can't cd to fink\n";
- $cmdd = "$cmd checkout -d 10.1 packages/dists";
- if ($username ne "root") {
- $cmdd = "/usr/bin/su $username -c
'$cmdd'";
- }
- &print_breaking("Now downloading more package
descriptions...");
- if (&execute($cmdd)) {
- die "Downloading package descriptions
from CVS failed.\n";
- }
- chdir $tempdir or die "Can't cd to $tempdir: $!\n";
+
+ my @trees = split(/\s+/, $config->param_default("SelfUpdateCVSTrees",
$distribution));
+ chdir "fink" or die "Can't cd to fink\n";
+
+ for my $tree (@trees) {
+ &print_breaking("Checking out $tree tree...");
+
+ my $cvsdir = "dists/$tree";
+ $cvsdir = "packages/dists" if ($tree eq "10.1");
+ $cmdd = "$cmd checkout -d $tree $cvsdir";
+
+ if ($username ne "root") {
+ $cmdd = "/usr/bin/su $username -c '$cmdd'";
+ }
+ if (&execute($cmdd)) {
+ die "Downloading package descriptions from CVS
failed.\n";
+ }
}
+ chdir $tempdir or die "Can't cd to $tempdir: $!\n";
+
if (not -d $tempfinkdir) {
die "The CVS didn't report an error, but the directory
'$tempfinkdir' ".
"doesn't exist as expected. Strange.\n";
@@ -364,7 +372,7 @@
### call cvs update
sub do_direct_cvs {
- my ($descdir, @sb, $cmd, $username, $msg);
+ my ($descdir, @sb, $cmd, $cmd_recursive, $username, $msg);
# add cvs quiet flag if verbosity level permits
my $verbosity = "-q";
@@ -376,13 +384,13 @@
chdir $descdir or die "Can't cd to $descdir: $!\n";
@sb = stat("$descdir/CVS");
- $cmd = "cvs ${verbosity} -z3 update -d -P";
- $msg = "I will now run the cvs command to retrieve the latest package ".
- "descriptions. ";
+
+ $cmd = "cvs ${verbosity} -z3 update -d -P -l";
+
+ $msg = "I will now run the cvs command to retrieve the latest package
descriptions. ";
if ($sb[4] != 0 and $> != $sb[4]) {
($username) = getpwuid($sb[4]);
- $cmd = "/usr/bin/su $username -c '$cmd'";
$msg .= "The 'su' command will be used to run the cvs command
as the ".
"user '$username'. ";
}
@@ -396,9 +404,29 @@
print "\n";
$ENV{CVS_RSH} = "ssh";
+
+ # first, update the top-level stuff
+
+ my $errors = 0;
+
+ $cmd = "/usr/bin/su $username -c '$cmd'" if ($username);
if (&execute($cmd)) {
- die "Updating using CVS failed. Check the error messages
above.\n";
+ $errors++;
+ }
+
+ # then, update the trees
+
+ my @trees = split(/\s+/, $config->param_default("SelfUpdateCVSTrees",
$distribution));
+ for my $tree (@trees) {
+ $cmd = "cvs ${verbosity} -z3 update -d -P ${tree}";
+ $cmd = "/usr/bin/su $username -c '$cmd'" if ($username);
+ if (&execute($cmd)) {
+ $errors++;
+ }
}
+
+ die "Updating using CVS failed. Check the error messages above.\n" if
($errors);
+
}
### update from packages tarball
@@ -530,16 +558,8 @@
push @elist, @{$package_list};
# update them, only fink if dist-upgrade must be done
- if (Fink::Services::checkDistribution())
+ if (Fink::Services::checkDistribution()) #returns true
if incompat
{
- Fink::Engine::cmd_install(@elist);
- # tell the user what has happened
- print "\n";
- &print_breaking("The core packages have been updated. ".
- "You should now update the
other packages ".
- "using commands like 'fink
update-all'.");
- print "\n";
- } else {
# tell the user what has happened
print "\n";
&print_breaking("The fink package has been updated. ".
@@ -548,6 +568,14 @@
"are running an old fink
distribution on ".
"an incompatible system.");
print "\n";
+ } else {
+ Fink::Engine::cmd_install(@elist);
+ # tell the user what has happened
+ print "\n";
+ &print_breaking("The core packages have been updated. ".
+ "You should now update the
other packages ".
+ "using commands like 'fink
update-all'.");
+ print "\n";
}
}
Index: ChangeLog
===================================================================
RCS file: /cvsroot/fink/fink/perlmod/Fink/ChangeLog,v
retrieving revision 1.958.2.5
retrieving revision 1.958.2.6
diff -u -d -r1.958.2.5 -r1.958.2.6
--- ChangeLog 17 May 2005 18:10:00 -0000 1.958.2.5
+++ ChangeLog 28 May 2005 23:28:24 -0000 1.958.2.6
@@ -1,3 +1,100 @@
+2005-05-26 Dave Vasilevsky <[EMAIL PROTECTED]>
+
+ * Configure.pm: Fix Spotlight warning.
+
+2005-05-26 Daniel Macks <[EMAIL PROTECTED]>
+
+ * PkgVersion.pm: Better err if qpkg-query fails while removing buildlock
+
+2005-05-26 Daniel Macks <[EMAIL PROTECTED]>
+
+ * Engine.pm: Convert "reinstall" to "rebuild" if no .deb present.
+
+2005-05-25 Peter O'Gorman <[EMAIL PROTECTED]>
+
+ * Bootstrap.pm: Maybe allow bootstrap on darwin8.
+
+2005-05-24 Dave Vasilevsky <[EMAIL PROTECTED]>
+
+ * Config.pm, Validation.pm: Make default buildpath
%p/fink/src/fink.build
+ * Configure.pm, Engine.pm: Warn about Spotlight indexing builds.
+ * Config.pm: New *_flag API.
+
+2005-05-24 Dave Vasilevsky <[EMAIL PROTECTED]>
+
+ * PkgVersion.pm: Insert the priority into .debs.
+ * Engine.pm: Try not to put everything into the override. On first run,
+ find all the debs without prio inside, and for the future put only them
+ into override.
+
+2005-05-24 Dave Vasilevsky <[EMAIL PROTECTED]>
+
+ * PkgVersion.pm: Empty perllocal.pod when the last perlmod is removed.
+
+2005-05-24 Benjamin Reed <[EMAIL PROTECTED]>
+
+ * PkgVersion.pm: Give more details when a dependency on a virtual fails.
+
+2005-05-24 Benjamin Reed <[EMAIL PROTECTED]>
+
+ * SelfUpdate.pm: changed CVS to only check out $distribution
+ (or whatever is set in SelfUpdateCVSTrees in fink.conf) rather
+ than everything under dists.
+
+2005-05-24 Dave Vasilevsky <[EMAIL PROTECTED]>
+
+ * Package.pm: Don't leave .lock files around.
+ * PkgVersion.pm: Don't break index if buildpath changes.
+
+2005-05-23 Daniel Macks <[EMAIL PROTECTED]>
+
+ * Bootstrap.pm, CLI.pm, Services.pm: Roll back last two commits.
+
+2005-05-23 Daniel Macks <[EMAIL PROTECTED]>
+
+ * Bootstrap.pm, CLI.pm, Services.pm: Adjust Fink:: importing to
+ match what is used.
+
+2005-05-23 Daniel Macks <[EMAIL PROTECTED]>
+
+ * Config.pm: Use new_from_properties as back end for new_with_path
+
+2005-05-22 Dave Morrison <[EMAIL PROTECTED]>
+
+ * Bootstrap.pm: recognize 10.4.1; also, say that 10.4 is "supported
+ and tested"
+
+2005-05-20 Daniel Macks <[EMAIL PROTECTED]>
+
+ * Validation.pm: Finish fieldname all-lc fixes.
+
+2005-05-20 Daniel Macks <[EMAIL PROTECTED]>
+
+ * Validation.pm: Move .info Shlibs syntax check into
+ validate_info_component. Move Provides and Shlibs checks out of
+ field loop. Control scoping of $field. Remember read_properties
+ returns all-lc keys. Better pkglist-field syntax warning.
+
+2005-05-20 Daniel Macks <[EMAIL PROTECTED]>
+
+ * Validation.pm: Fix pkglist-field syntax check when no conditional.
+
+2005-05-20 Daniel Macks <[EMAIL PROTECTED]>
+
+ * Validation.pm: Check pkglist-field syntax.
+
+2005-05-19 Dave Vasilevsky <[EMAIL PROTECTED]>
+
+ * Engine.pm: Fix bug with is_aptgetable changing $_.
+
+2005-05-18 Dave Vasilevsky <[EMAIL PROTECTED]>
+
+ * PkgVersion.pm, Package.pm: Load apt DB as needed, don't try caching
it.
+
+2005-05-18 Dave Vasilevsky <[EMAIL PROTECTED]>
+
+ * Services.pm, Package.pm: Move store_rename into Services.
+
2005-05-16 Daniel Macks <[EMAIL PROTECTED]>
* *: verbosity_level() is now a $config object method
Index: Engine.pm
===================================================================
RCS file: /cvsroot/fink/fink/perlmod/Fink/Engine.pm,v
retrieving revision 1.263.2.8
retrieving revision 1.263.2.9
diff -u -d -r1.263.2.8 -r1.263.2.9
--- Engine.pm 28 May 2005 23:06:39 -0000 1.263.2.8
+++ Engine.pm 28 May 2005 23:28:24 -0000 1.263.2.9
@@ -28,14 +28,15 @@
&execute &expand_percent
&file_MD5_checksum &count_files
&get_arch
&call_queue_clear &call_queue_add
&lock_wait
- &aptget_lockwait);
+ &aptget_lockwait &store_rename);
use Fink::CLI qw(&print_breaking &print_breaking_stderr
&prompt_boolean &prompt_selection
&get_term_width);
+use Fink::Configure qw(&spotlight_warning);
use Fink::Package;
use Fink::Shlibs;
use Fink::PkgVersion;
-use Fink::Config qw($config $basepath $debarch $distribution);
+use Fink::Config qw($config $basepath $debarch $distribution $dbpath);
use File::Find;
use Fink::Status;
use Fink::Command qw(mkdir_p);
@@ -220,6 +221,12 @@
sleep(3);
}
+ # Warn about Spotlight
+ if (&spotlight_warning()) {
+ $config->save;
+ $config->initialize;
+ }
+
# read package descriptions if needed
if ($pkgflag) {
Fink::Package->require_packages();
@@ -655,6 +662,86 @@
}
}
+=item create_override
+
+ create_override(@trees);
+
+Create an override file for the Fink .debs. The override lock must be locked
+for this method to work.
+
+=cut
+
+sub create_override {
+ my @trees = @_;
+ my @pkgs;
+
+ if (eval { require Storable; }) {
+ # Cache the old files. Not the most efficient system, but it
has the
+ # benefit of only needing to fully scan a tree once, ever.
+
+ my %pkgs;
+ my $dbpath = "$dbpath/override.db";
+ my $db = -f $dbpath ? Storable::lock_retrieve($dbpath) : { };
+
+ for my $tree (@trees) {
+ if (exists $db->{$tree}) { # Use the
cached debs
+ my $debs = $db->{$tree};
+ for my $deb (keys %$debs) {
+ if (-f $deb) {
+ $pkgs{$debs->{$deb}} = 1;
+# print "Using no-prio: $deb\n";
+ } else {
+ delete $debs->{$deb};
+# print "No-prio no longer
exists: $deb\n";
+ }
+ }
+ } else {
# Get the no-prio debs
+ find(sub {
+ return unless /\.deb$/;
+ my %fields;
+ open DEB, "dpkg-deb -f \Q$_\E package
priority |"
+ or return;
+ while (<DEB>) {
+ chomp;
+ if (/^(\S+)\s*:\s*(.*)$/) {
+ $fields{lc $1} = $2;
+ }
+ }
+ close DEB;
+
+ unless (exists $fields{priority}) {
+
$db->{$tree}->{$File::Find::name} = $fields{'package'};
+ $pkgs{$fields{'package'}} = 1;
+# print "Found no-prio:
$File::Find::name\n";
+ } else {
+# print "Have prio in:
$File::Find::name\n";
+ }
+ },
"$basepath/fink/dists/$tree/binary-$debarch/");
+ }
+ }
+
+ store_rename($db, $dbpath);
+ @pkgs = keys %pkgs;
+ } else {
+ @pkgs = Fink::Package->list_packages();
+ }
+
+ open(OVERRIDE,">$basepath/fink/override") or die "can't write override
file: $!\n";
+ foreach my $pkgname (@pkgs) {
+ my ($package, $pkgversion, $prio, $section);
+ $package = Fink::Package->package_by_name($pkgname);
+ next unless defined $package;
+ $pkgversion =
$package->get_version(&latest_version($package->list_versions()));
+ next unless defined $pkgversion;
+
+ $section = $pkgversion->get_control_section();
+ $prio = $pkgversion->get_priority();
+ print OVERRIDE "$pkgname $prio $section\n";
+ }
+ close(OVERRIDE) or die "can't write override file: $!\n";
+}
+
+
sub cmd_scanpackages {
my $quiet = shift || 0;
my @treelist = @_;
@@ -671,30 +758,7 @@
}
# create a global override file
-
- my ($pkgname, $package, $pkgversion, $prio, $section);
- open(OVERRIDE,">$basepath/fink/override") or die "can't write override
file: $!\n";
- foreach $pkgname (Fink::Package->list_packages()) {
- $package = Fink::Package->package_by_name($pkgname);
- next unless defined $package;
- $pkgversion =
$package->get_version(&latest_version($package->list_versions()));
- next unless defined $pkgversion;
-
- $section = $pkgversion->get_section();
- if ($section eq "bootstrap") {
- $section = "base";
- }
-
- $prio = "optional";
- if ($pkgname eq "apt" or $pkgname eq "apt-shlibs" or $pkgname
eq "storable-pm") {
- $prio = "important";
- }
- if ($pkgversion->param_boolean("Essential")) {
- $prio = "required";
- }
- print OVERRIDE "$pkgname $prio $section\n";
- }
- close(OVERRIDE) or die "can't write override file: $!\n";
+ create_override(@treelist);
# create the Packages.gz and Release files for each tree
@@ -1474,6 +1538,13 @@
if ($op == $OP_BUILD and $package->is_present()) {
next;
}
+ # if asked to reinstall but have no .deb, have to rebuild it
+ if ($op == $OP_REINSTALL and not $package->is_present()) {
+ if ($verbosity > 2) {
+ printf "No .deb found so %s must be rebuilt\n",
$package->get_fullname();
+ }
+ $op = $OP_REBUILD;
+ }
# add to table
@{$deps{$pkgname}}[ PKGNAME, PKGOBJ, PKGVER, OP, FLAG ] = (
$pkgname, Fink::Package->package_by_name($pkgname),
@@ -2304,11 +2375,12 @@
my $package =
Fink::Package->package_by_name($pkgname);
my $lversion =
&latest_version($package->list_versions());
print "$_:\n";
- foreach
(&sort_versions($package->list_versions())) {
+ foreach my $vers
(&sort_versions($package->list_versions())) {
+ my $pv = $package->get_version($vers);
printf " %1s%1s\t%s\n",
- (
$package->get_version($_)->is_present() or $config->binary_requested() &&
$package->get_version($_)->is_aptgetable() ) ? "b" : "",
-
$package->get_version($_)->is_installed() ? "i" : "",
- $_;
+ ( $pv->is_present() or
$config->binary_requested() && $pv->is_aptgetable() ) ? "b" : "",
+ $pv->is_installed() ? "i" : "",
+ $vers;
}
} elsif ($_ eq 'description') {
printf "%s: %s\n", $_,
$pkg->get_shortdescription;
Index: Package.pm
===================================================================
RCS file: /cvsroot/fink/fink/perlmod/Fink/Package.pm,v
retrieving revision 1.120.2.3
retrieving revision 1.120.2.4
diff -u -d -r1.120.2.3 -r1.120.2.4
--- Package.pm 11 May 2005 20:07:25 -0000 1.120.2.3
+++ Package.pm 28 May 2005 23:28:24 -0000 1.120.2.4
@@ -25,7 +25,7 @@
use Fink::Base;
use Fink::Services qw(&read_properties &read_properties_var
&latest_version &version_cmp &parse_fullversion
- &expand_percent &lock_wait);
+ &expand_percent &lock_wait &store_rename);
use Fink::CLI qw(&get_term_width &print_breaking &print_breaking_stderr);
use Fink::Config qw($config $basepath $dbpath $debarch);
use Fink::Command qw(&touch &mkdir_p &rm_rf &rm_f);
@@ -384,34 +384,6 @@
}
}
-# set the aptgetable status of packages
-
-sub update_aptgetable {
- my $class = shift; # class method
- my $statusfile = "$basepath/var/lib/dpkg/status";
-
- open APTDUMP, "$basepath/bin/apt-cache dump |"
- or die "Can't run apt-cache dump: $!";
-
- # Note: We assume here that the package DB exists already
- my ($po, $pv);
- while(<APTDUMP>) {
- if (/^\s*Package:\s*(\S+)/) {
- ($po, $pv) = (Fink::Package->package_by_name($1),
undef);
- } elsif (/^\s*Version:\s*(\S+)/) {
- $pv = $po->get_version($1) if defined $po;
- } elsif (/^\s+File:\s*(\S+)/) { # Need \s+ so we don't get crap
at end
-
# of apt-cache dump
- # Avoid using debs that aren't really apt-getable
- next if $1 eq $statusfile;
-
- $pv->set_aptgetable() if defined $pv;
- }
- }
- close APTDUMP;
-}
-
-
=private comment
When Fink uses a DB dir, it needs continued access to what's inside (since it
@@ -491,8 +463,10 @@
my @old = grep { $_ ne $current } @dirs;
if ($write) {
for my $dir (@old) {
- if (my $fh = lock_wait("$dir.lock", exclusive => 1,
no_block => 1)) {
+ my $lock = "$dir.lock";
+ if (my $fh = lock_wait($lock, exclusive => 1, no_block
=> 1)) {
rm_rf($dir);
+ rm_f($lock);
close $fh;
}
}
@@ -707,31 +681,6 @@
return ($read, $write);
}
-=item store_rename
-
- my $success = Fink::Package->store_rename $ref, $file;
-
-Store $ref in $file using Storable, but using a write-t-o-temp-and-atomically-
-rename strategy. Return true on success.
-
-=cut
-
-sub store_rename {
- my ($class, $ref, $file) = @_;
- my $tmp = "${file}.tmp";
-
- if (Storable::lock_store($ref, $tmp)) {
- unless (rename $tmp, $file) {
- print_breaking_stderr("Error: could not activate
temporary file $tmp: $!");
- return 0;
- }
- return 1;
- } else {
- print_breaking_stderr("Error: could not write temporary file
$tmp: $!");
- return 0;
- }
-}
-
=item update_index
my $fidx = Fink::Package->update_index $fidx, $info, @pvs;
@@ -830,7 +779,7 @@
mkdir_p($dir) unless -f $dir;
my %store = map { $_->get_fullname => $_ } @pvs;
- unless ($class->store_rename(\%store, $fidx->{cache})) {
+ unless (store_rename(\%store, $fidx->{cache})) {
delete $idx->{infos}{$info};
}
}
@@ -839,8 +788,7 @@
# Finish up;
if ($uncached) {
if ($ops->{write}) {
- $class->update_aptgetable() if
$config->binary_requested();
- $class->store_rename($idx, $class->db_index);
+ store_rename($idx, $class->db_index);
}
print_breaking_stderr("done.") if &get_term_width;
}
@@ -1296,7 +1244,6 @@
return $new_properties;
}
-
=back
=cut
Index: Configure.pm
===================================================================
RCS file: /cvsroot/fink/fink/perlmod/Fink/Configure.pm,v
retrieving revision 1.41.2.1
retrieving revision 1.41.2.2
diff -u -d -r1.41.2.1 -r1.41.2.2
--- Configure.pm 27 Apr 2005 16:11:23 -0000 1.41.2.1
+++ Configure.pm 28 May 2005 23:28:24 -0000 1.41.2.2
@@ -42,7 +42,8 @@
$VERSION = 1.00;
@ISA = qw(Exporter);
@EXPORT = qw();
- @EXPORT_OK = qw(&configure &choose_mirrors
$conf_file_compat_version);
+ @EXPORT_OK = qw(&configure &choose_mirrors
$conf_file_compat_version
+ &spotlight_warning);
%EXPORT_TAGS = ( ); # eg: TAG => [ qw!name1 name2!
],
}
our @EXPORT_OK;
@@ -125,6 +126,7 @@
if ($builddir =~ /\S/) {
$config->set_param("Buildpath", $builddir);
}
+ &spotlight_warning();
print "\n";
$binary_dist = $config->param_boolean("UseBinaryDist");
@@ -226,6 +228,40 @@
$config->save();
}
+=item spotlight_warning
+
+Warn the user if they are choosing a build path which will be indexed by
+Spotlight. Returns true if changes have been made to the Fink configuration,
+which will need to be saved.
+
+=cut
+
+sub spotlight_warning {
+ my $builddir = $config->param_default("Buildpath",
+
"$basepath/src/fink.build");
+ if ( $> == 0
+ && !$config->has_flag('SpotlightWarning')
+ && $builddir !~ /\.build$/
+ && $config->param("distribution") ge "10.4") {
+
+ $config->set_flag('SpotlightWarning');
+
+ print "\n";
+ my $response =
+ prompt_boolean("Your current build directory
'$builddir' will be ".
+ "indexed by Spotlight, which can make packages
build quite ".
+ "slowly.\n\n".
+ "Would you like to use '$builddir.build' as
your new build ".
+ "directory, so that Spotlight will not index
it?",
+ default => 1);
+ print "\n";
+
+ $config->set_param("Buildpath", $builddir . ".build") if
$response;
+ return 1;
+ }
+
+ return 0;
+}
=item choose_mirrors
Index: VirtPackage.pm
===================================================================
RCS file: /cvsroot/fink/fink/perlmod/Fink/VirtPackage.pm,v
retrieving revision 1.84.2.4
retrieving revision 1.84.2.5
diff -u -d -r1.84.2.4 -r1.84.2.5
--- VirtPackage.pm 11 May 2005 20:07:28 -0000 1.84.2.4
+++ VirtPackage.pm 28 May 2005 23:28:25 -0000 1.84.2.5
@@ -1157,6 +1157,11 @@
currently works with a growing number of applications.
http://growl.info/
+
+Please note that this virtual package expects you to have
+Growl installed system-wide in the
+/Library/PreferencePanes directory, rather than in a
+per-user ~/Library/PreferencePanes directory.
END
$hash->{compilescript} = &gen_compile_script($hash);
Index: Config.pm
===================================================================
RCS file: /cvsroot/fink/fink/perlmod/Fink/Config.pm,v
retrieving revision 1.45.2.3
retrieving revision 1.45.2.4
diff -u -d -r1.45.2.3 -r1.45.2.4
--- Config.pm 17 May 2005 18:10:02 -0000 1.45.2.3
+++ Config.pm 28 May 2005 23:28:24 -0000 1.45.2.4
@@ -56,10 +56,26 @@
use Fink::Config;
my $config = Fink::Config->new_with_path($config_file);
-
+
+ # General configuration file parameters
my $value = $config->param($key);
$config->set_param($key, $value);
$config->save;
+
+ # Configuration flags
+ my $bool = $config->has_flag($flag);
+ $config->set_flag($flag);
+ $config->clear_flag($flag);
+
+ # Specific configuration options
+ my $path = $config->get_path;
+ my @trees = $config->get_treelist;
+ my $verbosity = $config->verbosity_level;
+ my $use_apt = $config->binary_requested;
+
+ # Command-line parameters
+ my $value = $config->get_option($key, $default);
+ $config->set_options({ $key => $value, $key2 => ... });
=head1 DESCRIPTION
@@ -150,7 +166,7 @@
die $error;
}
- $buildpath = $self->param_default("Buildpath", "$basepath/src");
+ $buildpath = $self->param_default("Buildpath",
"$basepath/src/fink.build");
$libpath = "$basepath/lib/fink";
$dbpath = "$basepath/var/lib/fink"; # must sync with fink.info.in!
@@ -213,6 +229,9 @@
Inherited from Fink::Base.
+set_param also keeps a list of params that have been change since the
+$config object was originally initialized or last did $config->save()
+
=cut
sub set_param {
@@ -225,7 +244,9 @@
$config->save;
-Saves any changes made with set_param() to the config file.
+Saves any changes made with set_param() to the config file. Only lines
+of the file that correspond to params that were changed by set_param()
+are altered.
=cut
@@ -602,6 +623,7 @@
Determine whether the binary distribution or compilation has been requested.
This is affected by the --use-binary-dist and --compile-from-source
command line options as well as by the "UseBinaryDist" setting in fink.conf.
+A command-line flag takes precedence over a fink.conf setting.
Returns 1 for binary distribution, 0 for compile-from-source.
=cut
@@ -624,6 +646,54 @@
return $binary_request;
}
+=item has_flag
+
+ my $bool = $config->has_flag($flag);
+
+Check for the existence of a configuration flag.
+
+=item set_flag
+
+ $config->set_flag($flag);
+
+Set a configuration flag. Modified configuration can be saved with save().
+
+=item clear_flag
+
+ $config->clear_flag($flag);
+
+Clear a configuration flag. Modified configuration can be saved with save().
+
+=cut
+
+sub read_flags {
+ my $self = shift;
+ unless (defined $self->{_flags}) {
+ my @flags = split(' ', $self->param_default('Flags', ''));
+ $self->{_flags} = { map { $_ => 1 } @flags };
+ }
+}
+
+sub has_flag {
+ my ($self, $flag) = @_;
+ $self->read_flags;
+ return exists $self->{_flags}->{$flag};
+}
+
+sub set_flag {
+ my ($self, $flag) = @_;
+ $self->read_flags;
+ $self->{_flags}->{$flag} = 1;
+ $self->set_param('Flags', join(' ', keys %{$self->{_flags}}));
+}
+
+sub clear_flag {
+ my ($self, $flag) = @_;
+ $self->read_flags;
+ delete $self->{_flags}->{$flag};
+ $self->set_param('Flags', join(' ', keys %{$self->{_flags}}));
+}
+
=back
=head2 Exported Variables
Index: Validation.pm
===================================================================
RCS file: /cvsroot/fink/fink/perlmod/Fink/Validation.pm,v
retrieving revision 1.176.2.3
retrieving revision 1.176.2.4
diff -u -d -r1.176.2.3 -r1.176.2.4
--- Validation.pm 17 May 2005 18:10:05 -0000 1.176.2.3
+++ Validation.pm 28 May 2005 23:28:25 -0000 1.176.2.4
@@ -50,8 +50,10 @@
);
# Required fields.
-our @required_fields =
+our @required_fields = map {lc $_}
qw(Package Version Revision Maintainer);
+our @splitoff_required_fields = map {lc $_}
+ qw(Package);
# All fields that expect a boolean value
our %boolean_fields = map {$_, 1}
@@ -245,7 +247,18 @@
)
);
-
+# fields that are dpkg "Depends"-style lists of packages
+our %pkglist_fields = map {lc $_, 1}
+ (
+ 'Depends',
+ 'BuildDepends',
+ 'Conflicts',
+ 'BuildConflicts',
+ 'Provides',
+ 'Suggests',
+ 'Recommends',
+ 'Enhances',
+ );
END { } # module clean-up code here (global
destructor)
@@ -275,6 +288,7 @@
# + Warn if shbang in dpkg install-time scripts
# + Error if %i used in dpkg install-time scripts
# + Warn if non-ASCII chars in any field
+# + Check syntax of dpkg Depends-style fields
#
# TODO: Optionally, should sort the fields to the recommended field order
# - better validation of splitoffs
@@ -295,7 +309,7 @@
my $val_prefix = shift;
my ($properties, @parts);
my ($pkgname, $pkginvarname, $pkgversion, $pkgrevision, $pkgfullname,
$pkgdestdir, $pkgpatchpath, @patchfiles);
- my ($field, $value);
+ my $value;
my ($basepath, $buildpath);
my ($type, $type_hash);
my $expand = {};
@@ -330,10 +344,10 @@
# determine the base path
if (defined $val_prefix) {
$basepath = $val_prefix;
- $buildpath = "$basepath/src";
+ $buildpath = "$basepath/src/fink.build";
} else {
$basepath = $config->param_default("basepath", "/sw");
- $buildpath = $config->param_default("buildpath",
"$basepath/src");
+ $buildpath = $config->param_default("buildpath",
"$basepath/src/fink.build");
}
# make sure have InfoN (N>=2) if use Info2 features
@@ -486,7 +500,7 @@
}
# Loop over all fields and verify them
- foreach $field (keys %$properties) {
+ foreach my $field (keys %$properties) {
$value = $properties->{$field};
# Warn if field is obsolete
@@ -529,12 +543,12 @@
}
# Check for any source-related field without associated
Source(N) field
- if ($field =~
/^Source(\d*)-MD5|Source(\d*)Rename|Tar(\d*)FilesRename|Source(\d+)ExtractDir$/i)
{
+ if ($field =~
/^Source(\d*)-MD5|Source(\d*)Rename|Tar(\d*)FilesRename|Source(\d+)ExtractDir$/)
{
my $sourcefield = defined $+ # corresponding Source(N)
field
? "source$+"
: "source";
if (!exists $source_fields{$sourcefield}) {
- my $msg = $field =~ /-MD5$/i
+ my $msg = $field =~ /-md5$/
? "Warning" # no big deal
: "Error"; # probably means typo,
giving broken behavior
print "$msg: \"$field\" specified for
non-existent \"$sourcefield\". ($filename)\n";
@@ -567,46 +581,6 @@
$looks_good = 0;
}
- if (exists $splitoff_properties->{shlibs}) {
- my @shlibs = split /\n/,
$splitoff_properties->{shlibs};
- chomp @shlibs;
- my %shlibs;
- foreach (@shlibs) {
- my @shlibs_parts;
- if (scalar(@shlibs_parts = split ' ',
$_, 3) != 3) {
- print "Warning: Malformed line
in field \"shlibs\" of \"$field\". ($filename)\n $_\n";
- $looks_good = 0;
- next;
- }
- if (not /^(\%p)?\//) {
- print "Warning: Pathname
\"$shlibs_parts[0]\" is not absolute and is not in \%p in field \"shlibs\" of
\"$field\". ($filename)\n";
- $looks_good = 0;
- }
- if ($shlibs{$shlibs_parts[0]}++) {
- print "Warning: File
\"$shlibs_parts[0]\" is listed more than once in field \"shlibs\" of
\"$field\". ($filename)\n";
- $looks_good = 0;
- }
- if (not $shlibs_parts[1] =~
/^\d+\.\d+\.\d+$/) {
- print "Warning: Malformed
compatibility_version for \"$shlibs_parts[0]\" in field \"shlibs\" of
\"$field\". ($filename)\n";
- $looks_good = 0;
- }
- my @shlib_deps = split /\s*\|\s*/,
$shlibs_parts[2], -1;
- foreach (@shlib_deps) {
- if (not
/^[a-z%]\S*\s+\(>=\s*(\S+-\S+)\)$/) {
- print "Warning:
Malformed dependency \"$_\" for \"$shlibs_parts[0]\" in field \"shlibs\" of
\"$field\". ($filename)\n";
- $looks_good = 0;
- next;
- }
- my $shlib_dep_vers = $1;
- if ($shlib_dep_vers =~ /\%/) {
- print "Warning:
Non-hardcoded version in dependency \"$_\" for \"$shlibs_parts[0]\" in field
\"shlibs\" of \"$field\". ($filename)\n";
- $looks_good = 0;
- next;
- }
- }
- }
- }
-
if (defined ($value = $splitoff_properties->{files})) {
if ($value =~ /\/[\s\r\n]/ or $value =~ /\/$/) {
print "Warning: Field \"files\" of
\"$splitoff_field\" contains entries that end in \"/\" ($filename)\n";
@@ -754,28 +728,28 @@
if (defined $splitoff_field && length $splitoff_field) {
$is_splitoff = 1;
$splitoff_field = sprintf ' of "%s"', $splitoff_field;
- @pkg_required_fields = qw(package);
+ @pkg_required_fields = @splitoff_required_fields;
%pkg_valid_fields = %splitoff_valid_fields;
} else {
@pkg_required_fields = @required_fields;
%pkg_valid_fields = %valid_fields;
- }
+ }
- my ($field, $value);
+ my $value;
my $looks_good = 1;
### field-specific checks
# Verify that all required fields are present
- foreach $field (@pkg_required_fields) {
- unless (exists $properties->{lc $field}) {
+ foreach my $field (@pkg_required_fields) {
+ unless (exists $properties->{$field}) {
print "Error: Required field \"$field\"$splitoff_field
missing. ($filename)\n";
$looks_good = 0;
}
}
# dpkg install-time script stuff
- foreach $field (qw/preinstscript postinstscript prermscript
postrmscript/) {
+ foreach my $field (qw/preinstscript postinstscript prermscript
postrmscript/) {
next unless defined ($value = $properties->{$field});
# A #! line is worthless
@@ -799,7 +773,7 @@
### checks that apply to all fields
- foreach $field (keys %$properties) {
+ foreach my $field (keys %$properties) {
next if $field =~ /^splitoff/; # we don't do recursive stuff
here
$value = $properties->{$field};
@@ -832,12 +806,72 @@
}
}
- # Provides is not versionable
- if ($field =~ /^provides$/i) {
- if ($value =~ /\)\s*(,|\Z)/) {
- print "Warning: Not allowed to specify version
information in \"Provides\"$splitoff_field. ($filename)\n";
+ # check dpkg Depends-style field syntax
+ if ($pkglist_fields{$field}) {
+ (my $pkglist = $value) =~ tr/\n//d; # convert to sinle
line
+ foreach (split /[,|]/, $pkglist) {
+ # each atom must be '(optional cond) pkg
(optional vers)'
+ unless
(/\A\s*(?:\(([^()]*)\)|)\s*([^()\s]+)\s*(?:\(([^()]+)\)|)\s*\Z/) {
+ print "Warning: invalid dependency
\"$_\" in \"$field\"$splitoff_field. ($filename)\n";
+ $looks_good = 0;
+ }
+ my $cond = $1;
+ # no logical AND (OR would be split() and give
broken atoms)
+ if (defined $cond and $cond =~ /&/) {
+ print "Warning: invalid dependency
\"$_\" in \"$field\"$splitoff_field. ($filename)\n";
+ }
+ }
+ }
+ }
+
+ # Provides is not versionable
+ $value = $properties->{provides};
+ if (defined $value) {
+ if ($value =~ /\)\s*(,|\Z)/) {
+ print "Warning: Not allowed to specify version
information in \"Provides\"$splitoff_field. ($filename)\n";
+ $looks_good = 0;
+ }
+ }
+
+ # check syntax of each line of Shlibs field
+ $value = $properties->{shlibs};
+ if (defined $value) {
+ my @shlibs = split /\n/, $value;
+ my %shlibs;
+ foreach (@shlibs) {
+ next unless /\S/;
+ my @shlibs_parts;
+ if (scalar(@shlibs_parts = split ' ', $_, 3) != 3) {
+ print "Warning: Malformed line in field
\"shlibs\"$splitoff_field. ($filename)\n $_\n";
+ $looks_good = 0;
+ next;
+ }
+ if (not $shlibs_parts[0] =~ /^(\%p)?\//) {
+ print "Warning: Pathname \"$shlibs_parts[0]\"
is not absolute and is not in \%p in field \"shlibs\"$splitoff_field.
($filename)\n";
+ $looks_good = 0;
+ }
+ if ($shlibs{$shlibs_parts[0]}++) {
+ print "Warning: File \"$shlibs_parts[0]\" is
listed more than once in field \"shlibs\"$splitoff_field. ($filename)\n";
$looks_good = 0;
}
+ if (not $shlibs_parts[1] =~ /^\d+\.\d+\.\d+$/) {
+ print "Warning: Malformed compatibility_version
for \"$shlibs_parts[0]\" in field \"shlibs\"$splitoff_field. ($filename)\n";
+ $looks_good = 0;
+ }
+ my @shlib_deps = split /\s*\|\s*/, $shlibs_parts[2], -1;
+ foreach (@shlib_deps) {
+ if (not /^[a-z%]\S*\s+\(>=\s*(\S+-\S+)\)$/) {
+ print "Warning: Malformed dependency
\"$_\" for \"$shlibs_parts[0]\" in field \"shlibs\"$splitoff_field.
($filename)\n";
+ $looks_good = 0;
+ next;
+ }
+ my $shlib_dep_vers = $1;
+ if ($shlib_dep_vers =~ /\%/) {
+ print "Warning: Non-hardcoded version
in dependency \"$_\" for \"$shlibs_parts[0]\" in field
\"shlibs\"$splitoff_field. ($filename)\n";
+ $looks_good = 0;
+ next;
+ }
+ }
}
}
@@ -876,10 +910,10 @@
# determine the base path
if (defined $val_prefix) {
$basepath = $val_prefix;
- $buildpath = "$basepath/src";
+ $buildpath = "$basepath/src/fink.build";
} else {
$basepath = $config->param_default("basepath", "/sw");
- $buildpath = $config->param_default("buildpath",
"$basepath/src");
+ $buildpath = $config->param_default("buildpath",
"$basepath/src/fink.build");
}
# these are used in a regex and are automatically prepended with ^
Index: Services.pm
===================================================================
RCS file: /cvsroot/fink/fink/perlmod/Fink/Services.pm,v
retrieving revision 1.158.2.10
retrieving revision 1.158.2.11
diff -u -d -r1.158.2.10 -r1.158.2.11
--- Services.pm 28 May 2005 23:06:40 -0000 1.158.2.10
+++ Services.pm 28 May 2005 23:28:24 -0000 1.158.2.11
@@ -55,7 +55,8 @@
&get_osx_vers_long &get_kernel_vers
&get_darwin_equiv
&call_queue_clear &call_queue_add
&lock_wait
- &dpkg_lockwait &aptget_lockwait);
+ &dpkg_lockwait &aptget_lockwait
+ &store_rename);
}
our @EXPORT_OK;
@@ -1680,6 +1681,32 @@
: $fullpath;
}
+=item store_rename
+
+ my $success = store_rename $ref, $file;
+
+Store $ref in $file using Storable. Use a write-to-temp-and-atomically-
+rename strategy, to prevent corruption. Return true on success.
+
+=cut
+
+sub store_rename {
+ my ($ref, $file) = @_;
+ my $tmp = "${file}.tmp";
+
+ return 0 unless eval { require Storable };
+ if (Storable::lock_store($ref, $tmp)) {
+ unless (rename $tmp, $file) {
+ print_breaking_stderr("Error: could not activate
temporary file $tmp: $!");
+ return 0;
+ }
+ return 1;
+ } else {
+ print_breaking_stderr("Error: could not write temporary file
$tmp: $!");
+ return 0;
+ }
+}
+
=back
=cut
Index: Bootstrap.pm
===================================================================
RCS file: /cvsroot/fink/fink/perlmod/Fink/Bootstrap.pm,v
retrieving revision 1.97.2.4
retrieving revision 1.97.2.5
diff -u -d -r1.97.2.4 -r1.97.2.5
--- Bootstrap.pm 17 May 2005 18:10:00 -0000 1.97.2.4
+++ Bootstrap.pm 28 May 2005 23:28:24 -0000 1.97.2.5
@@ -184,9 +184,8 @@
&print_breaking("This system was not released at the time " .
"this Fink release was made, but should work.");
$distribution = "10.3";
- } elsif ($host =~ /^powerpc-apple-darwin8\.[0]\.0/) {
- &print_breaking("This brand new system is still being tested " .
- "but should work.");
+ } elsif ($host =~ /^powerpc-apple-darwin8\.[0-1]\.0/) {
+ &print_breaking("This system is supported and tested.");
if($ENV{FINK_NOTRANS}) {
&print_breaking("Using the non-transitional tree...");
$distribution = "10.4";
@@ -199,6 +198,17 @@
"of Mac OS X might work with Fink, but there are no " .
"guarantees.");
$distribution = "10.4-transitional";
+ } elsif ($host =~ /^i386-apple-darwin8\.[0-2]\.[0-1]/) {
+ &print_breaking("Fink is currently not supported on x86 ".
+ "Darwin. Various parts of Fink hardcode 'powerpc' ".
+ "and assume to run on a PowerPC based operating ".
+ "system. Use Fink on this system at your own risk!");
+ if($ENV{FINK_NOTRANS}) {
+ &print_breaking("Using the non-transitional tree...");
+ $distribution = "10.4";
+ } else {
+ $distribution = "10.4-transitional";
+ }
} elsif ($host =~ /^i386-apple-darwin7\.[0-2]\.[0-1]/) {
&print_breaking("Fink is currently not supported on x86 ".
"Darwin. Various parts of Fink hardcode 'powerpc' ".
Index: CLI.pm
===================================================================
RCS file: /cvsroot/fink/fink/perlmod/Fink/CLI.pm,v
retrieving revision 1.24.2.2
retrieving revision 1.24.2.3
diff -u -d -r1.24.2.2 -r1.24.2.3
--- CLI.pm 11 May 2005 20:07:16 -0000 1.24.2.2
+++ CLI.pm 28 May 2005 23:28:24 -0000 1.24.2.3
@@ -64,8 +64,8 @@
No functions are exported by default. You can get whichever ones you
need with things like:
- use Fink::Services '&prompt_boolean';
- use Fink::Services qw(&print_breaking &prompt);
+ use Fink::CLI '&prompt_boolean';
+ use Fink::CLI qw(&print_breaking &prompt);
=over 4
-------------------------------------------------------
This SF.Net email is sponsored by Yahoo.
Introducing Yahoo! Search Developer Network - Create apps using Yahoo!
Search APIs Find out how you can build Yahoo! directly into your own
Applications - visit http://developer.yahoo.net/?fr=offad-ysdn-ostg-q22005
_______________________________________________
Fink-commits mailing list
[email protected]
https://lists.sourceforge.net/lists/listinfo/fink-commits
