summaryrefslogtreecommitdiffstats
path: root/perl-install
diff options
context:
space:
mode:
authorPascal Rigaux <pixel@mandriva.com>2001-01-07 16:53:29 +0000
committerPascal Rigaux <pixel@mandriva.com>2001-01-07 16:53:29 +0000
commit597fbc897b288e62ddafaf38acf861bb8ff62f91 (patch)
tree8df4c9b284daf10ec2ca18bdc17d2a6069eb007d /perl-install
parent363a685fd8eb8386e234d12fd6c591342d1060cd (diff)
downloaddrakx-597fbc897b288e62ddafaf38acf861bb8ff62f91.tar
drakx-597fbc897b288e62ddafaf38acf861bb8ff62f91.tar.gz
drakx-597fbc897b288e62ddafaf38acf861bb8ff62f91.tar.bz2
drakx-597fbc897b288e62ddafaf38acf861bb8ff62f91.tar.xz
drakx-597fbc897b288e62ddafaf38acf861bb8ff62f91.zip
update code for new ask_from_entries_refH which doesn't handle optional ok/cancel names in arg 1.
must be handled via ask_from_entries_refH_powered
Diffstat (limited to 'perl-install')
-rw-r--r--perl-install/any.pm16
-rw-r--r--perl-install/install_steps_interactive.pm65
-rw-r--r--perl-install/interactive.pm33
-rw-r--r--perl-install/printerdrake.pm28
4 files changed, 84 insertions, 58 deletions
diff --git a/perl-install/any.pm b/perl-install/any.pm
index 184642794..fe9d05282 100644
--- a/perl-install/any.pm
+++ b/perl-install/any.pm
@@ -217,13 +217,15 @@ arch() !~ /sparc/ ? (
{ label => _("Default"), val => \$default, type => 'bool' },
);
- if ($in->ask_from_entries_refH($c eq "Add" ? '' : ['', _("Ok"), _("Remove entry")],
- '', \@l,
- complete => sub {
- $e->{label} or $in->ask_warn('', _("Empty label not allowed")), return 1;
- member($e->{label}, map { $_->{label} } grep { $_ != $e } @{$b->{entries}}) and $in->ask_warn('', _("This label is already used")), return 1;
- 0;
- })) {
+ if ($in->ask_from_entries_refH_powered(
+ {
+ if_($c ne "Add", cancel => _("Remove entry")),
+ callbacks => {
+ complete => sub {
+ $e->{label} or $in->ask_warn('', _("Empty label not allowed")), return 1;
+ member($e->{label}, map { $_->{label} } grep { $_ != $e } @{$b->{entries}}) and $in->ask_warn('', _("This label is already used")), return 1;
+ 0;
+ } } }, \@l)) {
$b->{default} = $old_default || $default ? $default && $e->{label} : $b->{default};
$e->{vga} = $bootloader::vga_modes{$e->{vga}} || $e->{vga};
require bootloader;
diff --git a/perl-install/install_steps_interactive.pm b/perl-install/install_steps_interactive.pm
index 2c3ec982a..73f738f69 100644
--- a/perl-install/install_steps_interactive.pm
+++ b/perl-install/install_steps_interactive.pm
@@ -151,8 +151,7 @@ For any question on this document, please contact MandrakeSoft S.A.
sub selectKeyboard($) {
my ($o, $clicked) = @_;
- $o->ask_from_entries_refH(
- _("Keyboard"),
+ $o->ask_from_entries_refH(_("Keyboard"),
_("Please, choose your keyboard layout."),
[ { val => \$o->{keyboard}, type => 'list',
format => sub { translate(keyboard::keyboard2text($_[0])) },
@@ -753,8 +752,18 @@ sub setRootPassword {
if_($o->{installClass} =~ "server" || $::expert, "setRootPasswordMd5"),
if_(!$::beginner, "setRootPasswordNIS"));
- $o->ask_from_entries_refH([_("Set root password"), _("Ok"), if_($o->{security} <= 2 && !$::corporate, _("No password"))],
- [ _("Set root password"), "\n" ], [
+ $o->ask_from_entries_refH_powered(
+ {
+ title => _("Set root password"),
+ messages => _("Set root password"),
+ cancel => ($o->{security} <= 2 && !$::corporate ? _("No password") : ''),
+ callbacks => {
+ complete => sub {
+ $sup->{password} eq $sup->{password2} or $o->ask_warn('', [ _("The passwords do not match"), _("Please try again") ]), return (1,1);
+ length $sup->{password} < 2 * $o->{security}
+ and $o->ask_warn('', _("This password is too simple (must be at least %d characters long)", 2 * $o->{security})), return (1,0);
+ return 0
+ } } }, [
{ label => _("Password"), val => \$sup->{password}, hidden => 1 },
{ label => _("Password (again)"), val => \$sup->{password2}, hidden => 1 },
if_($o->{installClass} eq "server" || $::expert,
@@ -762,15 +771,8 @@ sub setRootPassword {
{ label => _("Use MD5 passwords"), val => \$o->{authentication}{md5}, type => 'bool', text => _("MD5") },
), if_(!$::beginner,
{ label => _("Use NIS"), val => \$nis, type => 'bool', text => _("yellow pages") },
- )
- ],
- complete => sub {
- $sup->{password} eq $sup->{password2} or $o->ask_warn('', [ _("The passwords do not match"), _("Please try again") ]), return (1,1);
- length $sup->{password} < 2 * $o->{security}
- and $o->ask_warn('', _("This password is too simple (must be at least %d characters long)", 2 * $o->{security})), return (1,0);
- return 0
- }
- ) or return;
+ ),
+ ]) or return;
$o->{authentication}{NIS} &&= $nis;
$o->ask_from_entries_refH('',
@@ -798,10 +800,26 @@ sub addUser {
if (($o->{security} >= 1 || $clicked)) {
$u->{icon} = translate($u->{icon});
- if ($o->ask_from_entries_refH(
- [ _("Add user"), _("Accept user"), if_($o->{security} < 4 || @{$o->{users}}, _("Done")) ],
- _("Enter a user\n%s", $o->{users} ? _("(already added %s)", join(", ", map { $_->{realname} || $_->{name} } @{$o->{users}})) : ''),
- [
+ if ($o->ask_from_entries_refH_powered(
+ { title => _("Add user"),
+ messages => _("Enter a user\n%s", $o->{users} ? _("(already added %s)", join(", ", map { $_->{realname} || $_->{name} } @{$o->{users}})) : ''),
+ ok => _("Accept user"),
+ cancel => ($o->{security} < 4 || @{$o->{users}} ? _("Done") : ''),
+ callbacks => {
+ focus_out => sub {
+ if ($_[0] eq 0) {
+ $u->{name} ||= lc first($u->{realname} =~ /((\w|-)+)/);
+ }
+ },
+ complete => sub {
+ $u->{password} eq $u->{password2} or $o->ask_warn('', [ _("The passwords do not match"), _("Please try again") ]), return (1,2);
+ $o->{security} > 3 && length($u->{password}) < 6 and $o->ask_warn('', _("This password is too simple")), return (1,2);
+ $u->{name} or $o->ask_warn('', _("Please give a user name")), return (1,0);
+ $u->{name} =~ /^[a-z0-9_-]+$/ or $o->ask_warn('', _("The user name must contain only lower cased letters, numbers, `-' and `_'")), return (1,0);
+ member($u->{name}, map { $_->{name} } @{$o->{users}}) and $o->ask_warn('', _("This user name is already added")), return (1,0);
+ return 0;
+ },
+ } }, [
{ label => _("Real name"), val => \$u->{realname} },
{ label => _("User name"), val => \$u->{name} },
if_($o->{security} >= 2,
@@ -813,19 +831,6 @@ sub addUser {
{ label => _("Icon"), val => \$u->{icon}, list => [ any::facesnames($o->{prefix}) ], icon2f => sub { any::face2xpm($_[0], $o->{prefix}) } },
),
],
- focus_out => sub {
- if ($_[0] eq 0) {
- $u->{name} ||= lc first($u->{realname} =~ /((\w|-)+)/);
- }
- },
- complete => sub {
- $u->{password} eq $u->{password2} or $o->ask_warn('', [ _("The passwords do not match"), _("Please try again") ]), return (1,2);
- $o->{security} > 3 && length($u->{password}) < 6 and $o->ask_warn('', _("This password is too simple")), return (1,2);
- $u->{name} or $o->ask_warn('', _("Please give a user name")), return (1,0);
- $u->{name} =~ /^[a-z0-9_-]+$/ or $o->ask_warn('', _("The user name must contain only lower cased letters, numbers, `-' and `_'")), return (1,0);
- member($u->{name}, map { $_->{name} } @{$o->{users}}) and $o->ask_warn('', _("This user name is already added")), return (1,0);
- return 0;
- },
)) {
push @{$o->{users}}, $o->{user};
$o->{user} = {};
diff --git a/perl-install/interactive.pm b/perl-install/interactive.pm
index ba013028a..a99b172ff 100644
--- a/perl-install/interactive.pm
+++ b/perl-install/interactive.pm
@@ -123,7 +123,7 @@ sub ask_from_listf_no_check {
my ($o, $title, $message, $f, $l, $def, $help) = @_;
if (@$l <= 2) {
- ask_from_entries_refH_powered($o, { title => $title, messages => [ deref($message) ], ok => may_apply($f, $l->[0]), cancel => may_apply($f, $l->[1]) }, [])
+ ask_from_entries_refH_powered_no_check($o, { title => $title, messages => $message, ok => $l->[0] && may_apply($f, $l->[0]), cancel => $l->[1] && may_apply($f, $l->[1]) }, [])
? $l->[0] : $l->[1];
} else {
ask_from_entries_refH($o, $title, $message, [ { val => \$def, type => 'list', list => $l, help => $help, format => $f } ]);
@@ -196,15 +196,13 @@ sub ask_from_entries {
#- if you pass a hash with a field hidden -> emulate stty -echo
sub ask_from_entries_refH {
my ($o, $title, $message, $l, %callback) = @_;
-
- return unless @$l;
- ask_from_entries_refH_powered($o, { title => $title, messages => [ deref($message) ], callbacks => \%callback }, $l);
+ ask_from_entries_refH_powered($o, { title => $title, messages => $message, callbacks => \%callback }, $l);
}
-sub ask_from_entries_refH_powered {
+
+sub ask_from_entries_refH_powered_normalize {
my ($o, $common, $l) = @_;
- #- normalize
foreach my $e (@$l) {
if (my $l = $e->{list}) {
if ($e->{sort} || @$l > 10 && !$e->{sort}) {
@@ -221,12 +219,29 @@ sub ask_from_entries_refH_powered {
${$e->{val}} = max($e->{min}, min(${$e->{val}}, $e->{max}));
}
}
+
+ #- don't display empty lists
+ @$l = grep { !($_->{list} && @{$_->{list}} == () && $_->{not_edit}) } @$l;
+
+ $common->{messages} = [ deref($common->{messages}) ];
+ add2hash_($common, { ok => _("Ok"), cancel => _("Cancel") }) if !exists $common->{ok};
add2hash_($common->{callbacks} ||= {}, { changed => sub {}, focus_out => sub {}, complete => sub { 0 } });
- $o->ask_from_entries_refW($common,
- [ grep { !$_->{advanced} } @$l ],
- [ grep { $_->{advanced} } @$l ])
+}
+sub ask_from_entries_refH_powered {
+ my ($o, $common, $l) = @_;
+ ask_from_entries_refH_powered_normalize($o, $common, $l);
+ $o->ask_from_entries_refW($common, [ grep { !$_->{advanced} } @$l ], [ grep { $_->{advanced} } @$l ]);
+ 1;
+}
+sub ask_from_entries_refH_powered_no_check {
+ my ($o, $common, $l) = @_;
+ ask_from_entries_refH_powered_normalize($o, $common, $l);
+ @$l or return 1;
+ $o->ask_from_entries_refW($common, [ grep { !$_->{advanced} } @$l ], [ grep { $_->{advanced} } @$l ]);
}
+
+
sub wait_message {
my ($o, $title, $message, $temp) = @_;
diff --git a/perl-install/printerdrake.pm b/perl-install/printerdrake.pm
index af7c592f9..d78aed3bb 100644
--- a/perl-install/printerdrake.pm
+++ b/perl-install/printerdrake.pm
@@ -437,17 +437,18 @@ and optionally the port number."), [
return; #- exit printer configuration, here is another hack for simplification.
}
$in->set_help('configurePrinterLocal') if $::isInstall;
- $in->ask_from_entries_refH([_("Select Printer Connection"), _("Ok"),
- $::beginner || !$printer->{configured}{$printer->{QUEUE}} ? () : _("Remove queue")],
+ $in->ask_from_entries_refH_powered(
+ { title => _("Select Printer Connection"),
+ cancel => $::beginner || !$printer->{configured}{$printer->{QUEUE}} ? '' : _("Remove queue"),
+ messages =>
_("Every printer need a name (for example lp).
Other parameters such as the description of the printer or its location
can be defined. What name should be used for this printer and
-how is the printer connected?"), [
+how is the printer connected?") }, [
{ label => _("Name of printer"), val => \$printer->{QUEUE} },
{ label => _("Description"), val => \$printer->{Info} },
{ label => _("Location"), val => \$printer->{Location} },
- ],
- ) or printer::remove_queue($printer), $continue = 1, last;
+ ]) or printer::remove_queue($printer), $continue = 1, last;
} else {
if ($::beginner) {
$printer->{str_type} = $in->ask_from_list_(_("Select Printer Connection"),
@@ -457,18 +458,21 @@ how is the printer connected?"), [
);
} else {
$in->set_help('configurePrinterLPR') if $::isInstall;
- $in->ask_from_entries_refH([_("Select Printer Connection"), _("Ok"), $::beginner ? () : _("Remove queue")],
+ $in->ask_from_entries_refH_powered(
+ { title => _("Select Printer Connection"),
+ cancel => $::beginner ? '' : _("Remove queue"),
+ messages =>
_("Every print queue (which print jobs are directed to) needs a
name (often lp) and a spool directory associated with it. What
-name and directory should be used for this queue and how is the printer connected?"), [
+name and directory should be used for this queue and how is the printer connected?"),
+ callbacks => { changed => sub {
+ $printer->{SPOOLDIR} = printer::default_spooldir($printer) unless $_[0];
+ } }
+ }, [
{ label => _("Name of queue"), val => \$printer->{QUEUE} },
{ label => _("Spool directory"), val => \$printer->{SPOOLDIR} },
{ label => _("Printer Connection"), val => \$printer->{str_type}, list => [ printer::printer_type($printer) ] },
- ],
- changed => sub {
- $printer->{SPOOLDIR} = printer::default_spooldir($printer) unless $_[0];
- }
- ) or printer::remove_queue($printer), $continue = 1, last;
+]) or printer::remove_queue($printer), $continue = 1, last;
}
$printer->{TYPE} = $printer::printer_type{$printer->{str_type}};
}