package mirror; # $Id$ use diagnostics; use strict; use feature 'state'; use common; use log; my %land2tzs = ( N_("Australia") => [ 'Australia/Sydney' ], N_("Austria") => [ 'Europe/Vienna', 'Europe/Brussels', 'Europe/Berlin' ], N_("Belgium") => [ 'Europe/Brussels', 'Europe/Paris', 'Europe/Berlin' ], N_("Brazil") => [ 'Brazil/East' ], N_("Canada") => [ 'Canada/Atlantic', 'Canada/Eastern' ], N_("Costa Rica") => [ 'America/Costa_Rica' ], N_("Czech Republic") => [ 'Europe/Prague', 'Europe/Berlin' ], N_("Denmark") => [ 'Europe/Copenhagen', 'Europe/Berlin' ], N_("Estonia") => [ 'Europe/Tallinn', 'Europe/Helsinki' ], N_("Finland") => [ 'Europe/Helsinki', 'Europe/Tallinn' ], N_("France") => [ 'Europe/Paris', 'Europe/Brussels', 'Europe/Berlin' ], N_("Germany") => [ 'Europe/Berlin', 'Europe/Prague' ], N_("Greece") => [ 'Europe/Athens', 'Europe/Prague' ], N_("Hungary") => [ 'Europe/Budapest' ], N_("Ireland") => [ 'Europe/Dublin', 'Europe/London' ], N_("Israel") => [ 'Asia/Tel_Aviv' ], N_("Italy") => [ 'Europe/Rome', 'Europe/Brussels', 'Europe/Paris' ], N_("Japan") => [ 'Asia/Tokyo', 'Asia/Seoul' ], N_("Netherlands") => [ 'Europe/Amsterdam', 'Europe/Brussels', 'Europe/Berlin' ], N_("New Zealand") => [ 'Pacific/Auckland' ], N_("Norway") => [ 'Europe/Oslo', 'Europe/Stockholm' ], N_("Poland") => [ 'Europe/Warsaw' ], N_("Portugal") => [ 'Europe/Lisbon', 'Europe/Madrid' ], N_("Russia") => [ 'Europe/Moscow', ], N_("Slovakia") => [ 'Europe/Bratislava' ], N_("South Africa") => [ 'Africa/Johannesburg' ], N_("Spain") => [ 'Europe/Madrid', 'Europe/Lisbon' ], N_("Sweden") => [ 'Europe/Stockholm', 'Europe/Oslo' ], N_("Switzerland") => [ 'Europe/Zurich', 'Europe/Berlin', 'Europe/Brussels' ], N_("Taiwan") => [ 'Asia/Taipei', 'Asia/Seoul' ], N_("Thailand") => [ 'Asia/Bangkok', 'Asia/Seoul' ], N_("United States") => [ 'America/New_York', 'Canada/Atlantic', 'Asia/Tokyo', 'Australia/Sydney', 'Europe/Paris' ], ); sub mirror2text { my ($mirror) = @_; translate($mirror->{country}) . '|' . $mirror->{host} . ($mirror->{method} ? " ($mirror->{method})" : ''); } my $downloader; sub register_downloader { my ($func) = @_; $downloader = $func; } sub mirrors_raw { my ($product_id) = @_; #- contact the following URL to retrieve the list of mirrors. #- http://wiki.mandriva.com/en/Product_id my $type = lc($product_id->{type}); $type =~ s/\s//g; my $list = "http://api.mandriva.com/mirrors/$type.$product_id->{version}.$product_id->{arch}.list?product=$product_id->{product}"; log::explanations("trying mirror list from $list"); my @lines; if ($::isInstall) { require install::http; my $f = install::http::getFile($list) or die "mirror list not found"; local $SIG{ALRM} = sub { die "timeout" }; alarm 60; log::l("using mirror list $list"); push @lines, $_ while <$f>; install::http::close(); alarm 0; } else { if (ref($downloader)) { @lines = $downloader->($list); @lines or die "mirror list not found"; } else { die "Missing download callback"; } } map { common::parse_LDAP_namespace_structure(chomp_($_)) } @lines; } sub list { my ($product_id, $type) = @_; our @mirrors_raw; if (!@mirrors_raw) { @mirrors_raw = eval { mirrors_raw($product_id) }; if (my $err = $@) { log::explanations("failed to download mirror list"); die $err; } @mirrors_raw or log::explanations("empty mirror list"), return; } my @mirrors = grep { ($_->{method}, $_->{host}, $_->{dir}) = $_->{url} =~ m!^(ftp|http)://(.*?)(/.*)!; $_->{method} && ($type eq 'all' || $_->{type} eq $type); } @mirrors_raw or log::explanations("no mirrors of type $type"), return; @mirrors && \@mirrors; } sub nearest { my ($timezone, $mirrors) = @_; my (@country, @zone); foreach my $mirror (@$mirrors) { my @tzs = @{$land2tzs{$mirror->{country}} || []}; eval { push @{$country[find_index { $_ eq $timezone } @tzs]}, $mirror }; eval { push @{$zone[find_index { ((split '/')[0] eq (split '/', $timezone)[0]) } @tzs]}, $mirror }; } my @l = @country ? @country : @zone; shift @l while !$l[0] && @l; my @possible = @l ? ((@{$l[0]}) x 2, @{$l[1] || []}) : @$mirrors; $possible[rand @possible]; } 1; c211464d525a87218f7'>refslogtreecommitdiffstats
path: root/perl-install/standalone
diff options
context:
space:
mode:
authorPascal Rigaux <pixel@mandriva.com>2003-08-19 19:20:27 +0000
committerPascal Rigaux <pixel@mandriva.com>2003-08-19 19:20:27 +0000
commit47193590cbe2f3c1de7bac211464d525a87218f7 (patch)
tree0efaeec65179b7883c9dae1d9ab38cf86e5a8f6e /perl-install/standalone
parent6a5b9c63cb02eec0406d8b726a8c25ab6726623c (diff)
downloaddrakx-47193590cbe2f3c1de7bac211464d525a87218f7.tar
drakx-47193590cbe2f3c1de7bac211464d525a87218f7.tar.gz
drakx-47193590cbe2f3c1de7bac211464d525a87218f7.tar.bz2
drakx-47193590cbe2f3c1de7bac211464d525a87218f7.tar.xz
drakx-47193590cbe2f3c1de7bac211464d525a87218f7.zip
perl_checker compliance
Diffstat (limited to 'perl-install/standalone')
-rwxr-xr-xperl-install/standalone/drakautoinst18
-rw-r--r--perl-install/standalone/drakhelp2
-rwxr-xr-xperl-install/standalone/drakperm5
3 files changed, 13 insertions, 12 deletions
diff --git a/perl-install/standalone/drakautoinst b/perl-install/standalone/drakautoinst
index f181d1e97..25eca63c2 100755
--- a/perl-install/standalone/drakautoinst
+++ b/perl-install/standalone/drakautoinst
@@ -118,7 +118,7 @@ if (!$::isEmbedded && $in->isa('interactive::gtk')) {
wacom => '',
);
- member($_, keys %struct_gui) and push @{$tree{$struct_gui{$_}}}, [ $_ , $pixmap{$_}, h2widget($o->{$_}, "\$o->\{$_\}") ] foreach keys %$o;
+ member($_, keys %struct_gui) and push @{$tree{$struct_gui{$_}}}, [ $_ , $pixmap{$_}, h2widget($o->{$_}, "\$o->\{$_}") ] foreach keys %$o;
my $W = ugtk2->new('$o edition');
my @box_to_hide;
@@ -167,7 +167,7 @@ if (!$::isEmbedded && $in->isa('interactive::gtk')) {
my $local_page = $nb_pages;
my $function = sub { $notebook->set_page($local_page) };
gtksignal_connect($button, toggled => sub {
- $button->get_active() and $function->()
+ $button->get_active and $function->()
});
my $b;
if ($_->[1] ne "") { $b = gtkcreate_img($_->[1]) } else { $b = () };
@@ -258,7 +258,7 @@ sub h2widget {
$widget_list[$i] = create_packtable({ col_spacings => 10, row_spacings => 3 },
map {
my $e;
- $e = h2widget($k->{$_}, "$label\{$_\}");
+ $e = h2widget($k->{$_}, "$label\{$_}");
[ "$_ : ", $e ] } @list_keys
),
)
@@ -270,7 +270,7 @@ sub h2widget {
$field eq '' and return undef;
gtkpack__($vb,
$widget_list[$i] = create_packtable({ col_spacings => 10, row_spacings => 3 },
- [ "$field : ", h2widget($ref_local_k, "$label\{$field\}") ])
+ [ "$field : ", h2widget($ref_local_k, "$label\{$field}") ])
);
@$widget_list2 = @widget_list;
},
@@ -278,7 +278,7 @@ sub h2widget {
);
} else {
$w = create_packtable({ col_spacings => 10, row_spacings => 3 },
- map { create_entry_element($k->{$_}, "$label\{$_\}", $_) } @list_keys
+ map { create_entry_element($k->{$_}, "$label\{$_}", $_) } @list_keys
)
}
} elsif (ref($k) =~ /ARRAY/) {
@@ -288,13 +288,13 @@ sub h2widget {
$w = gtkpack_(new Gtk2::VBox(0,0),
1, create_scrolled_window(
gtkpack__($vb = new Gtk2::VBox(0,5),
- map { $i++; $widget_list[$i] = h2widget($_, "$label\[$i\]") } @$k,
+ map { $i++; $widget_list[$i] = h2widget($_, "$label\[$i]") } @$k,
)
),
control_buttons($k->[0],
sub { my ($vb, $widget_list2, $ref_local_k, $i) = @_;
my @widget_list = @$widget_list2;
- gtkpack__($vb, $widget_list[$i] = h2widget($ref_local_k, "$label\[$i\]"));
+ gtkpack__($vb, $widget_list[$i] = h2widget($ref_local_k, "$label\[$i]"));
@$widget_list2 = @widget_list;
},
$vb, \$i, \@widget_list)
@@ -311,9 +311,9 @@ sub create_entry_element {
my ($text, $value, $label) = @_;
my $e;
if (ref $text =~ /HASH/) {
- return ([ "$label : ", h2widget($text, $label) ]);
+ return [ "$label : ", h2widget($text, $label) ];
} elsif (ref $text =~ /ARRAY/) {
- return ([ "$label : ", h2widget($text, $label) ]);
+ return [ "$label : ", h2widget($text, $label) ];
} else {
$e = new Gtk2::Entry;
$e->{value} = $value;
diff --git a/perl-install/standalone/drakhelp b/perl-install/standalone/drakhelp
index d4e9d264d..4b94aefb4 100644
--- a/perl-install/standalone/drakhelp
+++ b/perl-install/standalone/drakhelp
@@ -16,7 +16,7 @@ die "Usage: drakhelp <help_path>" if @ARGV != 1;
my $in = interactive->vnew;
my $locale = lang::read('', $>);
-printf("lang is %s\n",$locale->{lang});
+printf("lang is %s\n", $locale->{lang});
$locale->{lang} = 'en' unless member($locale->{lang}, qw(en es fr));
my $path2help = "/usr/share/doc/mandrake/" . $locale->{lang} . "/";
my $path = $ARGV[0] =~ /^http|^www/ ? $ARGV[0] : $path2help . $ARGV[0];
diff --git a/perl-install/standalone/drakperm b/perl-install/standalone/drakperm
index 0347cc9ce..aa7c3e28b 100755
--- a/perl-install/standalone/drakperm
+++ b/perl-install/standalone/drakperm
@@ -16,7 +16,8 @@ local $_ = join '', @ARGV;
my ($default_perm_level) = "level ".chomp_(`cat /etc/sysconfig/msec | grep SECURE_LEVEL= |cut -d= -f2`);
my $perm_path = '/usr/share/msec/';
my $local_path = '/etc/security/msec/';
-my %perm = ( 'level 1' => $perm_path.'perm.1',
+my %perm = (
+ 'level 1' => $perm_path.'perm.1',
'level 2' => $perm_path.'perm.2',
'level 3' => $perm_path.'perm.3',
'level 4' => $perm_path.'perm.4',
@@ -367,7 +368,7 @@ sub row_setting_dialog {
$vbox;
} keys %rights),
gtkpack(Gtk2::VBox->new(0,5),
- Gtk2::Label->new (' '),
+ Gtk2::Label->new(' '),
$suid,
$gid,
$sticky,