package Rpmdrake::gui; #***************************************************************************** # # Copyright (c) 2002 Guillaume Cottenceau # Copyright (c) 2002-2007 Thierry Vignaud # Copyright (c) 2003, 2004, 2005 MandrakeSoft SA # Copyright (c) 2005-2007 Mandriva SA # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License version 2, as # published by the Free Software Foundation. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. # #***************************************************************************** # # $Id$ use strict; our @ISA = qw(Exporter); use lib qw(/usr/lib/libDrakX); use common; use mygtk2 qw(gtknew); #- do not import gtkadd which conflicts with ugtk2 version use ugtk2 qw(:helpers :wrappers); use rpmdrake; use Rpmdrake::formatting; use Rpmdrake::init; use Rpmdrake::icon; use Rpmdrake::pkg; use Rpmdrake::icon; use Gtk2::Gdk::Keysyms; our @EXPORT = qw(ask_browse_tree_info_given_widgets_for_rpmdrake build_tree callback_choices closure_removal do_action get_info is_locale_available pkgs_provider reset_search switch_pkg_list_mode $clear_button $dont_show_selections $find_entry $force_displaying_group $force_rebuild @initial_selection $pkgs $size_free $size_selected $urpm); our $dont_show_selections = $> ? 1 : 0; our ($descriptions, %filter_methods, $force_displaying_group, $force_rebuild, @initial_selection, $initial_selection_done, $pkgs, $size_free, $size_selected, $urpm); sub format_pkg_simplifiedinfo { my ($pkgs, $key, $urpm, $descriptions) = @_; my ($name, $_version) = split_fullname($key); my $medium = pkg2medium($pkgs->{$key}{pkg}, $urpm)->{name}; my $update_descr = $pkgs->{$key}{pkg}->flag_upgrade && $descriptions->{$name}{pre} && $descriptions->{$name}{medium} eq $medium; my $s = ugtk2::markup_to_TextView_format(join("\n", format_header($name . ' - ' . $pkgs->{$key}{summary}) . # workaround gtk+ bug where GtkTextView wronly limit embedded widget size to bigger line's width (#25533): "\x{200b} \x{feff}" . ' ' x 120, if_($update_descr, # is it an update? format_field(N("Importance: ")) . escape_text_for_TextView_markup_format($descriptions->{$name}{importance}), format_field(N("Reason for update: ")) . escape_text_for_TextView_markup_format(rpm_description($descriptions->{$name}{pre})), ), '')); # extra empty line if ($update_descr) { push @$s, [ my $link = gtkshow(Gtk2::LinkButton->new($descriptions->{$name}{URL}, N("Security advisory"))) ]; $link->set_uri_hook(sub { my (undef, $url) = @_; run_program::raw({ detach => 1 }, 'www-browser', $url); }); } push @$s, @{ ugtk2::markup_to_TextView_format(join("\n", (escape_text_for_TextView_markup_format($pkgs->{$key}{description} || $descriptions->{$name}{description}) || '' . N("No description") . '') )) }; push @$s, [ "\n" ]; push @$s, [ gtkadd(gtkshow(my $exp = Gtk2::Expander->new(format_field(N("Files:")))), gtknew('TextView', text => exists $pkgs->{$key}{files} ? ugtk2::markup_to_TextView_format('' . join("\n", map { "\x{200e}$_" } @{$pkgs->{$key}{files}}) . '') #- to highlight information : N("(Not available)"), )) ]; $exp->set_use_markup(1); push @$s, [ "\n\n" ]; push @$s, [ gtkadd(gtkshow(my $exp2 = Gtk2::Expander->new(format_field(N("Changelog:")))), gtknew('TextView', text => $pkgs->{$key}{changelog} || N("(Not available)")) ) ]; $exp2->set_use_markup(1); $s; } sub format_pkg_info { my ($pkgs, $key, $urpm, $descriptions) = @_; my ($name, $version) = split_fullname($key); my @files = ( format_field(N("Files:\n")), exists $pkgs->{$key}{files} ? '' . join("\n", map { "\x{200e}$_" } @{$pkgs->{$key}{files}}) . '' #- to highlight information : N("(Not available)"), ); my @chglo = (format_field(N("Changelog:\n")), ($pkgs->{$key}{changelog} ? @{$pkgs->{$key}{changelog}} : N("(Not available)"))); my @source_info = ( $MODE eq 'remove' || !@$max_info_in_descr ? () : ( format_field(N("Medium: ")) . pkg2medium($pkgs->{$key}{pkg}, $urpm)->{name}, format_field(N("Currently installed version: ")) . find_installed_version($pkgs->{$key}{pkg}), ) ); my @max_info = @$max_info_in_descr && $changelog_first ? (@chglo, @files) : (@files, '', @chglo); ugtk2::markup_to_TextView_format(join("\n", format_field(N("Name: ")) . $name, format_field(N("Version: ")) . $version, format_field(N("Architecture: ")) . $pkgs->{$key}{pkg}->arch, format_field(N("Size: ")) . N("%s KB", int($pkgs->{$key}{pkg}->size/1024)), if_( $MODE eq 'update', format_field(N("Importance: ")) . $descriptions->{$name}{importance} ), @source_info, '', # extra empty line format_field(N("Summary: ")) . $pkgs->{$key}{summary}, '', # extra empty line if_( $MODE eq 'update', format_field(N("Reason for update: ")) . rpm_description($descriptions->{$name}{pre}), ), format_field(N("Description: ")), ($pkgs->{$key}{description} || $descriptions->{$name}{description} || N("No description")), @max_info, )); } sub node_state { my $pkg = $pkgs->{$_[0]}; my $urpm_obj = $pkg->{pkg}; #- checks $_[0] -> hack for partial tree displaying $_[0] ? $pkg->{selected} ? ($urpm_obj->flag_installed ? ($urpm_obj->flag_upgrade ? 'to_install' : 'to_remove') : 'to_install') : ($urpm_obj->flag_installed ? ($urpm_obj->flag_upgrade ? 'to_update' : 'installed') : ($urpm_obj->flag_base ? '/usr/share/rpmdrake/icons/base.png' : 'uninstalled')) : 'XXX'; } # ask_browse_tree_info_given_widgets will run gtk+ loop. its main parameter "common" is a hash containing: # - a "widgets" subhash which holds: # o a "w" reference on a ugtk2 object # o "tree" & "info" references a TreeView # o "info" is a TextView # o "tree_model" is the associated model of "tree" # o "status" references a Label # - some methods: get_info, node_state, build_tree, grep_allowed_to_toggle, partialsel_unsel, grep_unselected, rebuild_tree, toggle_nodes, check_interactive_to_toggle, get_status # - "tree_submode": the default mode (by group, mandriva choice), ... # - "state": a hash of misc flags: => { flat => '0' }, # o "flat": is the tree flat or not # - "tree_mode": mode of the tree ("mandrake_choices", "by_group", ...) (mainly used by rpmdrake) sub ask_browse_tree_info_given_widgets_for_rpmdrake { my ($common) = @_; my $w = $common->{widgets}; $w->{detail_list} ||= $w->{tree}; $w->{detail_list_model} ||= $w->{tree_model}; my ($prev_label); my (%wtree, %ptree, %pix, %node_state, %state_stats); my $update_size = sub { if ($w->{status}) { my $new_label = $common->{get_status}(); $prev_label ne $new_label and $w->{status}->set($prev_label = $new_label); } }; my $set_node_state_flat = sub { my ($iter, $state, $model) = @_; $state eq 'XXX' and return; $pix{$state} ||= gtkcreate_pixbuf($state); $model ||= $w->{tree_model}; $model->set($iter, 1 => $pix{$state}); $model->set($iter, 2 => $state); }; my $set_node_state_tree; $set_node_state_tree = sub { my ($iter, $state, $model) = @_; $model ||= $w->{tree_model}; my $iter_str = $model->get_path_str($iter); ($state eq 'XXX' || !$state) and return; $pix{$state} ||= gtkcreate_pixbuf('state_' . $state); if ($node_state{$iter_str} ne $state) { my $parent; if (!$model->iter_has_child($iter) && ($parent = $model->iter_parent($iter))) { my $parent_str = $model->get_path_str($parent); my $stats = $state_stats{$parent_str} ||= {}; $stats->{$node_state{$iter_str}}--; $stats->{$state}++; my @list = grep { $stats->{$_} > 0 } keys %$stats; my $new_state = @list == 1 ? $list[0] : 'semiselected'; $node_state{$parent_str} ne $new_state and $set_node_state_tree->($parent, $new_state); } $model->set($iter, 1 => $pix{$state}); $model->set($iter, 2 => $state); #$node_state{$iter_str} = $state; #- cache for efficiency } else { } }; my $set_node_state = $common->{state}{splited} || $common->{state}{flat} ? $set_node_state_flat : $set_node_state_tree; my $set_leaf_state = sub { my ($leaf, $state, $model) = @_; $set_node_state->($_, $state, $model) foreach @{$ptree{$leaf}}; }; my $add_parent; $add_parent = sub { my ($root, $state) = @_; $root or return undef; if (my $w = $wtree{$root}) { return $w } my $s; foreach (split '\|', $root) { my $s2 = $s ? "$s|$_" : $_; $wtree{$s2} ||= do { my $pixbuf = get_icon($s2, $s); my $iter = $w->{tree_model}->append_set($s ? $add_parent->($s, $state, get_icon($s)) : undef, [ 0 => $_, if_($pixbuf, 2 => $pixbuf) ]); $iter; }; $s = $s2; } $set_node_state->($wtree{$s}, $state); #- use this state by default as tree is building. $wtree{$s}; }; $common->{add_parent} = $add_parent; my $add_node = sub { my ($leaf, $root, $options) = @_; my $state = node_state($leaf) or return; if ($leaf) { my $iter; if (is_a_package($leaf)) { $iter = $w->{detail_list_model}->append_set([ 0 => $leaf ]); $set_node_state->($iter, $state, $w->{detail_list_model}); } else { $iter = $w->{tree_model}->append_set($add_parent->($root, $state), [ 0 => $leaf ]); } push @{$ptree{$leaf}}, $iter; } else { my $parent = $add_parent->($root, $state); #- hackery for partial displaying of trees, used in rpmdrake: #- if leaf is void, we may create the parent and one child (to have the [+] in front of the parent in the ctree) #- though we use '' as the label of the child; then rpmdrake will connect on tree_expand, and whenever #- the first child has '' as the label, it will remove the child and add all the "right" children $options->{nochild} or $w->{tree_model}->append_set($parent, [ 0 => '' ]); # test $leaf? } }; my $clear_all_caches = sub { foreach (values %ptree) { foreach my $n (@$_) { delete $node_state{$w->{detail_list_model}->get_path_str($n)}; } } foreach (values %wtree) { foreach my $model ($w->{tree_model}) { my $iter_str = $model->get_path_str($_); delete $node_state{$iter_str}; delete $state_stats{$iter_str}; } } %ptree = %wtree = (); }; $common->{delete_all} = sub { $clear_all_caches->(); $w->{detail_list_model}->clear; $w->{tree_model}->clear; }; $common->{rebuild_tree} = sub { $common->{delete_all}->(); $set_node_state = $common->{state}{flat} ? $set_node_state_flat : $set_node_state_tree; $common->{build_tree}($add_node, $common->{state}{flat}, $common->{tree_mode}); &$update_size; }; $common->{delete_category} = sub { my ($cat) = @_; exists $wtree{$cat} or return; foreach (keys %ptree) { my @to_remove; foreach my $node (@{$ptree{$_}}) { my $category; my $parent = $node; my @parents; while ($parent = $w->{tree_model}->iter_parent($parent)) { #- LEAKS my $parent_name = $w->{tree_model}->get($parent, 0); $category = $category ? "$parent_name|$category" : $parent_name; $_->[1] = "$parent_name|$_->[1]" foreach @parents; push @parents, [ $parent, $category ]; } if ($category =~ /^\Q$cat/) { push @to_remove, $node; foreach (@parents) { next if $_->[1] eq $cat || !exists $wtree{$_->[1]}; delete $wtree{$_->[1]}; delete $node_state{$w->{tree_model}->get_path_str($_->[0])}; delete $state_stats{$w->{tree_model}->get_path_str($_->[0])}; } } } foreach (@to_remove) { delete $node_state{$w->{tree_model}->get_path_str($_)}; } @{$ptree{$_}} = difference2($ptree{$_}, \@to_remove); } if (exists $wtree{$cat}) { my $iter_str = $w->{tree_model}->get_path_str($wtree{$cat}); delete $node_state{$iter_str}; delete $state_stats{$iter_str}; $w->{tree_model}->remove($wtree{$cat}); delete $wtree{$cat}; } &$update_size; }; $common->{add_nodes} = sub { my (@nodes) = @_; $w->{detail_list_model}->clear; $w->{detail_list}->scroll_to_point(0, 0); $add_node->($_->[0], $_->[1], $_->[2]) foreach @nodes; &$update_size; }; $common->{display_info} = sub { gtktext_insert($w->{info}, get_info($_[0], $w->{tree}->window)); $w->{info}->scroll_to_iter($w->{info}->get_buffer->get_start_iter, 0, 0, 0, 0); 0; }; my $children = sub { map { $w->{detail_list_model}->get($_, 0) } gtktreeview_children($w->{detail_list_model}, $_[0]) }; $common->{toggle_all} = sub { my ($_val) = @_; my @l = $common->{grep_allowed_to_toggle}($children->()) or return; my @unsel = $common->{grep_unselected}(@l); my @p = @unsel ? #- not all is selected, select all if no option to potentially override (exists $common->{partialsel_unsel} && $common->{partialsel_unsel}->(\@unsel, \@l) ? difference2(\@l, \@unsel) : @unsel) : @l; toggle_nodes($w->{tree}->window, $w->{detail_list_model}, $set_leaf_state, undef, @p); &$update_size; }; my $fast_toggle = sub { my ($iter) = @_; gtkset_mousecursor_wait($w->{w}{rwindow}->window); $common->{check_interactive_to_toggle}($iter) and toggle_nodes($w->{tree}->window, $w->{detail_list_model}, $set_leaf_state, $w->{detail_list_model}->get($iter, 2), $w->{detail_list_model}->get($iter, 0)); &$update_size; gtkset_mousecursor_normal($w->{w}{rwindow}->window); }; $w->{detail_list}->get_selection->signal_connect(changed => sub { my ($model, $iter) = $_[0]->get_selected; $model && $iter or return; $common->{display_info}($model->get($iter, 0)); }); $w->{detail_list}->signal_connect(button_press_event => sub { #- not too good, but CellRendererPixbuf does not have the needed signals :( my ($path, $column) = $w->{detail_list}->get_path_at_pos($_[1]->x, $_[1]->y); if ($path && $column && $column->{is_pix}) { my $iter = $w->{detail_list_model}->get_iter($path); $fast_toggle->($iter) if $iter; } 0; }); $w->{detail_list}->signal_connect(key_press_event => sub { my $c = chr($_[1]->keyval & 0xff); if ($_[1]->keyval >= 0x100 ? $c eq "\r" || $c eq "\x8d" : $c eq ' ') { my ($model, $iter) = $w->{detail_list}->get_selection->get_selected; $fast_toggle->($iter) if $model && $iter; } 0; }); $common->{rebuild_tree}->(); &$update_size; $common->{initial_selection} and toggle_nodes($w->{tree}->window, $w->{detail_list_model}, $set_leaf_state, undef, @{$common->{initial_selection}}); #my $_b = before_leaving { $clear_all_caches->() }; $common->{init_callback}->() if $common->{init_callback}; $w->{w}->main; } my ($clear_button, $find_entry); sub reset_search() { $clear_button and $clear_button->set_sensitive(0); $find_entry and $find_entry->set_text(""); } sub is_a_package { my ($pkg) = @_; return exists $pkgs->{$pkg}; } sub switch_pkg_list_mode { my ($mode) = @_; return if !$mode; return if !$filter_methods{$mode}; $force_displaying_group = 1; $filter_methods{$mode}->(); } sub pkgs_provider { my ($options, $mode) = @_; return if !$mode; my $h = &get_pkgs($urpm, $options); # was given (1, @_) for updates ($urpm, $descriptions) = @$h{qw(urpm update_descr)}; %filter_methods = ( all => sub { $pkgs = { map { %{$h->{$_}} } qw(installed installable updates) } }, installed => sub { $pkgs = $h->{installed} }, non_installed => sub { $pkgs = $h->{installable} }, all_updates => sub { my %pkgs = grep { my $p = $h->{installable}{$_}; $p->{pkg} && !$p->{selected} && $p->{pkg}->flag_installed && $p->{pkg}->flag_upgrade } keys %{$h->{installable}}; $pkgs = { (map { $_ => $h->{updates}{$_} } keys %{$h->{updates}}), (map { $_ => $h->{installable}{$_} } keys %pkgs) }; }, ); if (!$initial_selection_done) { $filter_methods{all}->(); @initial_selection = grep { $pkgs->{$_}{selected} } keys %$pkgs; $initial_selection_done = 1; } foreach my $importance (qw(bugfix security normal)) { $filter_methods{$importance} = sub { $pkgs = $h->{updates}; $pkgs = { map { $_ => $pkgs->{$_} } grep { my ($name, $_version) = split_fullname($_); $descriptions->{$name}{importance} eq $importance } keys %$pkgs }; }; } $filter_methods{mandrake_choices} = $filter_methods{non_installed}; switch_pkg_list_mode($mode); } sub closure_removal { $urpm->{state} = {}; urpm::select::find_packages_to_remove($urpm, $urpm->{state}, \@_); } sub is_locale_available { any { $urpm->{depslist}[$_]->flag_selected } keys %{$urpm->{provides}{$_[0]} || {}} and return 1; my $found; $db->traverse_tag('name', [ $_ ], sub { $found ||= 1 }); return $found; } sub callback_choices { my (undef, undef, undef, $choices) = @_; foreach my $pkg (@$choices) { foreach ($pkg->requires_nosense) { /locales-/ or next; is_locale_available($_) and return $pkg; } } my $callback = sub { interactive_msg(N("More information on package..."), get_info($_[0]), scroll => 1) }; $choices = [ sort { $a->name cmp $b->name } @$choices ]; my @choices = interactive_list_(N("Please choose"), P("The following package is needed:", "One of the following packages is needed:", scalar(@$choices)), [ map { urpm_name($_) } @$choices ], $callback); $choices->[$choices[0]]; } sub toggle_nodes { my ($widget, $model, $set_state, $old_state, @nodes) = @_; @nodes = grep { exists $pkgs->{$_} } @nodes or return; #- avoid selecting too many packages at once return if !$dont_show_selections && @nodes > 2000; my $new_state = !$pkgs->{$nodes[0]}{selected}; my @nodes_with_deps; my $deps_msg = sub { return 1 if $dont_show_selections; my ($title, $msg, $nodes, $nodes_with_deps) = @_; my @deps = sort { $a cmp $b } difference2($nodes_with_deps, $nodes); @deps > 0 or return 1; deps_msg_again: my $results = interactive_msg( $title, $msg . urpm::select::translate_why_removed($urpm, $urpm->{state}, @deps), yesno => [ N("Cancel"), N("More info"), N("Ok") ], scroll => 1, ); if ($results eq #-PO: Keep it short, this is gonna be on a button N("More info")) { interactive_packtable( N("Information on packages"), $::main_window, undef, [ map { my $pkg = $_; [ gtknew('HBox', children_tight => [ gtkset_selectable(gtknew('Label', text => $pkg), 1) ]), gtknew('Button', text => N("More information on package..."), clicked => sub { interactive_msg(N("More information on package..."), get_info($pkg), scroll => 1); }) ] } @deps ], [ gtknew('Button', text => N("Ok"), clicked => sub { Gtk2->main_quit }) ] ); goto deps_msg_again; } else { return $results eq N("Ok"); } }; # deps_msg if (member($old_state, qw(to_remove installed))) { # remove pacckages if ($new_state) { my @remove; slow_func($widget, sub { @remove = closure_removal(@nodes) }); @nodes_with_deps = grep { !$pkgs->{$_}{selected} && !/^basesystem/ } @remove; $deps_msg->(N("Some additional packages need to be removed"), formatAlaTeX(N("Because of their dependencies, the following package(s) also need to be\nremoved:")) . "\n\n", \@nodes, \@nodes_with_deps) or @nodes_with_deps = (); my @impossible_to_remove; foreach (grep { exists $pkgs->{$_}{base} } @remove) { ${$pkgs->{$_}{base}} == 1 ? push @impossible_to_remove, $_ : ${$pkgs->{$_}{base}}--; } @impossible_to_remove and interactive_msg(N("Some packages can't be removed"), N("Removing these packages would break your system, sorry:\n\n") . formatlistpkg(@impossible_to_remove)); @nodes_with_deps = difference2(\@nodes_with_deps, \@impossible_to_remove); } else { slow_func($widget, sub { @nodes_with_deps = grep { intersection(\@nodes, [ closure_removal($_) ]) } grep { $pkgs->{$_}{selected} && !member($_, @nodes) } keys %$pkgs }); push @nodes_with_deps, @nodes; $deps_msg->(N("Some packages can't be removed"), N("Because of their dependencies, the following package(s) must be\nunselected now:\n\n"), \@nodes, \@nodes_with_deps) or @nodes_with_deps = (); $pkgs->{$_}{base} && ${$pkgs->{$_}{base}}++ foreach @nodes_with_deps; } } else { if ($new_state) { if (@nodes > 1) { #- unselect i18n packages of which locales is not already present (happens when user clicks on KDE group) my @bad_i18n_pkgs; foreach my $sel (@nodes) { foreach ($pkgs->{$sel}{pkg}->requires_nosense) { /locales-([^-]+)/ or next; $sel =~ /-$1[-_]/ && !is_locale_available($_) and push @bad_i18n_pkgs, $sel; } } @nodes = difference2(\@nodes, \@bad_i18n_pkgs); } my @requested; slow_func( $widget, sub { @requested = $urpm->resolve_requested( $db, $urpm->{state}, { map { $pkgs->{$_}{pkg}->id => 1 } @nodes }, callback_choices => \&callback_choices, ); }, ); @nodes_with_deps = map { urpm_name($_) } @requested; if (!$deps_msg->(N("Additional packages needed"), N("To satisfy dependencies, the following package(s) also need\nto be installed:\n\n"), \@nodes, \@nodes_with_deps)) { @nodes_with_deps = (); $urpm->disable_selected($db, $urpm->{state}, @requested); goto packages_selection_ok; } if (my @cant = sort(difference2(\@nodes, \@nodes_with_deps))) { my @ask_unselect = urpm::select::unselected_packages($urpm, $urpm->{state}); my @reasons = map { my $cant = $_; my $unsel = find { $_ eq $cant } @ask_unselect; $unsel ? join("\n", urpm::select::translate_why_unselected($urpm, $urpm->{state}, $unsel)) : ($pkgs->{$_}{pkg}->flag_skip ? N("%s (belongs to the skip list)", $cant) : $cant); } @cant; my $count = @reasons; interactive_msg( P("One package cannot be installed", "Some packages can't be installed", $count), P("Sorry, the following package cannot be selected:\n\n%s", "Sorry, the following packages can't be selected:\n\n%s", $count, join("\n", @reasons)), scroll => 1, ); foreach (@cant) { $pkgs->{$_}{pkg}->set_flag_requested(0); $pkgs->{$_}{pkg}->set_flag_required(0); } } packages_selection_ok: } else { my @unrequested; slow_func($widget, sub { @unrequested = $urpm->disable_selected($db, $urpm->{state}, map { $pkgs->{$_}{pkg} } @nodes) }); @nodes_with_deps = map { urpm_name($_) } @unrequested; if (!$deps_msg->(N("Some packages need to be removed"), N("Because of their dependencies, the following package(s) must be\nunselected now:\n\n"), \@nodes, \@nodes_with_deps)) { @nodes_with_deps = (); $urpm->resolve_requested($db, $urpm->{state}, { map { $_->id => 1 } @unrequested }); goto packages_unselection_ok; } packages_unselection_ok: } } foreach (@nodes_with_deps) { #- some deps may exist on some packages which aren't listed because #- not upgradable (older than what currently installed) exists $pkgs->{$_} or next; if (!$pkgs->{$_}{pkg}) { #- can't be removed # FIXME; what about next packages in the loop? $pkgs->{$_}{selected} = 0; log::explanations("can't be removed: $_"); } else { $pkgs->{$_}{selected} = $new_state; } $set_state->($_, node_state($_), $model); $pkgs->{$_}{pkg} and $size_selected += $pkgs->{$_}{pkg}->size * ($new_state ? 1 : -1); } } sub do_action { my ($options, $callback_action, $o_info) = @_; require urpm::sys; if (!urpm::sys::check_fs_writable()) { $urpm->{fatal}(1, N("Error: %s appears to be mounted read-only.", $urpm::sys::mountpoint)); return; } if (!int(grep { $pkgs->{$_}{selected} } keys %$pkgs)) { interactive_msg(N("You need to select some packages first."), N("You need to select some packages first.")); return; } my $size_added = sum(map { if_($_->flag_selected && !$_->flag_installed, $_->size) } @{$urpm->{depslist}}); if ($MODE eq 'install' && $size_free - $size_added/1024 < 50*1024) { interactive_msg(N("Too many packages are selected"), N("Warning: it seems that you are attempting to add so much packages that your filesystem may run out of free diskspace, during or after package installation ; this is particularly dangerous and should be considered with care. Do you really want to install all the selected packages?"), yesno => 1) or return; } if (!$callback_action->($urpm, $pkgs)) { $force_rebuild = 1; pkgs_provider({ skip_updating_mu => 1 }, $options->{tree_mode}); reset_search(); $size_selected = 0; (undef, $size_free) = MDK::Common::System::df('/usr'); $options->{rebuild_tree}->(); gtktext_insert($o_info, '') if $o_info; } } sub ctreefy { join('|', map { translate($_) } split m|/|, $_[0]); } sub build_tree { my ($tree, $tree_model, $elems, $options, $force_rebuild, $compssUsers, $add_node, $flat, $mode) = @_; my $old_mode if 0; $mode = $options->{rmodes}{$mode} || $mode; return if $old_mode eq $mode && !$force_rebuild; $old_mode = $mode; undef $force_rebuild; my @elems; my $wait; $wait = statusbar_msg(N("Please wait, listing packages...")) if $MODE ne 'update'; gtkflush(); if ($mode eq 'mandrake_choices') { foreach my $pkg (keys %$pkgs) { my ($name) = split_fullname($pkg); push @elems, [ $pkg, $_ ] foreach @{$compssUsers->{$name}}; } } else { my @keys = keys %$pkgs; if (member($mode, qw(all_updates security bugfix normal))) { @keys = grep { my ($name) = split_fullname($_); member($descriptions->{$name}{importance}, @$mandrakeupdate_wanted_categories) || ! $descriptions->{$name}{importance}; } @keys; if (@keys == 0) { $add_node->('', N("(none)"), { nochild => 1 }); my $explanation_only_once if 0; $explanation_only_once or interactive_msg(N("No update"), N("The list of updates is empty. This means that either there is no available update for the packages installed on your computer, or you already installed all of them.")); $explanation_only_once = 1; } } @elems = map { [ $_, !$flat && ctreefy($pkgs->{$_}{pkg}->group) ] } @keys; } my %sortmethods = ( by_size => sub { sort { $pkgs->{$b->[0]}{pkg}->size <=> $pkgs->{$a->[0]}{pkg}->size } @_ }, by_selection => sub { sort { $pkgs->{$b->[0]}{selected} <=> $pkgs->{$a->[0]}{selected} || uc($a->[0]) cmp uc($b->[0]) } @_ }, by_leaves => sub { my $pkgs_times = 'rpm -q --qf "%{name}-%{version}-%{release} %{installtime}\n" `urpmi_rpm-find-leaves`'; sort { $b->[1] <=> $a->[1] } grep { exists $pkgs->{$_->[0]} } map { [ split ] } run_rpm($pkgs_times); }, flat => sub { no locale; sort { uc($a->[0]) cmp uc($b->[0]) } @_ }, by_medium => sub { sort { $a->[2] <=> $b->[2] || uc($a->[0]) cmp uc($b->[0]) } @_ }, ); if ($flat) { $add_node->($_->[0], '') foreach $sortmethods{$mode || 'flat'}->(@elems); } else { if (0 && $MODE eq 'update') { $add_node->($_->[0], N("All")) foreach $sortmethods{flat}->(@elems); $tree->expand_row($tree_model->get_path($tree_model->get_iter_first), 0); } elsif ($mode eq 'by_source') { $add_node->($_->[0], $_->[1]) foreach $sortmethods{by_medium}->(map { my $m = pkg2medium($pkgs->{$_->[0]}{pkg}, $urpm); [ $_->[0], $m->{name}, $m->{priority} ]; } @elems); } elsif ($mode eq 'by_presence') { $add_node->( $_->[0], $pkgs->{$_->[0]}{pkg}->flag_installed && !$pkgs->{$_->[0]}{pkg}->flag_skip ? N("Upgradable") : N("Addable") ) foreach $sortmethods{flat}->(@elems); } else { #- we populate all the groups tree at first %$elems = (); # better loop on packages, create groups tree and push packages in the proper place: foreach my $pkg (@elems) { my $grp = $pkg->[1]; $options->{add_parent}->($grp); $elems->{$grp} ||= []; push @{$elems->{$grp}}, $pkg; } } } statusbar_msg_remove($wait) if defined $wait; } sub get_info { my ($key, $widget) = @_; #- the package information hasn't been loaded. Instead of rescanning the media, just give up. exists $pkgs->{$key} or return [ [ N("Description not available for this package\n") ] ]; exists $pkgs->{$key}{description} && exists $pkgs->{$key}{files} or slow_func($widget, sub { extract_header($pkgs->{$key}, $urpm) }); my $s; eval { $s = format_pkg_simplifiedinfo($pkgs, $key, $urpm, $descriptions) }; if (my $err = $@) { $s = N("A fatal error occurred: %s.", $err); } $s; } 1;