Update of /cvsroot/fink/fink/perlmod/Fink
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv17727/perlmod/Fink
Modified Files:
Tag: shlibs
Bootstrap.pm CLI.pm ChangeLog Configure.pm Engine.pm Mirror.pm
NetAccess.pm PkgVersion.pm SelfUpdate.pm Services.pm
Log Message:
Sync with head
Index: PkgVersion.pm
===================================================================
RCS file: /cvsroot/fink/fink/perlmod/Fink/PkgVersion.pm,v
retrieving revision 1.128.2.44
retrieving revision 1.128.2.45
diff -u -d -r1.128.2.44 -r1.128.2.45
--- PkgVersion.pm 4 Feb 2005 02:48:20 -0000 1.128.2.44
+++ PkgVersion.pm 9 Feb 2005 01:44:16 -0000 1.128.2.45
@@ -30,7 +30,7 @@
&file_MD5_checksum &version_cmp
&get_arch &get_system_perl_version
&get_path &eval_conditional
&enforce_gcc);
-use Fink::CLI qw(&print_breaking &prompt_boolean &prompt_selection_new);
+use Fink::CLI qw(&print_breaking &prompt_boolean &prompt_selection);
use Fink::Config qw($config $basepath $libpath $debarch $buildpath
$ignore_errors binary_requested);
use Fink::NetAccess qw(&fetch_url_to_file);
use Fink::Mirror;
@@ -1807,12 +1807,14 @@
"Expected:
$checksum \nActual: $found_archive_sum \n".
"It is
recommended that you download it ".
"again. How do
you want to proceed?");
- $answer = &prompt_selection_new("Make your
choice: ",
- [ value =>
($tries >= 3) ? "error" : "redownload" ],
- ( "Give up" =>
"error",
+ $answer = &prompt_selection("Make your choice:
",
+ default => [
value => ($tries >= 3) ? "error" : "redownload" ],
+ choices => [
+ "Give up" =>
"error",
"Delete it
and download again" => "redownload",
"Assume it is
a partial download and try to continue" => "continuedownload",
- "Don't
download, use existing file" => "continue" ) );
+ "Don't
download, use existing file" => "continue"
+ ] );
if ($answer eq "redownload") {
rm_f $found_archive;
# Axel leaves .st files around for
partial files, need to remove
@@ -1910,7 +1912,7 @@
"cause for this
is a corrupted or incomplete ".
"download. Do
you want to delete the tarball ".
"and download
it again?",
- ($tries >= 3) ?
0 : 1);
+ default =>
($tries >= 3) ? 0 : 1);
if ($answer) {
rm_f $found_archive;
redo; # restart loop with same tarball
@@ -2750,7 +2752,7 @@
}
}
$cmd = "dpkg-deb -b $ddir ".$self->get_debpath();
- if (&execute($cmd) == 1) {
+ if (&execute($cmd)) {
my $error = "can't create package ".$self->get_debname();
$notifier->notify(event => 'finkPackageBuildFailed',
description => $error);
die $error . "\n";
Index: Engine.pm
===================================================================
RCS file: /cvsroot/fink/fink/perlmod/Fink/Engine.pm,v
retrieving revision 1.101.2.30
retrieving revision 1.101.2.31
diff -u -d -r1.101.2.30 -r1.101.2.31
--- Engine.pm 3 Feb 2005 03:44:41 -0000 1.101.2.30
+++ Engine.pm 9 Feb 2005 01:44:16 -0000 1.101.2.31
@@ -24,7 +24,7 @@
package Fink::Engine;
use Fink::Services qw(&latest_version &sort_versions &execute
&file_MD5_checksum &get_arch &expand_percent &count_files &call_queue_clear
&call_queue_add);
-use Fink::CLI qw(&print_breaking &prompt_boolean &prompt_selection_new
&get_term_width);
+use Fink::CLI qw(&print_breaking &prompt_boolean &prompt_selection
&get_term_width);
use Fink::Package;
use Fink::Shlibs;
use Fink::PkgVersion;
@@ -98,6 +98,7 @@
'showparent' => [\&cmd_showparent, 1, 0, 0],
'dumpinfo' => [\&cmd_dumpinfo, 1, 0, 0],
'show-deps' => [\&cmd_show_deps, 1, 0, 0],
+ 'snapshot' => [\&cmd_snapshot, 1, 0, 0],
);
END { } # module clean-up code here (global
destructor)
@@ -136,7 +137,7 @@
sub process {
my $self = shift;
- my $options = shift;
+ my $orig_ARGV = shift;
my $cmd = shift;
my @args = @_;
@@ -156,7 +157,7 @@
# check if we need to be root
if ($rootflag and $> != 0) {
- &restart_as_root($options, $cmd, @args);
+ &restart_as_root(@$orig_ARGV);
}
# check if we need apt-get
@@ -190,7 +191,7 @@
}
if($apt_problem) {
my $prompt = "Continue with the 'UseBinaryDist' option
temporarily disabled?";
- my $continue = prompt_boolean($prompt, 1, 60);
+ my $continue = prompt_boolean($prompt, default => 1,
timeout => 60);
if ($continue) {
# temporarily disable UseBinaryDist
$config->set_param("UseBinaryDist", "false");
@@ -222,11 +223,7 @@
Fink::PkgVersion->clear_buildlock(); # always clean up
# Rebuild the command line, for user viewing
- my $commandline = 'fink';
- $commandline .= " $options" if $options;
- $commandline .= " $cmd" if $cmd;
- $commandline .= join('', map { " $_" } @args) if @args;
-
+ my $commandline = join ' ', 'fink', @$orig_ARGV;
my $notifier = Fink::Notify->new();
if ($proc_rc->{'$@'}) { # now deal with eval results
print "Failed: " . $proc_rc->{'$@'};
@@ -255,14 +252,11 @@
$cmd = "$basepath/bin/fink";
- # Pass on options
- $cmd .= ' ' . shift;
-
foreach $arg (@_) {
if ($arg =~ /^[A-Za-z0-9_.+-]+$/) {
$cmd .= " $arg";
} else {
- # safety first
+ # safety first (protect shell metachars, quote whole
string)
$arg =~ s/[\$\`\'\"|;]/_/g;
$cmd .= " \"$arg\"";
}
@@ -931,11 +925,12 @@
if ($cmp1 ne $cmp2) {
my $pkglist = join(", ", @packages);
- my $rmcount = $#packages + 1;
- print "Fink will attempt to $cmd $rmcount package(s).\n";
- &print_breaking("$pkglist\n\n");
-
- my $answer = &prompt_boolean("Do you want to continue?", 1);
+ my $pkgcount = $#packages + 1;
+ my $prompt = "Fink will attempt to $cmd $pkgcount package" .
+ ( $pkgcount > 1 ? "s" : "" ) .
+ "\n\n" .
+ "Do you want to continue?";
+ my $answer = &prompt_boolean($prompt, default => 1);
if (! $answer) {
die "$cmd not performed!\n";
}
@@ -974,7 +969,7 @@
print "WARNING: this command will remove the package(s) and remove
any\n";
print " global configure files, even if you modified them!\n\n";
- my $answer = &prompt_boolean("Do you want to continue?", 1);
+ my $answer = &prompt_boolean("Do you want to continue?", default => 1);
if (! $answer) {
die "Purge not performed!\n";
}
@@ -1572,7 +1567,8 @@
print "\n";
&print_breaking("fink needs help picking an
alternative to satisfy ".
"a virtual
dependency. The candidates:");
- $dname = &prompt_selection_new("Pick one:",
[number=>$choice], @choices);
+ $dname = &prompt_selection("Pick one:",
+ default => [number=>$choice], choices
=> [EMAIL PROTECTED]);
}
# the dice are rolled...
@@ -1727,7 +1723,8 @@
&print_breaking(join(" ",@removals), 1, " ");
}
if (not $dryrun) {
- $answer = &prompt_boolean("Do you want to
continue?", 1);
+ $answer = &prompt_boolean("Do you want to
continue?",
+
default => 1);
if (! $answer) {
die "Package requirements not
satisfied\n";
}
@@ -2341,6 +2338,51 @@
}
}
+sub cmd_snapshot {
+ my ($pname, $package, @installed, $snapdir, $outfile, @time,
+ $snappkg, $snapver, $snaprev, $snapdep);
+
+ eval "use POSIX qw(strftime);";
+ $snappkg = "fink-snapshot";
+ $snapver = strftime("%Y.%m.%d.%H", localtime);
+ $snaprev = "1";
+ $snapdir = "/tmp";
+ foreach $pname (Fink::Package->list_packages()) {
+ next if ($pname eq $snappkg);
+ $package = Fink::Package->package_by_name($pname);
+ if ($package->is_any_installed() &&
+ !$package->is_virtual()) {
+ push @installed, $pname;
+ }
+ }
+ $snapdep = join(",\n ", sort(@installed));
+ $outfile = sprintf("$snapdir/snap-%s-%s.info",
+ $snapver, $snaprev);
+ my @user = getpwnam($ENV{SUDO_USER} || $ENV{USER});
+ local *SNAP;
+ open(SNAP, "> $outfile") or die "can't create file $outfile\n";
+ print SNAP <<"EOF";
+Package: $snappkg
+Version: $snapver
+Revision: $snaprev
+Type: bundle
+License: Restrictive
+Description: Snapshot of Fink packages for $user[6]
+Maintainer: $user[6] <[EMAIL PROTECTED]>
+Homepage: http://fink.sourceforge.net/
+Depends: <<
+ $snapdep
+<<
+EOF
+ close(SNAP) or die "can't create file $outfile\n";
+ print <<"EOF";
+Wrote $outfile
+To use this file:
+ copy to /sw/fink/dists/local/main/finkinfo
+ run "fink build fink-snapshot"
+EOF
+}
+
# pretty-print a set of PkgVersion::pkglist (each "or" group on its own line)
# pass:
# ref to list of field names
@@ -2358,8 +2400,8 @@
}
my $field_value; # used in dep processing loop (string from
pkglist())
+ my %results; # hash so duplicates are removed automatically
- my $did_print = 0; # did we print anything at all?
foreach my $field (@$fields) {
foreach (@$pkgs) {
next unless defined( $field_value = $_->pkglist($field)
);
@@ -2373,16 +2415,17 @@
s/^\s*\|\s*//;
s/\s*\|\s*$//;
}
-
- if (length $_) {
- printf " %s\n", $_;
- $did_print++;
- }
+ $results{$_} = 1 if length $_; # save what we
found
}
}
}
- print " [none]\n" unless $did_print;
+ # organize and display the list of packages
+ if (%results) {
+ print map " $_\n", sort keys %results;
+ } else {
+ print " [none]\n";
+ }
}
### EOF
Index: CLI.pm
===================================================================
RCS file: /cvsroot/fink/fink/perlmod/Fink/CLI.pm,v
retrieving revision 1.14.2.2
retrieving revision 1.14.2.3
diff -u -d -r1.14.2.2 -r1.14.2.3
--- CLI.pm 1 Feb 2005 03:19:57 -0000 1.14.2.2
+++ CLI.pm 9 Feb 2005 01:44:16 -0000 1.14.2.3
@@ -39,9 +39,9 @@
# your exported package globals go here,
# as well as any optionally exported functions
@EXPORT_OK = qw(&print_breaking &print_breaking_stderr
- &prompt &prompt_boolean
&prompt_selection_new &prompt_selection
+ &prompt &prompt_boolean
&prompt_selection
&print_optionlist
- &get_term_width);
+ &get_term_width);
}
our @EXPORT_OK;
@@ -163,63 +163,91 @@
=item prompt
my $answer = prompt $prompt;
- my $answer = prompt $prompt, $default;
- my $answer = prompt $prompt, $default, $timeout;
+ my $answer = prompt $prompt, %options;
Ask the user a question and return the answer. The user is prompted
-via STDOUT/STDIN using $prompt (which is word-wrapped). If the user
-returns a null string or Fink is configured to automatically accept
-defaults (i.e., bin/fink was invoked with the -y or --yes option), the
-default answer $default is returned (or a null string if no $default
-is not defined). The optional $timeout argument establishes a wait
-period (in seconds) for the prompt, after which the default answer
-will be used. If a $timeout is given, any existing alarm() is
-destroyed.
+via STDOUT/STDIN using $prompt (which is word-wrapped).
+
+The %options are given as option => value pairs. The following
+options are known:
+
+ default (optional)
+
+ If the option 'default' is given, then its value will be
+ returned if no input is detected.
+
+ This can occur if the user enters a null string, or if Fink
+ is configured to automatically accept defaults (i.e., bin/fink
+ was invoked with the -y or --yes option).
+
+ Default value: null string
+
+ timeout (optional)
+
+ The 'timeout' option establishes a wait period (in seconds) for
+ the prompt, after which the default answer will be used.
+ If a timeout is given, any existing alarm() is destroyed.
+
+ Default value: no timeout
=cut
sub prompt {
my $prompt = shift;
- my $default_value = shift;
- $default_value = "" unless defined $default_value;
- my $timeout = shift || 0;
+ my %opts = (default => "", timeout => 0, @_);
- my $answer = &get_input("$prompt [$default_value]", $timeout);
+ my $answer = &get_input("$prompt [$opts{default}]", $opts{timeout});
chomp $answer;
- $answer = $default_value if $answer eq "";
+ $answer = $opts{default} if $answer eq "";
return $answer;
}
=item prompt_boolean
my $answer = prompt_boolean $prompt;
- my $answer = prompt_boolean $prompt, $default_true;
- my $answer = prompt_boolean $prompt, $default_true, $timeout;
+ my $answer = prompt_boolean $prompt, %options;
-Ask the user a yes/no question and return the logical value of the
+Ask the user a yes/no question and return the B<truth>-value of the
answer. The user is prompted via STDOUT/STDIN using $prompt (which is
-word-wrapped). If $default_true is true or undef, the default answer
-is true, otherwise it is false. If the user returns a null string or
-Fink is configured to automatically accept defaults (i.e., bin/fink
-was invoked with the -y or --yes option), the default answer is
-returned. The optional $timeout argument establishes a wait period
-(in seconds) for the prompt, after which the default answer will be
-used. If a $timeout is given, any existing alarm() is destroyed.
+word-wrapped).
+
+The %options are given as option => value pairs. The following
+options are known:
+
+ default (optional)
+
+ If the option 'default' is given, then its B<truth>-value will
be
+ returned if no input is detected.
+
+ This can occur if the user enters a null string, or if Fink
+ is configured to automatically accept defaults (i.e., bin/fink
+ was invoked with the -y or --yes option).
+
+ Default value: true
+
+ timeout (optional)
+
+ The 'timeout' option establishes a wait period (in seconds) for
+ the prompt, after which the default answer will be used.
+ If a timeout is given, any existing alarm() is destroyed.
+
+ Default value: no timeout
=cut
sub prompt_boolean {
my $prompt = shift;
- my $default_value = shift;
- $default_value = 1 unless defined $default_value;
- my $timeout = shift || 0;
+ my %opts = (default => 1, timeout => 0, @_);
my $meaning;
while (1) {
- my $answer = &get_input("$prompt [".($default_value ? "Y/n" :
"y/N")."]", $timeout);
+ my $answer = &get_input(
+ "$prompt [".($opts{default} ? "Y/n" : "y/N")."]",
+ $opts{timeout}
+ );
chomp $answer;
if ($answer eq "") {
- $meaning = $default_value;
+ $meaning = $opts{default};
last;
} elsif ($answer =~ /^y(es?)?/i) {
$meaning = 1;
@@ -233,54 +261,58 @@
return $meaning;
}
-=item prompt_selection_new
-
- my $answer = prompt_selection_new $prompt, [EMAIL PROTECTED], @choices;
-
-Compatibility during API migration. Use prompt_selection() instead.
-
-=cut
-
-sub prompt_selection_new {
- my $prompt = shift;
- my $default = shift;
- my @choices = @_;
-
- &prompt_selection($prompt, $default, [EMAIL PROTECTED]);
-}
-
=item prompt_selection
- my $answer = prompt_selection $prompt, [EMAIL PROTECTED], [EMAIL
PROTECTED];
- my $answer = prompt_selection $prompt, [EMAIL PROTECTED], [EMAIL
PROTECTED], $timeout;
+ my $answer = prompt_selection $prompt, %options;
Ask the user a multiple-choice question and return the answer. The
user is prompted via STDOUT/STDIN using $prompt (which is
word-wrapped) and a list of choices. The choices are numbered
-(beginning with 1) and the user selects by number. The list @choices
-is an ordered pairwise list (label1,value1,label2,value2,...). If the
-user returns a null string or Fink is configured to automatically
-accept defaults (i.e., bin/fink was invoked with the -y or --yes
-option), the default answer is used according to the following:
-
- @default = undef; # choice 1
- @default = []; # choice 1
- @default = ["number", $number]; # choice $number
- @default = ["label", $label]; # first choice with label $label
- @default = ["value", $label]; # first choice with value $value
+(beginning with 1) and the user selects by number.
-The optional $timeout argument establishes a wait period (in seconds)
-for the prompt, after which the default answer will be used. If a
-$timeout is given, any existing alarm() is destroyed.
+The %options are given as option => value pairs. The following
+options are known:
+
+ choices (required)
+
+ The option 'choices' must be a reference to an ordered pairwise
+ array [ label1 => value1, label2 => value2, ... ]. The labels
will
+ be displayed to the user; the values are the return values if
that
+ option is chosen.
+
+ default (optional)
+
+ If the option 'default' is given, then it determines which
choice
+ will be returned if no input is detected.
+
+ This can occur if the user enters a null string, or if Fink
+ is configured to automatically accept defaults (i.e., bin/fink
+ was invoked with the -y or --yes option).
+
+ The following formats are recognized for the 'default' option:
+
+ @default = []; # choice 1
+ @default = ["number", $number]; # choice $number
+ @default = ["label", $label]; # first choice with label
$label
+ @default = ["value", $label]; # first choice with value
$value
+
+ Default value: choice 1
+
+ timeout (optional)
+
+ The 'timeout' option establishes a wait period (in seconds) for
+ the prompt, after which the default answer will be used.
+ If a timeout is given, any existing alarm() is destroyed.
+
+ Default value: no timeout
=cut
sub prompt_selection {
my $prompt = shift;
- my $default = shift;
- my $choices = shift;
- my @choices = @$choices;
- my $timeout = shift || 0;
+ my %opts = (default => [], timeout => 0, @_);
+ my @choices = @{$opts{choices}};
+ my $default = $opts{default};
my ($count, $answer, $default_value);
@@ -317,7 +349,7 @@
$default_value = 1 if !defined $default_value;
print "\n\n";
- $answer = &get_input("$prompt [$default_value]", $timeout);
+ $answer = &get_input("$prompt [$default_value]", $opts{timeout});
chomp($answer);
if (!$answer) {
$answer = 0;
Index: SelfUpdate.pm
===================================================================
RCS file: /cvsroot/fink/fink/perlmod/Fink/SelfUpdate.pm,v
retrieving revision 1.30.2.9
retrieving revision 1.30.2.10
diff -u -d -r1.30.2.9 -r1.30.2.10
--- SelfUpdate.pm 1 Feb 2005 03:19:58 -0000 1.30.2.9
+++ SelfUpdate.pm 9 Feb 2005 01:44:17 -0000 1.30.2.10
@@ -24,7 +24,7 @@
package Fink::SelfUpdate;
use Fink::Services qw(&execute &version_cmp);
-use Fink::CLI qw(&print_breaking &prompt &prompt_boolean
&prompt_selection_new);
+use Fink::CLI qw(&print_breaking &prompt &prompt_boolean &prompt_selection);
use Fink::Config qw($config $basepath $distribution binary_requested);
use Fink::NetAccess qw(&fetch_url);
use Fink::Engine;
@@ -86,11 +86,13 @@
# if the fink.conf setting is not there.
if ((! defined($config->param("SelfUpdateMethod") )) and $useopt == 0){
&print_breaking("fink needs you to choose a SelfUpdateMethod.
\n");
- $answer = &prompt_selection_new("Choose an update method",
- [ value => "rsync" ],
- ( "rsync" => "rsync",
+ $answer = &prompt_selection("Choose an update method",
+ default => [ value => "rsync" ],
+ choices => [
+ "rsync" => "rsync",
"cvs" => "cvs",
- "Stick to point releases" =>
"point" ) );
+ "Stick to point releases" =>
"point"
+ ] );
$config->set_param("SelfUpdateMethod", $answer);
$config->save();
}
@@ -125,7 +127,7 @@
$answer =
&prompt_boolean("The current selfupdate method is
$selfupdatemethod. "
. "Do you wish to change the default
selfupdate method ".
- "to rsync?",1);
+ "to rsync?", default => 1);
if (! $answer) {
return;
}
@@ -139,7 +141,7 @@
$answer =
&prompt_boolean("The current selfupdate method is
$selfupdatemethod. "
. "Do you wish to change the default
selfupdate method ".
- "to cvs?",1);
+ "to cvs?", default => 1);
if (! $answer) {
return;
}
@@ -208,7 +210,7 @@
"descriptions to be edited and updated without
becoming ".
"root. Please specify the user login name that
should be ".
"used:",
- $username);
+ default => $username);
# sanity check
@testlist = getpwnam($username);
Index: NetAccess.pm
===================================================================
RCS file: /cvsroot/fink/fink/perlmod/Fink/NetAccess.pm,v
retrieving revision 1.23.2.6
retrieving revision 1.23.2.7
diff -u -d -r1.23.2.6 -r1.23.2.7
--- NetAccess.pm 1 Feb 2005 03:19:58 -0000 1.23.2.6
+++ NetAccess.pm 9 Feb 2005 01:44:16 -0000 1.23.2.7
@@ -203,11 +203,15 @@
"Expected:
$checksum \nActual: $found_archive_sum \n";
}
}
- $result = &prompt_selection_new("The file \"$file\" already
exists".$checksum_msg."How do you want to proceed?",
- [ value => $default_value ],
- ( "Delete it and download
again" => "retry",
- "Assume it is a partial
download and try to continue" => "continue",
- "Don't download, use existing
file" => "use_it" ) );
+ $result = &prompt_selection(
+ "The file \"$file\" already exists".$checksum_msg."How
do you want to proceed?",
+ default => [ value => $default_value ],
+ choices => [
+ "Delete it and download again" => "retry",
+ "Assume it is a partial download and try to
continue" => "continue",
+ "Don't download, use existing file" => "use_it"
+ ]
+ );
if ($result eq "retry") {
rm_f $file;
} elsif ($result eq "continue") {
Index: Mirror.pm
===================================================================
RCS file: /cvsroot/fink/fink/perlmod/Fink/Mirror.pm,v
retrieving revision 1.8.4.6
retrieving revision 1.8.4.7
diff -u -d -r1.8.4.6 -r1.8.4.7
--- Mirror.pm 1 Feb 2005 03:19:58 -0000 1.8.4.6
+++ Mirror.pm 9 Feb 2005 01:44:16 -0000 1.8.4.7
@@ -24,7 +24,7 @@
package Fink::Mirror;
use Fink::Services qw(&read_properties &read_properties_multival_var
&read_properties_multival);
-use Fink::CLI qw(&prompt_selection_new);
+use Fink::CLI qw(&prompt_selection);
use Fink::Config qw($config $libpath);
use strict;
@@ -318,9 +318,9 @@
"retry-next" => $nexttext );
my @choices = map { ( $choices{$_} => $_ ) } @choice_list;
$result =
- &prompt_selection_new("How do you want to proceed?",
- [ number => $default ],
- @choices );
+ &prompt_selection("How do you want to proceed?",
+ default => [ number => $default ],
+ choices => [EMAIL PROTECTED] );
}
$url = $self->{lastused};
if ($result eq "error") {
Index: Services.pm
===================================================================
RCS file: /cvsroot/fink/fink/perlmod/Fink/Services.pm,v
retrieving revision 1.45.2.12
retrieving revision 1.45.2.13
diff -u -d -r1.45.2.12 -r1.45.2.13
--- Services.pm 1 Feb 2005 18:01:51 -0000 1.45.2.12
+++ Services.pm 9 Feb 2005 01:44:17 -0000 1.45.2.13
@@ -186,8 +186,8 @@
Any unknown/invalid syntax.
- Reaching the end of @lines while a heredoc multiline value is still
- open.
+ Reaching the end of @lines while a heredoc multiline value is
+ still open.
Note that no check is made for the validity of the fields being in the
file in which they were encountered. The filetype (fink.conf, *.info,
@@ -344,13 +344,14 @@
Multiline values are can only be given in RFC-822 style notation,
not with heredoc.
- No sanity-checking is performed. Lines that could not be parsed are
- silently ignored.
+ No sanity-checking is performed. Lines that could not be parsed
+ are silently ignored.
Multiple occurances of a field are allowed.
- Each hash value is a ref to a list of key values instead of a simple
- value string. The list is in the order the values appear in @lines.
+ Each hash value is a ref to a list of key values instead of a
+ simple value string. The list is in the order the values appear in
+ @lines.
=cut
@@ -419,8 +420,8 @@
nonroot_okay
If the value of the option 'nonroot_okay' is true, fink was
- run with the --build-as-nobody flag, drop to user=nobody when
- running the actual commands.
+ run with the --build-as-nobody flag, drop to user=nobody
+ when running the actual commands.
delete_tempfile
@@ -430,7 +431,8 @@
-1 Always delete
0 (or not passed)
- Delete if script was successful, do not delete if it failed
+ Delete if script was successful, do not delete if
+ it failed
1 Never delete
@@ -858,7 +860,7 @@
return $latest;
}
-=item sort_versions {
+=item sort_versions
my @sorted = sort_versions @versionstrings;
@@ -1324,8 +1326,8 @@
[ \&function, @params ]
- In this form, a call will be made to function &function (unblessed
- CODE ref), that is, &$function(@params).
+ In this form, a call will be made to function &function
+ (unblessed CODE ref), that is, &$function(@params).
In both cases, the thing is called with parameter list @params (if
given, otherwise an empty list). Return values are discarded. The lis
Index: Bootstrap.pm
===================================================================
RCS file: /cvsroot/fink/fink/perlmod/Fink/Bootstrap.pm,v
retrieving revision 1.26.2.11
retrieving revision 1.26.2.12
diff -u -d -r1.26.2.11 -r1.26.2.12
--- Bootstrap.pm 1 Feb 2005 18:01:48 -0000 1.26.2.11
+++ Bootstrap.pm 9 Feb 2005 01:44:16 -0000 1.26.2.12
@@ -312,7 +312,7 @@
my ($bsbase, $save_path);
my ($pkgname, $package, @elist);
my @plist = ("gettext", "tar", "dpkg-bootstrap");
- my @addlist = ("apt", "apt-shlibs", "storable-pm", "bzip2-dev",
"gettext-dev", "gettext-bin", "libiconv-dev", "ncurses-dev");
+ my @addlist = ("apt", "apt-shlibs", "storable-pm", "bzip2-dev",
"gettext-dev", "gettext-bin", "libiconv-dev", "libncurses5");
if ("$]" == "5.006") {
push @addlist, "storable-pm560", "file-spec-pm",
"test-harness-pm", "test-simple-pm";
} elsif ("$]" == "5.006001") {
@@ -355,7 +355,6 @@
# determine essential packages
@elist = Fink::Package->list_essential_packages();
-
print "\n";
&print_breaking("BOOTSTRAP PHASE ONE: download tarballs.");
print "\n";
@@ -655,7 +654,7 @@
}
if (-e "$bpath/fink/dists/$destination/$package.info") {
# if (-e "$bpath/fink/dists/$destination/$package.info.bak") {
-# my $answer = &prompt_boolean("\nWARNING: The file
$bpath/fink/dists/$destination/$package.info.bak exists and will be
overwritten. Do you wish to continue?", 1);
+# my $answer = &prompt_boolean("\nWARNING: The file
$bpath/fink/dists/$destination/$package.info.bak exists and will be
overwritten. Do you wish to continue?", default => 1);
# if (not $answer) {
# die "\nOK, you can re-run ./inject.pl after
moving the file.\n\n";
# }
Index: ChangeLog
===================================================================
RCS file: /cvsroot/fink/fink/perlmod/Fink/ChangeLog,v
retrieving revision 1.305.2.43
retrieving revision 1.305.2.44
diff -u -d -r1.305.2.43 -r1.305.2.44
--- ChangeLog 4 Feb 2005 02:41:42 -0000 1.305.2.43
+++ ChangeLog 9 Feb 2005 01:44:16 -0000 1.305.2.44
@@ -1,3 +1,48 @@
+2005-02-08 Daniel Macks <[EMAIL PROTECTED]>
+
+ * Engine.pm: Fix plural in package count msg.
+ * Configure.pm: Rework proxy prompting: consolidate whole msg into
+ $prompt, add note about value visibility, clean up variable usage.
+ Ignore whitespace in answers. Add msg if skipping UseBinaryDist.
+
+2005-02-08 Daniel Macks <[EMAIL PROTECTED]>
+
+ * CLI.pm: don't export obsoleted prompt_selection_new
+ * PkgVersion.pm: fixed a prompt*() API-change straggler.
+
+2005-02-08 Dave Vasilevsky <[EMAIL PROTECTED]>
+
+ * CLI.pm: Rename prompt_selction_new prompt_selection. Switch
+ prompt, prompt_boolean, and prompt_selection to use named
+ parameters.
+ * *.pm: Adjust prompt*() calls for new API.
+
+2005-02-06 Justin F. Hallett <[EMAIL PROTECTED]>
+
+ * Bootstrap.pm: Replacing ncurses with libncurses5 for bootstraping
+
+2005-02-06 Daniel Macks <[EMAIL PROTECTED]>
+
+ * PkgVersion.pm: Fix .deb-creation error checking.
+
+2005-02-05 Daniel Macks <[EMAIL PROTECTED]>
+
+ * Engine.pm: ...which it now does, so reviving it
+
+2005-02-05 Justin F. Hallett <[EMAIL PROTECTED]>
+
+ * Engine.pm: backing out last change till it's complete and works
+
+2005-02-05 Daniel Macks <[EMAIL PROTECTED]>
+
+ * Engine.pm: first arg to process() is ref to original @ARGV not
+ scalar concat of canonical getopt flags. First restart_as_root arg
+ is no longer handled as specially-preprocessed text.
+
+2005-02-05 Daniel Macks <[EMAIL PROTECTED]>
+
+ * Engine.pm: Alphabetize and remove duplicates in output of show-deps.
+
2005-02-03 Justin F. Hallett <[EMAIL PROTECTED]>
* shilbs branch is now fully working and merged to head.
Index: Configure.pm
===================================================================
RCS file: /cvsroot/fink/fink/perlmod/Fink/Configure.pm,v
retrieving revision 1.14.4.6
retrieving revision 1.14.4.7
diff -u -d -r1.14.4.6 -r1.14.4.7
--- Configure.pm 1 Feb 2005 03:19:57 -0000 1.14.4.6
+++ Configure.pm 9 Feb 2005 01:44:16 -0000 1.14.4.7
@@ -31,7 +31,7 @@
use Fink::Config qw($config $basepath $libpath);
use Fink::Services qw(&read_properties &read_properties_multival &filename);
-use Fink::CLI qw(&prompt &prompt_boolean &prompt_selection_new
&print_breaking);
+use Fink::CLI qw(&prompt &prompt_boolean &prompt_selection &print_breaking);
use strict;
use warnings;
@@ -101,7 +101,7 @@
sub configure {
my ($otherdir, $builddir, $verbose);
- my ($http_proxy, $ftp_proxy, $passive_ftp, $same_for_ftp, $binary_dist,
$default);
+ my ($proxy_prompt, $proxy, $passive_ftp, $same_for_ftp, $binary_dist);
print "\n";
&print_breaking("OK, I'll ask you some questions and update the ".
@@ -112,23 +112,26 @@
$otherdir =
&prompt("In what additional directory should Fink look for
downloaded ".
"tarballs?",
- $config->param_default("FetchAltDir", ""));
- if ($otherdir) {
+ default =>
$config->param_default("FetchAltDir", ""));
+ if ($otherdir =~ /\S/) {
$config->set_param("FetchAltDir", $otherdir);
}
+ print "\n";
$builddir =
&prompt("Which directory should Fink use to build packages?
\(If you don't ".
"know what this means, it is safe to leave it
at its default.\)",
- $config->param_default("Buildpath", ""));
- if ($builddir) {
+ default => $config->param_default("Buildpath",
""));
+ if ($builddir =~ /\S/) {
$config->set_param("Buildpath", $builddir);
}
+ print "\n";
$binary_dist = $config->param_boolean("UseBinaryDist");
# if we are not installed in /sw, $binary_dist must be 0:
if (not $basepath eq '/sw') {
$binary_dist = 0;
+ &print_breaking('Setting UseBinaryDist to "false". This option
can be used only when fink is installed in /sw.');
} else {
# New users should use the binary dist, but an existing user who
# is running "fink configure" should see a default answer of
"no"
@@ -144,74 +147,70 @@
}
$binary_dist =
&prompt_boolean("Should Fink try to download
pre-compiled packages from ".
- "the binary
distribution if available?", $binary_dist);
+ "the binary
distribution if available?",
+ default =>
$binary_dist);
}
$config->set_param("UseBinaryDist", $binary_dist ? "true" : "false");
$verbose = $config->param_default("Verbose", 1);
$verbose =
- &prompt_selection_new("How verbose should Fink be?",
- [value=>$verbose],
- (
+ &prompt_selection("How verbose should Fink be?",
+ default =>
[value=>$verbose],
+ choices => [
"Quiet (do not show
download statistics)" => 0,
"Low (do not show
tarballs being expanded)" => 1,
"Medium (will show
almost everything)" => 2,
"High (will show
everything)" => 3,
"Pedantic (even show
nitpicky details)" => 4
- ) );
+ ]
+ );
$config->set_param("Verbose", $verbose);
# proxy settings
print "\n";
&print_breaking("Proxy/Firewall settings");
- $default = $config->param_default("ProxyHTTP", "");
- $default = "none" unless $default;
- &print_breaking("Enter the URL of the HTTP proxy to use, or 'none' for
no proxy. ".
- "The URL should start with http:// and may contain username, ".
- "password or port specifications ".
- " E.g: http://username:[EMAIL PROTECTED]:port ");
- $http_proxy =
- &prompt("Your proxy: ".
- $default);
- if ($http_proxy =~ /^none$/i) {
- $http_proxy = "";
+ $proxy_prompt =
+ "Enter the URL of the %s proxy to use, or 'none' for no proxy.
" .
+ "The URL should start with http:// and may contain username, " .
+ "password, and/or port specifications. " .
+ "Note that this value will be visible to all users on your
computer.\n".
+ "Example, http://username:[EMAIL PROTECTED]:port\n" .
+ "Your proxy: ";
+
+ $proxy = $config->param_default("ProxyHTTP", "none");
+ $proxy = &prompt(sprintf($proxy_prompt, "HTTP"), default => $proxy);
+ if ($proxy =~ /^\s*none\s*$/i) {
+ $proxy = "";
}
- $config->set_param("ProxyHTTP", $http_proxy);
+ $config->set_param("ProxyHTTP", $proxy);
- if ($http_proxy) {
+ if (length $proxy) {
$same_for_ftp =
- &prompt_boolean("Use the same proxy server for FTP
connections?", 0);
+ &prompt_boolean("Use the same proxy server for FTP
connections?",
+ default => 0);
} else {
$same_for_ftp = 0;
}
- if ($same_for_ftp) {
- $ftp_proxy = $http_proxy;
- } else {
- $default = $config->param_default("ProxyFTP", "");
- $default = "none" unless $default;
- &print_breaking("Enter the URL of the proxy to use for FTP, ".
- "or 'none' for no proxy. ".
- "The URL should start with http:// and may
contain username," .
- "password or port specifications.".
- " E.g: ftp://username:[EMAIL PROTECTED]:port
");
- $ftp_proxy = &prompt("Your proxy:" , $default);
-
- if ($ftp_proxy =~ /^none$/i) {
- $ftp_proxy = "";
+ if (not $same_for_ftp) {
+ $proxy = $config->param_default("ProxyFTP", "none");
+ $proxy = &prompt(sprintf($proxy_prompt, "FTP"), default =>
$proxy);
+ if ($proxy =~ /^\s*none\s*$/i) {
+ $proxy = "";
}
}
- $config->set_param("ProxyFTP", $ftp_proxy);
+ $config->set_param("ProxyFTP", $proxy);
- $passive_ftp = $config->param_boolean("ProxyPassiveFTP");
- # passive FTP is the safe default
- if (!$config->has_param("ProxyPassiveFTP")) {
+ if ($config->has_param("ProxyPassiveFTP")) {
+ $passive_ftp = $config->param_boolean("ProxyPassiveFTP");
+ } else {
+ # passive FTP is the safe default
$passive_ftp = 1;
}
$passive_ftp =
&prompt_boolean("Use passive mode FTP transfers (to get through
a ".
- "firewall)?", $passive_ftp);
+ "firewall)?", default =>
$passive_ftp);
$config->set_param("ProxyPassiveFTP", $passive_ftp ? "true" : "false");
@@ -264,13 +263,16 @@
}
if (!$missing) {
if ($mirrors_postinstall) {
+ # called from dpkg postinst script of fink-mirrors pkg
print "\n";
$answer = &prompt_boolean("The list of possible mirrors
in fink has" .
- " been updated. Do you want to review and
change your choices?", 0, 60);
- } else {
- $answer =
- &prompt_boolean("All mirrors are set. Do you want to
change them?", 0);
- }
+ " been updated. Do you want to review and
change your choices?",
+ default => 0, timeout => 60);
+ } else {
+ $answer =
+ &prompt_boolean("All mirrors are set. Do you
want to change them?",
+ default => 0);
+ }
if (!$answer) {
return;
}
@@ -280,28 +282,39 @@
"the sources for all fink packages. You can
choose to use these mirrors first, ".
"last, never, or mixed in with
regular mirrors. If you don't care, just select the default.\n");
- $mirror_order = &prompt_selection_new("What mirror order should fink
use when downloading sources?",
- [ value =>
$config->param_default("MirrorOrder", "MasterFirst") ],
- ( "Search \"Master\" source
mirrors first." => "MasterFirst",
- "Search \"Master\" source
mirrors last." => "MasterLast",
- "Never use \"Master\" source
mirrors." => "MasterNever",
- "Search closest source mirrors
first. (combine all mirrors into one set)" => "ClosestFirst" ) );
+ $mirror_order = &prompt_selection(
+ "What mirror order should fink use when downloading sources?",
+ default => [ value => $config->param_default("MirrorOrder",
"MasterFirst") ],
+ choices => [
+ "Search \"Master\" source mirrors first." =>
"MasterFirst",
+ "Search \"Master\" source mirrors last." =>
"MasterLast",
+ "Never use \"Master\" source mirrors." => "MasterNever",
+ "Search closest source mirrors first. (combine all
mirrors into one set)"
+ => "ClosestFirst"
+ ]);
$config->set_param("MirrorOrder", $mirror_order);
### step 1: choose a continent
&print_breaking("Choose a continent:");
- $continent = &prompt_selection_new("Your continent?",
- [ value =>
$config->param_default("MirrorContinent", "-") ],
- map { length($_)==3 ?
($keyinfo->{$_},$_) : () } sort keys %$keyinfo);
+ $continent = &prompt_selection("Your continent?",
+ default => [ value => $config->param_default("MirrorContinent",
"-") ],
+ choices => [
+ map { length($_)==3 ? ($keyinfo->{$_},$_) : () }
+ sort keys %$keyinfo
+ ]
+ );
$config->set_param("MirrorContinent", $continent);
### step 2: choose a country
print "\n";
&print_breaking("Choose a country:");
- $country = &prompt_selection_new("Your country?",
- [ value =>
$config->param_default("MirrorCountry", $continent) ],
- ( "No selection - display all mirrors
on the continent" => $continent,
- map { /^$continent-/ ?
($keyinfo->{$_},$_) : () } sort keys %$keyinfo ) );
+ $country = &prompt_selection("Your country?",
+ default => [ value => $config->param_default("MirrorCountry",
$continent) ],
+ choices => [
+ "No selection - display all mirrors on the continent"
=> $continent,
+ map { /^$continent-/ ? ($keyinfo->{$_},$_) : () } sort
keys %$keyinfo
+ ]
+ );
$config->set_param("MirrorCountry", $country);
### step 3: mirrors
@@ -336,9 +349,9 @@
print "\n";
&print_breaking("Choose a mirror for '$mirrortitle':");
- $answer = &prompt_selection_new("Mirror for $mirrortitle?",
- [ number => 1 ],
- @mirrors );
+ $answer = &prompt_selection("Mirror for $mirrortitle?",
+ default => [ number => 1 ],
+ choices => [EMAIL PROTECTED] );
$config->set_param("Mirror-$mirrorname", $answer);
}
}
-------------------------------------------------------
SF email is sponsored by - The IT Product Guide
Read honest & candid reviews on hundreds of IT Products from real users.
Discover which products truly live up to the hype. Start reading now.
http://ads.osdn.com/?ad_id=6595&alloc_id=14396&op=click
_______________________________________________
Fink-commits mailing list
[email protected]
https://lists.sourceforge.net/lists/listinfo/fink-commits
