/[soft]/rpmdrake/trunk/Rpmdrake/gui.pm
ViewVC logotype

Annotation of /rpmdrake/trunk/Rpmdrake/gui.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1034 - (hide annotations) (download)
Thu Apr 28 19:50:25 2011 UTC (12 years, 11 months ago) by tv
File size: 42709 byte(s)
s/dependancy/dependency/ (#945)
1 dmorgan 535 package Rpmdrake::gui;
2     #*****************************************************************************
3     #
4     # Copyright (c) 2002 Guillaume Cottenceau
5     # Copyright (c) 2002-2007 Thierry Vignaud <tvignaud@mandriva.com>
6     # Copyright (c) 2003, 2004, 2005 MandrakeSoft SA
7     # Copyright (c) 2005-2007 Mandriva SA
8     #
9     # This program is free software; you can redistribute it and/or modify
10     # it under the terms of the GNU General Public License version 2, as
11     # published by the Free Software Foundation.
12     #
13     # This program is distributed in the hope that it will be useful,
14     # but WITHOUT ANY WARRANTY; without even the implied warranty of
15     # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16     # GNU General Public License for more details.
17     #
18     # You should have received a copy of the GNU General Public License
19     # along with this program; if not, write to the Free Software
20     # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
21     #
22     #*****************************************************************************
23     #
24     # $Id$
25    
26     use strict;
27     our @ISA = qw(Exporter);
28     use lib qw(/usr/lib/libDrakX);
29    
30     use common;
31     use mygtk2 qw(gtknew); #- do not import gtkadd which conflicts with ugtk2 version
32    
33     use ugtk2 qw(:helpers :wrappers);
34     use rpmdrake;
35     use Rpmdrake::open_db;
36     use Rpmdrake::formatting;
37     use Rpmdrake::init;
38     use Rpmdrake::icon;
39     use Rpmdrake::pkg;
40     use Rpmdrake::icon;
41     use feature 'state';
42    
43     our @EXPORT = qw(
44     $descriptions
45     $find_entry
46     $force_displaying_group
47     $force_rebuild
48     $pkgs
49     $results_ok
50     $results_none
51     $size_free
52     $size_selected
53     $urpm
54     %grp_columns
55     %pkg_columns
56     @filtered_pkgs
57     @initial_selection
58     ask_browse_tree_given_widgets_for_rpmdrake
59     build_tree
60     callback_choices
61     compute_main_window_size
62     do_action
63     get_info
64     get_summary
65     is_locale_available
66     node_state
67     pkgs_provider
68     real_quit
69     reset_search
70     set_node_state
71     sort_callback
72     switch_pkg_list_mode
73     toggle_all
74     toggle_nodes
75     );
76    
77     our ($descriptions, %filters, @filtered_pkgs, %filter_methods, $force_displaying_group, $force_rebuild, @initial_selection, $pkgs, $size_free, $size_selected, $urpm);
78     our ($results_ok, $results_none) = (N("Search results"), N("Search results (none)"));
79    
80     our %grp_columns = (
81     label => 0,
82     icon => 2,
83     );
84    
85     our %pkg_columns = (
86     text => 0,
87     state_icon => 1,
88     state => 2,
89     selected => 3,
90     short_name => 4,
91     version => 5,
92     release => 6,
93     'arch' => 7,
94     selectable => 8,
95     );
96    
97    
98     sub compute_main_window_size {
99     my ($w) = @_;
100     ($typical_width) = string_size($w->{real_window}, translate("Graphical Environment") . "xmms-more-vis-plugins");
101     $typical_width > 600 and $typical_width = 600; #- try to not being crazy with a too large value
102     $typical_width < 150 and $typical_width = 150;
103     }
104    
105     sub get_summary {
106     my ($key) = @_;
107     $pkgs->{$key}{summary} ||= $pkgs->{$key}{pkg}->summary;
108     my $summary = translate($pkgs->{$key}{summary});
109     utf8::valid($summary) ? $summary : ();
110     }
111    
112     sub build_expander {
113     my ($pkg, $label, $type, $get_data, $o_installed_version) = @_;
114     my $textview;
115     gtkadd(
116     gtkshow(my $exp = gtksignal_connect(
117     Gtk2::Expander->new(format_field($label)),
118     activate => sub {
119     state $first;
120     return if $first;
121     $first = 1;
122     slow_func($::main_window->window, sub {
123     extract_header($pkg, $urpm, $type, $o_installed_version);
124     gtktext_insert($textview, $get_data->() || [ [ N("(Not available)") ] ]);
125     });
126     })),
127     $textview = gtknew('TextView')
128     );
129     $exp->set_use_markup(1);
130     $exp;
131     }
132    
133    
134     sub get_advisory_link {
135     my ($update_descr) = @_;
136     my $link = gtkshow(Gtk2::LinkButton->new($update_descr->{URL}, N("Security advisory")));
137     $link->set_uri_hook(\&run_help_callback);
138     [ $link ];
139     }
140    
141     sub get_description {
142     my ($pkg, $update_descr) = @_;
143     @{ ugtk2::markup_to_TextView_format(join("\n",
144     (eval {
145     escape_text_for_TextView_markup_format(
146     $pkg->{description}
147     || $update_descr->{description});
148     } || '<i>' . N("No description") . '</i>')
149     )) };
150     }
151    
152     sub get_string_from_keywords {
153     my ($medium) = @_;
154     return if !$medium->{mediacfg};
155     my ($distribconf, $medium_name) = @{$medium->{mediacfg}};
156    
157     return if !$distribconf;
158    
159     my @media_types = split(':', $distribconf->getvalue($medium_name, 'media_type'));
160    
161 dmorgan 594 my $unsupported = N("It is <b>not supported</b> by Mageia.");
162 dmorgan 535 my $dangerous = N("It may <b>break</b> your system.");
163     my $s;
164     $s .= N("This package is not free software") . "\n" if member('non-free', @media_types);
165     if (member('backport', @media_types)) {
166     return join("\n",
167     N("This package contains a new version that was backported."),
168     $unsupported, $dangerous, $s);
169     } elsif (member('testing', @media_types)) {
170     return join("\n",
171     N("This package is a potential candidate for an update."),
172     $unsupported, $dangerous, $s);
173     } elsif (member('updates', @media_types)) {
174     return join("\n",
175     (member('official', @media_types) ?
176 tv 1033 N("This is an official update which is supported by Mageia.")
177     : (N("This is an unofficial update."), $unsupported))
178 dmorgan 535 ,
179     $s);
180     } else {
181 dmorgan 594 $s .= N("This is an official package supported by Mageia") . "\n" if member('official', @media_types);
182 dmorgan 535 return $s;
183     }
184     }
185    
186     sub get_main_text {
187     my ($medium, $name, $summary, $is_update, $update_descr) = @_;
188    
189     my $txt = get_string_from_keywords($medium);
190    
191     ugtk2::markup_to_TextView_format(
192     # force align "name - summary" to the right with RTL languages (#33603):
193     if_(lang::text_direction_rtl(), "\x{200f}") .
194     join("\n",
195     format_header(join(' - ', $name, $summary)) .
196     # workaround gtk+ bug where GtkTextView wronly limit embedded widget size to bigger line's width (#25533):
197     "\x{200b} \x{feff}" . ' ' x 120,
198     if_($txt, format_field(N("Notice: ")) . $txt),
199     if_($is_update, # is it an update?
200     format_field(N("Importance: ")) . format_update_field($update_descr->{importance}),
201     format_field(N("Reason for update: ")) . format_update_field(rpm_description($update_descr->{pre})),
202     ),
203     '' # extra empty line
204     ));
205     }
206    
207     sub get_details {
208     my ($key, $pkg, $upkg, $installed_version, $raw_medium) = @_;
209     my (undef, $version, $release) = split_fullname($key);
210     my $a = ugtk2::markup_to_TextView_format(
211     $spacing . join("\n$spacing",
212     format_field(N("Version: ")) . $version . '-' . $release,
213     ($upkg->flag_installed ?
214     format_field(N("Currently installed version: ")) . $installed_version : ()
215     ),
216     format_field(N("Group: ")) . translate_group($upkg->group),
217     format_field(N("Architecture: ")) . $upkg->arch,
218     format_field(N("Size: ")) . N("%s KB", int($upkg->size/1024)),
219     eval { format_field(N("Medium: ")) . $raw_medium->{name} },
220     ),
221     );
222     my @link = get_url_link($upkg, $pkg);
223     push @$a, @link if @link;
224     $a;
225     }
226    
227     sub get_new_deps {
228     my ($urpm, $upkg) = @_;
229     my $deps_textview;
230     my @a = [ gtkadd(
231     gtksignal_connect(
232     gtkshow(my $dependencies = Gtk2::Expander->new(format_field(N("New dependencies:")))),
233     activate => sub {
234     slow_func($::main_window->window, sub {
235     my $state = {};
236     my @requested = $urpm->resolve_requested(
237     open_rpm_db(), $state,
238     { $upkg->id => 1 },
239     );
240     $urpm->disable_selected(open_rpm_db(), $state, @requested);
241     my @nodes_with_deps = map { urpm_name($_) } @requested;
242     my @deps = sort { $a cmp $b } difference2(\@nodes_with_deps, [ urpm_name($upkg) ]);
243 tv 1034 @deps = N("No non installed dependency.") if !@deps;
244 dmorgan 535 gtktext_insert($deps_textview, join("\n", @deps));
245     });
246     }
247     ),
248     $deps_textview = gtknew('TextView')
249     ) ];
250     $dependencies->set_use_markup(1);
251     @a;
252     }
253    
254     sub get_url_link {
255     my ($upkg, $pkg) = @_;
256    
257     my $url = $upkg->url || $pkg->{url};
258    
259     if (!$url) {
260     open_rpm_db()->traverse_tag('name', [ $upkg->name ], sub { $url = $_[0]->url });
261     }
262    
263     return if !$url;
264    
265     my @a =
266     (@{ ugtk2::markup_to_TextView_format(format_field("\n$spacing" . N("URL: "))) },
267     [ my $link = gtkshow(Gtk2::LinkButton->new($url, $url)) ]);
268     $link->set_uri_hook(\&run_help_callback);
269     @a;
270     }
271    
272     sub files_format {
273     my ($files) = @_;
274     ugtk2::markup_to_TextView_format(
275     '<tt>' . $spacing #- to highlight information
276     . join("\n$spacing", map { "\x{200e}$_" } @$files)
277     . '</tt>');
278     }
279    
280     sub format_pkg_simplifiedinfo {
281     my ($pkgs, $key, $urpm, $descriptions) = @_;
282     my ($name) = split_fullname($key);
283     my $pkg = $pkgs->{$key};
284     my $upkg = $pkg->{pkg};
285     return if !$upkg;
286     my $raw_medium = pkg2medium($upkg, $urpm);
287     my $medium = !$raw_medium->{fake} ? $raw_medium->{name} : undef;
288     my $update_descr = $descriptions->{$medium}{$name};
289     # discard update fields if not matching:
290     my $is_update = ($upkg->flag_upgrade && $update_descr && $update_descr->{pre});
291     my $summary = get_summary($key);
292     my $s = get_main_text($raw_medium, $name, $summary, $is_update, $update_descr);
293     push @$s, get_advisory_link($update_descr) if $is_update;
294    
295     push @$s, get_description($pkg, $update_descr);
296     push @$s, [ "\n" ];
297     my $installed_version = eval { find_installed_version($upkg) };
298    
299     push @$s, [ gtkadd(gtkshow(my $details_exp = Gtk2::Expander->new(format_field(N("Details:")))),
300     gtknew('TextView', text => get_details($key, $pkg, $upkg, $installed_version, $raw_medium))) ];
301     $details_exp->set_use_markup(1);
302     push @$s, [ "\n\n" ];
303     push @$s, [ build_expander($pkg, N("Files:"), 'files', sub { files_format($pkg->{files}) }) ];
304     push @$s, [ "\n\n" ];
305     push @$s, [ build_expander($pkg, N("Changelog:"), 'changelog', sub { $pkg->{changelog} }, $installed_version) ];
306    
307     push @$s, [ "\n\n" ];
308     if ($upkg->id) { # If not installed
309     push @$s, get_new_deps($urpm, $upkg);
310     }
311     $s;
312     }
313    
314     sub format_pkg_info {
315     my ($pkgs, $key, $urpm, $descriptions) = @_;
316     my $pkg = $pkgs->{$key};
317     my $upkg = $pkg->{pkg};
318     my ($name, $version) = split_fullname($key);
319     my @files = (
320     format_field(N("Files:\n")),
321     exists $pkg->{files}
322     ? '<tt>' . join("\n", map { "\x{200e}$_" } @{$pkg->{files}}) . '</tt>' #- to highlight information
323     : N("(Not available)"),
324     );
325     my @chglo = (format_field(N("Changelog:\n")), ($pkg->{changelog} ? @{$pkg->{changelog}} : N("(Not available)")));
326     my @source_info = (
327     $MODE eq 'remove' || !@$max_info_in_descr
328     ? ()
329     : (
330     format_field(N("Medium: ")) . pkg2medium($upkg, $urpm)->{name},
331     format_field(N("Currently installed version: ")) . find_installed_version($upkg),
332     )
333     );
334     my @max_info = @$max_info_in_descr && $changelog_first ? (@chglo, @files) : (@files, '', @chglo);
335     ugtk2::markup_to_TextView_format(join("\n", format_field(N("Name: ")) . $name,
336     format_field(N("Version: ")) . $version,
337     format_field(N("Architecture: ")) . $upkg->arch,
338     format_field(N("Size: ")) . N("%s KB", int($upkg->size/1024)),
339     if_(
340     $MODE eq 'update',
341     format_field(N("Importance: ")) . $descriptions->{$name}{importance}
342     ),
343     @source_info,
344     '', # extra empty line
345     format_field(N("Summary: ")) . $pkg->{summary},
346     '', # extra empty line
347     if_(
348     $MODE eq 'update',
349     format_field(N("Reason for update: ")) . rpm_description($descriptions->{$name}{pre}),
350     ),
351     format_field(N("Description: ")), ($pkg->{description} || $descriptions->{$name}{description} || N("No description")),
352     @max_info,
353     ));
354     }
355    
356     sub node_state {
357     my ($name) = @_;
358     return if !$name;
359     my $pkg = $pkgs->{$name};
360     my $urpm_obj = $pkg->{pkg};
361     if (!$urpm_obj) {
362     my ($short_name) = split_fullname($name);
363     state $warned;
364     if (!$warned) {
365     $warned = 1;
366     interactive_msg(N("Warning"),
367     join("\n",
368     N("The package \"%s\" was found.", $name),
369     N("However this package is not in the package list."),
370     N("You may want to update your urpmi database."),
371     '',
372     N("Matching packages:"),
373     '',
374     join("\n", sort map {
375     #-PO: this is list fomatting: "- <package_name> (medium: <medium_name>)"
376     #-PO: eg: "- rpmdrake (medium: "Main Release"
377     N("- %s (medium: %s)", $_, pkg2medium($pkgs->{$_}{pkg}, $urpm)->{name});
378     } grep { /^$short_name/ } keys %$pkgs),
379     ),
380     scroll => 1,
381     );
382     }
383     return 'XXX';
384     }
385     #- checks $_[0] -> hack for partial tree displaying
386     return 'XXX' if !$_[0];
387     $pkg->{selected} ?
388     ($urpm_obj->flag_installed ?
389     ($urpm_obj->flag_upgrade ? 'to_install' : 'to_remove')
390     : 'to_install')
391     : ($urpm_obj->flag_installed ?
392     ($urpm_obj->flag_upgrade ? 'to_update'
393     : ($urpm_obj->flag_base ? 'base' : 'installed'))
394     : 'uninstalled');
395     }
396    
397     my ($common, $w, %wtree, %ptree, %pix);
398    
399     sub set_node_state {
400     my ($iter, $state, $model) = @_;
401     ($state eq 'XXX' || !$state) and return;
402     $pix{$state} ||= gtkcreate_pixbuf('state_' . $state);
403     $model->set($iter, $pkg_columns{state_icon} => $pix{$state});
404     $model->set($iter, $pkg_columns{state} => $state);
405     $model->set($iter, $pkg_columns{selected} => to_bool(member($state, qw(base installed to_install)))); #$pkg->{selected}));
406     $model->set($iter, $pkg_columns{selectable} => to_bool($state ne 'base'));
407     }
408    
409     sub set_leaf_state {
410     my ($leaf, $state, $model) = @_;
411     set_node_state($_, $state, $model) foreach @{$ptree{$leaf}};
412     }
413    
414     sub grep_unselected { grep { exists $pkgs->{$_} && !$pkgs->{$_}{selected} } @_ }
415    
416     sub add_parent {
417     my ($root, $state) = @_;
418     $root or return undef;
419     if (my $w = $wtree{$root}) { return $w }
420     my $s; foreach (split '\|', $root) {
421     my $s2 = $s ? "$s|$_" : $_;
422     $wtree{$s2} ||= do {
423     my $pixbuf = get_icon($s2, $s);
424     my $iter = $w->{tree_model}->append_set($s ? add_parent($s, $state, get_icon($s)) : undef,
425     [ $grp_columns{label} => $_, if_($pixbuf, $grp_columns{icon} => $pixbuf) ]);
426     $iter;
427     };
428     $s = $s2;
429     }
430     set_node_state($wtree{$s}, $state, $w->{tree_model}); #- use this state by default as tree is building. #
431     $wtree{$s};
432     }
433    
434     sub add_node {
435     my ($leaf, $root, $options) = @_;
436     my $state = node_state($leaf) or return;
437     if ($leaf) {
438     my $iter;
439     if (is_a_package($leaf)) {
440     my ($name, $version, $release, $arch) = split_fullname($leaf);
441     $iter = $w->{detail_list_model}->append_set([ $pkg_columns{text} => $leaf,
442     $pkg_columns{short_name} => format_name_n_summary($name, get_summary($leaf)),
443     $pkg_columns{version} => $version,
444     $pkg_columns{release} => $release,
445     $pkg_columns{arch} => $arch,
446     ]);
447     set_node_state($iter, $state, $w->{detail_list_model});
448     $ptree{$leaf} = [ $iter ];
449     } else {
450     $iter = $w->{tree_model}->append_set(add_parent($root, $state), [ $grp_columns{label} => $leaf ]);
451     push @{$wtree{$leaf}}, $iter;
452     }
453     } else {
454     my $parent = add_parent($root, $state);
455     #- hackery for partial displaying of trees, used in rpmdrake:
456     #- if leaf is void, we may create the parent and one child (to have the [+] in front of the parent in the ctree)
457     #- though we use '' as the label of the child; then rpmdrake will connect on tree_expand, and whenever
458     #- the first child has '' as the label, it will remove the child and add all the "right" children
459     $options->{nochild} or $w->{tree_model}->append_set($parent, [ $grp_columns{label} => '' ]); # test $leaf?
460     }
461     }
462    
463     my ($prev_label);
464     sub update_size {
465     my ($common) = shift @_;
466     if ($w->{status}) {
467     my $new_label = $common->{get_status}();
468     $prev_label ne $new_label and $w->{status}->set($prev_label = $new_label);
469     }
470     }
471    
472     sub children {
473     my ($w) = @_;
474     map { $w->{detail_list_model}->get($_, $pkg_columns{text}) } gtktreeview_children($w->{detail_list_model});
475     }
476    
477     sub toggle_all {
478     my ($common, $_val) = @_;
479     my $w = $common->{widgets};
480     my @l = children($w) or return;
481    
482     my @unsel = grep_unselected(@l);
483     my @p = @unsel ?
484     #- not all is selected, select all if no option to potentially override
485     (exists $common->{partialsel_unsel} && $common->{partialsel_unsel}->(\@unsel, \@l) ? difference2(\@l, \@unsel) : @unsel)
486     : @l;
487     toggle_nodes($w->{detail_list}->window, $w->{detail_list_model}, \&set_leaf_state, node_state($p[0]), @p);
488     update_size($common);
489     }
490    
491     # ask_browse_tree_given_widgets_for_rpmdrake will run gtk+ loop. its main parameter "common" is a hash containing:
492     # - a "widgets" subhash which holds:
493     # o a "w" reference on a ugtk2 object
494     # o "tree" & "info" references a TreeView
495     # o "info" is a TextView
496     # o "tree_model" is the associated model of "tree"
497     # o "status" references a Label
498     # - some methods: get_info, node_state, build_tree, partialsel_unsel, grep_unselected, rebuild_tree, toggle_nodes, get_status
499     # - "tree_submode": the default mode (by group, ...), ...
500     # - "state": a hash of misc flags: => { flat => '0' },
501     # o "flat": is the tree flat or not
502     # - "tree_mode": mode of the tree ("gui_pkgs", "by_group", ...) (mainly used by rpmdrake)
503    
504     sub ask_browse_tree_given_widgets_for_rpmdrake {
505     ($common) = @_;
506     $w = $common->{widgets};
507    
508     $w->{detail_list} ||= $w->{tree};
509     $w->{detail_list_model} ||= $w->{tree_model};
510    
511     $common->{add_parent} = \&add_parent;
512     my $clear_all_caches = sub {
513     %ptree = %wtree = ();
514     };
515     $common->{clear_all_caches} = $clear_all_caches;
516     $common->{delete_all} = sub {
517     $clear_all_caches->();
518     $w->{detail_list_model}->clear;
519     $w->{tree_model}->clear;
520     };
521     $common->{rebuild_tree} = sub {
522     $common->{delete_all}->();
523     $common->{build_tree}($common->{state}{flat}, $common->{tree_mode});
524     update_size($common);
525     };
526     $common->{delete_category} = sub {
527     my ($cat) = @_;
528     exists $wtree{$cat} or return;
529     %ptree = ();
530    
531     if (exists $wtree{$cat}) {
532     my $_iter_str = $w->{tree_model}->get_path_str($wtree{$cat});
533     $w->{tree_model}->remove($wtree{$cat});
534     delete $wtree{$cat};
535     }
536     update_size($common);
537     };
538     $common->{add_nodes} = sub {
539     my (@nodes) = @_;
540     $w->{detail_list_model}->clear;
541     $w->{detail_list}->scroll_to_point(0, 0);
542     add_node($_->[0], $_->[1], $_->[2]) foreach @nodes;
543     update_size($common);
544     };
545    
546     $common->{display_info} = sub {
547     gtktext_insert($w->{info}, get_info($_[0], $w->{tree}->window));
548     $w->{info}->scroll_to_iter($w->{info}->get_buffer->get_start_iter, 0, 0, 0, 0);
549     0;
550     };
551    
552     my $fast_toggle = sub {
553     my ($iter) = @_;
554     gtkset_mousecursor_wait($w->{w}{rwindow}->window);
555     my $_cleaner = before_leaving { gtkset_mousecursor_normal($w->{w}{rwindow}->window) };
556     my $name = $w->{detail_list_model}->get($iter, $pkg_columns{text});
557     my $urpm_obj = $pkgs->{$name}{pkg};
558    
559     if ($urpm_obj->flag_base) {
560     interactive_msg(N("Warning"),
561     N("Removing package %s would break your system", $name));
562     return '';
563     }
564    
565     if ($urpm_obj->flag_skip) {
566     interactive_msg(N("Warning"), N("The \"%s\" package is in urpmi skip list.\nDo you want to select it anyway?", $name), yesno => 1) or return '';
567     $urpm_obj->set_flag_skip(0);
568     }
569    
570     if ($Rpmdrake::pkg::need_restart && !$priority_up_alread_warned) {
571     $priority_up_alread_warned = 1;
572     interactive_msg(N("Warning"), '<b>' . N("Rpmdrake or one of its priority dependencies needs to be updated first. Rpmdrake will then restart.") . '</b>' . "\n\n");
573     }
574    
575     toggle_nodes($w->{tree}->window, $w->{detail_list_model}, \&set_leaf_state, $w->{detail_list_model}->get($iter, $pkg_columns{state}),
576     $w->{detail_list_model}->get($iter, $pkg_columns{text}));
577     update_size($common);
578     };
579     $w->{detail_list}->get_selection->signal_connect(changed => sub {
580     my ($model, $iter) = $_[0]->get_selected;
581     $model && $iter or return;
582     $common->{display_info}($model->get($iter, $pkg_columns{text}));
583     });
584     ($w->{detail_list}->get_column(0)->get_cell_renderers)[0]->signal_connect(toggled => sub {
585     my ($_cell, $path) = @_; #text_
586     my $iter = $w->{detail_list_model}->get_iter_from_string($path);
587     $fast_toggle->($iter) if $iter;
588     1;
589     });
590     $common->{rebuild_tree}->();
591     update_size($common);
592     $common->{initial_selection} and toggle_nodes($w->{tree}->window, $w->{detail_list_model}, \&set_leaf_state, undef, @{$common->{initial_selection}});
593     #my $_b = before_leaving { $clear_all_caches->() };
594     $common->{init_callback}->() if $common->{init_callback};
595     $w->{w}->main;
596     }
597    
598     our $find_entry;
599    
600     sub reset_search() {
601     return if !$common;
602     $common->{delete_category}->($_) foreach $results_ok, $results_none;
603     # clear package list:
604     $common->{add_nodes}->();
605     }
606    
607     sub is_a_package {
608     my ($pkg) = @_;
609     return exists $pkgs->{$pkg};
610     }
611    
612     sub switch_pkg_list_mode {
613     my ($mode) = @_;
614     return if !$mode;
615     return if !$filter_methods{$mode};
616     $force_displaying_group = 1;
617     $filter_methods{$mode}->();
618     }
619    
620     sub is_updatable {
621     my $p = $pkgs->{$_[0]};
622     $p->{pkg} && !$p->{selected} && $p->{pkg}->flag_installed && $p->{pkg}->flag_upgrade;
623     }
624    
625     sub pkgs_provider {
626     my ($options, $mode, %options) = @_;
627     return if !$mode;
628     my $h = &get_pkgs($options); # was given (1, @_) for updates
629     ($urpm, $descriptions) = @$h{qw(urpm update_descr)};
630     $pkgs = $h->{all_pkgs};
631     %filters = (
632     non_installed => $h->{installable},
633     installed => $h->{installed},
634     all => [ keys %$pkgs ],
635     );
636     my %tmp_filter_methods = (
637     all => sub {
638     [ difference2([ keys %$pkgs ], $h->{inactive_backports}) ]
639     },
640     all_updates => sub {
641     # potential "updates" from media not tagged as updates:
642     if (!$options{pure_updates} && !$Rpmdrake::pkg::need_restart) {
643     [ @{$h->{updates}},
644     difference2([ grep { is_updatable($_) } @{$h->{installable}} ], $h->{backports}) ];
645     } else {
646     [ difference2($h->{updates}, $h->{inactive_backports}) ];
647     }
648     },
649     backports => sub { $h->{backports} },
650     meta_pkgs => sub {
651     [ difference2($h->{meta_pkgs}, $h->{inactive_backports}) ]
652     },
653     gui_pkgs => sub {
654     [ difference2($h->{gui_pkgs}, $h->{inactive_backports}) ]
655     },
656     );
657     foreach my $importance (qw(bugfix security normal)) {
658     $tmp_filter_methods{$importance} = sub {
659     my @media = keys %$descriptions;
660     [ grep {
661     my ($name) = split_fullname($_);
662     my $medium = find { $descriptions->{$_}{$name} } @media;
663     $medium && $descriptions->{$medium}{$name}{importance} eq $importance } @{$h->{updates}} ];
664     };
665     }
666    
667     undef %filter_methods;
668     foreach my $type (keys %tmp_filter_methods) {
669     $filter_methods{$type} = sub {
670     $force_rebuild = 1; # force rebuilding tree since we changed filter (FIXME: switch to SortModel)
671     @filtered_pkgs = intersection($filters{$filter->[0]}, $tmp_filter_methods{$type}->());
672     };
673     }
674    
675     switch_pkg_list_mode($mode);
676     }
677    
678     sub closure_removal {
679     local $urpm->{state} = {};
680     urpm::select::find_packages_to_remove($urpm, $urpm->{state}, \@_);
681     }
682    
683     sub is_locale_available {
684     any { $urpm->{depslist}[$_]->flag_selected } keys %{$urpm->{provides}{$_[0]} || {}} and return 1;
685     my $found;
686     open_rpm_db()->traverse_tag('name', [ $_ ], sub { $found ||= 1 });
687     return $found;
688     }
689    
690     sub callback_choices {
691     my (undef, undef, undef, $choices) = @_;
692     return $choices->[0] if $::rpmdrake_options{auto};
693     foreach my $pkg (@$choices) {
694     foreach ($pkg->requires_nosense) {
695     /locales-/ or next;
696     is_locale_available($_) and return $pkg;
697     }
698     }
699     my $callback = sub { interactive_msg(N("More information on package..."), get_info($_[0]), scroll => 1) };
700     $choices = [ sort { $a->name cmp $b->name } @$choices ];
701     my @choices = interactive_list_(N("Please choose"), (scalar(@$choices) == 1 ?
702     N("The following package is needed:") : N("One of the following packages is needed:")),
703     [ map { urpm_name($_) } @$choices ], $callback, nocancel => 1);
704     defined $choices[0] ? $choices->[$choices[0]] : undef;
705     }
706    
707     sub deps_msg {
708     return 1 if $dont_show_selections->[0];
709     my ($title, $msg, $nodes, $nodes_with_deps) = @_;
710     my @deps = sort { $a cmp $b } difference2($nodes_with_deps, $nodes);
711     @deps > 0 or return 1;
712     deps_msg_again:
713     my $results = interactive_msg(
714     $title, $msg .
715     format_list(map { scalar(urpm::select::translate_why_removed_one($urpm, $urpm->{state}, $_)) } @deps)
716     . "\n\n" . format_size($urpm->selected_size($urpm->{state})),
717     yesno => [ N("Cancel"), N("More info"), N("Ok") ],
718     scroll => 1,
719     );
720     if ($results eq
721     #-PO: Keep it short, this is gonna be on a button
722     N("More info")) {
723     interactive_packtable(
724     N("Information on packages"),
725     $::main_window,
726     undef,
727     [ map { my $pkg = $_;
728     [ gtknew('HBox', children_tight => [ gtkset_selectable(gtknew('Label', text => $pkg), 1) ]),
729     gtknew('Button', text => N("More information on package..."),
730     clicked => sub {
731     interactive_msg(N("More information on package..."), get_info($pkg), scroll => 1);
732     }) ] } @deps ],
733     [ gtknew('Button', text => N("Ok"),
734     clicked => sub { Gtk2->main_quit }) ]
735     );
736     goto deps_msg_again;
737     } else {
738     return $results eq N("Ok");
739     }
740     }
741    
742     sub toggle_nodes {
743     my ($widget, $model, $set_state, $old_state, @nodes) = @_;
744     @nodes = grep { exists $pkgs->{$_} } @nodes
745     or return;
746     #- avoid selecting too many packages at once
747     return if !$dont_show_selections->[0] && @nodes > 2000;
748     my $new_state = !$pkgs->{$nodes[0]}{selected};
749    
750     my @nodes_with_deps;
751    
752     my $bar_id = statusbar_msg(N("Checking dependencies of package..."), 0);
753    
754     my $warn_about_additional_packages_to_remove = sub {
755     my ($msg) = @_;
756     statusbar_msg_remove($bar_id);
757     deps_msg(N("Some additional packages need to be removed"),
758     formatAlaTeX($msg) . "\n\n",
759     \@nodes, \@nodes_with_deps) or @nodes_with_deps = ();
760     };
761    
762     if (member($old_state, qw(to_remove installed))) { # remove pacckages
763     if ($new_state) {
764     my @remove;
765     slow_func($widget, sub { @remove = closure_removal(@nodes) });
766     @nodes_with_deps = grep { !$pkgs->{$_}{selected} && !/^basesystem/ } @remove;
767     $warn_about_additional_packages_to_remove->(
768     N("Because of their dependencies, the following package(s) also need to be removed:"));
769     my @impossible_to_remove;
770     foreach (grep { exists $pkgs->{$_}{base} } @remove) {
771     ${$pkgs->{$_}{base}} == 1 ? push @impossible_to_remove, $_ : ${$pkgs->{$_}{base}}--;
772     }
773     @impossible_to_remove and interactive_msg(N("Some packages can't be removed"),
774     N("Removing these packages would break your system, sorry:\n\n") .
775     format_list(@impossible_to_remove));
776     @nodes_with_deps = difference2(\@nodes_with_deps, \@impossible_to_remove);
777     } else {
778     slow_func($widget,
779     sub { @nodes_with_deps = grep { intersection(\@nodes, [ closure_removal($_) ]) }
780     grep { $pkgs->{$_}{selected} && !member($_, @nodes) } keys %$pkgs });
781     push @nodes_with_deps, @nodes;
782     $warn_about_additional_packages_to_remove->(
783     N("Because of their dependencies, the following package(s) must be unselected now:\n\n"));
784     $pkgs->{$_}{base} && ${$pkgs->{$_}{base}}++ foreach @nodes_with_deps;
785     }
786     } else {
787     if ($new_state) {
788     if (@nodes > 1) {
789     #- unselect i18n packages of which locales is not already present (happens when user clicks on KDE group)
790     my @bad_i18n_pkgs;
791     foreach my $sel (@nodes) {
792     foreach ($pkgs->{$sel}{pkg}->requires_nosense) {
793     /locales-([^-]+)/ or next;
794     $sel =~ /-$1[-_]/ && !is_locale_available($_) and push @bad_i18n_pkgs, $sel;
795     }
796     }
797     @nodes = difference2(\@nodes, \@bad_i18n_pkgs);
798     }
799     my @requested;
800     slow_func(
801     $widget,
802     sub {
803     @requested = $urpm->resolve_requested(
804     open_rpm_db(), $urpm->{state},
805     { map { $pkgs->{$_}{pkg}->id => 1 } @nodes },
806     callback_choices => \&callback_choices,
807     );
808     },
809     );
810     @nodes_with_deps = map { urpm_name($_) } @requested;
811     statusbar_msg_remove($bar_id);
812     if (!deps_msg(N("Additional packages needed"),
813     formatAlaTeX(N("To satisfy dependencies, the following package(s) also need to be installed:\n\n")) . "\n\n",
814     \@nodes, \@nodes_with_deps)) {
815     @nodes_with_deps = ();
816     $urpm->disable_selected(open_rpm_db(), $urpm->{state}, @requested);
817     goto packages_selection_ok;
818     }
819    
820     if (my $conflicting_msg = urpm::select::conflicting_packages_msg($urpm, $urpm->{state})) {
821     if (!interactive_msg(N("Conflicting Packages"), $conflicting_msg, yesno => 1, scroll => 1)) {
822     @nodes_with_deps = ();
823     $urpm->disable_selected(open_rpm_db(), $urpm->{state}, @requested);
824     goto packages_selection_ok;
825     }
826     }
827    
828     if (my @cant = sort(difference2(\@nodes, \@nodes_with_deps))) {
829     my @ask_unselect = urpm::select::unselected_packages($urpm, $urpm->{state});
830     my @reasons = map {
831     my $cant = $_;
832     my $unsel = find { $_ eq $cant } @ask_unselect;
833     $unsel
834     ? join("\n", urpm::select::translate_why_unselected($urpm, $urpm->{state}, $unsel))
835     : ($pkgs->{$_}{pkg}->flag_skip ? N("%s (belongs to the skip list)", $cant) : $cant);
836     } @cant;
837     my $count = @reasons;
838     interactive_msg(
839     ($count == 1 ? N("One package cannot be installed") : N("Some packages can't be installed")),
840     ($count == 1 ?
841     N("Sorry, the following package cannot be selected:\n\n%s", format_list(@reasons))
842     : N("Sorry, the following packages can't be selected:\n\n%s", format_list(@reasons))),
843     scroll => 1,
844     );
845     foreach (@cant) {
846     next unless $pkgs->{$_}{pkg};
847     $pkgs->{$_}{pkg}->set_flag_requested(0);
848     $pkgs->{$_}{pkg}->set_flag_required(0);
849     }
850     }
851     packages_selection_ok:
852     } else {
853     my @unrequested;
854     slow_func($widget,
855     sub { @unrequested = $urpm->disable_selected(open_rpm_db(), $urpm->{state},
856     map { $pkgs->{$_}{pkg} } @nodes) });
857     @nodes_with_deps = map { urpm_name($_) } @unrequested;
858     statusbar_msg_remove($bar_id);
859     if (!deps_msg(N("Some packages need to be removed"),
860     N("Because of their dependencies, the following package(s) must be unselected now:\n\n"),
861     \@nodes, \@nodes_with_deps)) {
862     @nodes_with_deps = ();
863     $urpm->resolve_requested(open_rpm_db(), $urpm->{state}, { map { $_->id => 1 } @unrequested });
864     goto packages_unselection_ok;
865     }
866     packages_unselection_ok:
867     }
868     }
869    
870     foreach (@nodes_with_deps) {
871     #- some deps may exist on some packages which aren't listed because
872     #- not upgradable (older than what currently installed)
873     exists $pkgs->{$_} or next;
874     if (!$pkgs->{$_}{pkg}) { #- can't be removed # FIXME; what about next packages in the loop?
875     $pkgs->{$_}{selected} = 0;
876     log::explanations("can't be removed: $_");
877     } else {
878     $pkgs->{$_}{selected} = $new_state;
879     }
880     $set_state->($_, node_state($_), $model);
881     if (my $pkg = $pkgs->{$_}{pkg}) {
882     # FIXME: shouldn't we threat all of them as POSITIVE (as selected size)
883     $size_selected += $pkg->size * ($pkg->flag_installed && !$pkg->flag_upgrade ? ($new_state ? -1 : 1) : ($new_state ? 1 : -1));
884     }
885     }
886     }
887    
888     sub is_there_selected_packages() {
889     int(grep { $pkgs->{$_}{selected} } keys %$pkgs);
890     }
891    
892     sub real_quit() {
893     if (is_there_selected_packages()) {
894     interactive_msg(N("Some packages are selected."), N("Some packages are selected.") . "\n" . N("Do you really want to quit?"), yesno => 1) or return;
895     }
896     Gtk2->main_quit;
897     }
898    
899     sub do_action__real {
900     my ($options, $callback_action, $o_info) = @_;
901     require urpm::sys;
902     if (!urpm::sys::check_fs_writable()) {
903     $urpm->{fatal}(1, N("Error: %s appears to be mounted read-only.", $urpm::sys::mountpoint));
904     return 1;
905     }
906     if (!$Rpmdrake::pkg::need_restart && !is_there_selected_packages()) {
907     interactive_msg(N("You need to select some packages first."), N("You need to select some packages first."));
908     return 1;
909     }
910     my $size_added = sum(map { if_($_->flag_selected && !$_->flag_installed, $_->size) } @{$urpm->{depslist}});
911     if ($MODE eq 'install' && $size_free - $size_added/1024 < 50*1024) {
912     interactive_msg(N("Too many packages are selected"),
913     N("Warning: it seems that you are attempting to add so much
914     packages that your filesystem may run out of free diskspace,
915     during or after package installation ; this is particularly
916     dangerous and should be considered with care.
917    
918     Do you really want to install all the selected packages?"), yesno => 1)
919     or return 1;
920     }
921     my $res = $callback_action->($urpm, $pkgs);
922     if (!$res) {
923     $force_rebuild = 1;
924     pkgs_provider({ skip_updating_mu => 1 }, $options->{tree_mode}, if_($Rpmdrake::pkg::probe_only_for_updates, pure_updates => 1));
925     reset_search();
926     $size_selected = 0;
927     (undef, $size_free) = MDK::Common::System::df('/usr');
928     $options->{rebuild_tree}->() if $options->{rebuild_tree};
929     gtktext_insert($o_info, '') if $o_info;
930     }
931     $res;
932     }
933    
934     sub do_action {
935     my ($options, $callback_action, $o_info) = @_;
936     my $res = eval { do_action__real($options, $callback_action, $o_info) };
937     my $err = $@;
938     # FIXME: offer to report the problem into bugzilla:
939     if ($err && $err !~ /cancel_perform/) {
940     interactive_msg(N("Fatal error"),
941     N("A fatal error occurred: %s.", $err));
942     }
943     $res;
944     }
945    
946     sub translate_group {
947     join('/', map { translate($_) } split m|/|, $_[0]);
948     }
949    
950     sub ctreefy {
951     join('|', map { translate($_) } split m|/|, $_[0]);
952     }
953    
954     sub _build_tree {
955     my ($elems, @elems) = @_;
956     #- we populate all the groups tree at first
957     %$elems = ();
958     # better loop on packages, create groups tree and push packages in the proper place:
959     foreach my $pkg (@elems) {
960     my $grp = $pkg->[1];
961     add_parent($grp);
962     $elems->{$grp} ||= [];
963     push @{$elems->{$grp}}, $pkg;
964     }
965     }
966    
967    
968     sub build_tree {
969     my ($tree, $tree_model, $elems, $options, $force_rebuild, $flat, $mode) = @_;
970     state $old_mode;
971     $mode = $options->{rmodes}{$mode} || $mode;
972     return if $old_mode eq $mode && !$force_rebuild;
973     $old_mode = $mode;
974     undef $force_rebuild;
975     my @elems;
976     my $wait; $wait = statusbar_msg(N("Please wait, listing packages...")) if $MODE ne 'update';
977     gtkflush();
978     {
979     my @keys = @filtered_pkgs;
980     if (member($mode, qw(all_updates security bugfix normal))) {
981     @keys = grep {
982     my ($name) = split_fullname($_);
983     member($descriptions->{$name}{importance}, @$mandrakeupdate_wanted_categories)
984     || ! $descriptions->{$name}{importance};
985     } @keys;
986     if (@keys == 0) {
987     add_node('', N("(none)"), { nochild => 1 });
988     state $explanation_only_once;
989     $explanation_only_once or interactive_msg(N("No update"),
990     N("The list of updates is empty. This means that either there is
991     no available update for the packages installed on your computer,
992     or you already installed all of them."));
993     $explanation_only_once = 1;
994     }
995     }
996     @elems = map { [ $_, !$flat && ctreefy($pkgs->{$_}{pkg}->group) ] } sort @keys;
997     }
998     my %sortmethods = (
999     by_size => sub { sort { $pkgs->{$b->[0]}{pkg}->size <=> $pkgs->{$a->[0]}{pkg}->size } @_ },
1000     by_selection => sub { sort { $pkgs->{$b->[0]}{selected} <=> $pkgs->{$a->[0]}{selected}
1001     || uc($a->[0]) cmp uc($b->[0]) } @_ },
1002     by_leaves => sub {
1003     # inlining part of MDK::Common::Data::difference2():
1004     my %l; @l{map { $_->[0] } @_} = ();
1005     my @pkgs_times = ('rpm', '-q', '--qf', '%{name}-%{version}-%{release}.%{arch} %{installtime}\n',
1006     map { chomp_($_) } run_program::get_stdout('urpmi_rpm-find-leaves'));
1007     sort { $b->[1] <=> $a->[1] } grep { exists $l{$_->[0]} } map { chomp; [ split ] } run_rpm(@pkgs_times);
1008     },
1009     flat => sub { no locale; sort { uc($a->[0]) cmp uc($b->[0]) } @_ },
1010     by_medium => sub { sort { $a->[2] <=> $b->[2] || uc($a->[0]) cmp uc($b->[0]) } @_ },
1011     );
1012     if ($flat) {
1013     add_node($_->[0], '') foreach $sortmethods{$::mode->[0] || 'flat'}->(@elems);
1014     } else {
1015     if (0 && $MODE eq 'update') {
1016     add_node($_->[0], N("All")) foreach $sortmethods{flat}->(@elems);
1017     $tree->expand_row($tree_model->get_path($tree_model->get_iter_first), 0);
1018     } elsif ($::mode->[0] eq 'by_source') {
1019     _build_tree($elems, $sortmethods{by_medium}->(map {
1020     my $m = pkg2medium($pkgs->{$_->[0]}{pkg}, $urpm); [ $_->[0], $m->{name}, $m->{priority} ];
1021     } @elems));
1022     } elsif ($::mode->[0] eq 'by_presence') {
1023     _build_tree($elems, map {
1024     my $pkg = $pkgs->{$_->[0]}{pkg};
1025     [ $_->[0], $pkg->flag_installed ?
1026     (!$pkg->flag_skip && $pkg->flag_upgrade ? N("Upgradable") : N("Installed"))
1027     : N("Addable") ];
1028     } $sortmethods{flat}->(@elems));
1029     } else {
1030     _build_tree($elems, @elems);
1031     }
1032     }
1033     statusbar_msg_remove($wait) if defined $wait;
1034     }
1035    
1036     sub get_info {
1037     my ($key, $widget) = @_;
1038     #- the package information hasn't been loaded. Instead of rescanning the media, just give up.
1039     exists $pkgs->{$key} or return [ [ N("Description not available for this package\n") ] ];
1040     #- get the description if needed:
1041     exists $pkgs->{$key}{description} or slow_func($widget, sub { extract_header($pkgs->{$key}, $urpm, 'info') });
1042     format_pkg_simplifiedinfo($pkgs, $key, $urpm, $descriptions);
1043     }
1044    
1045     sub sort_callback {
1046     my ($store, $treeiter1, $treeiter2) = @_;
1047     URPM::rpmvercmp(map { $store->get_value($_, $pkg_columns{version}) } $treeiter1, $treeiter2);
1048     }
1049    
1050     sub run_help_callback {
1051     my (undef, $url) = @_;
1052     run_program::raw({ detach => 1, as_user => 1 }, 'www-browser', $url);
1053     }
1054    
1055     1;

  ViewVC Help
Powered by ViewVC 1.1.30