4 # path to your brestore.glade
5 my $glade_file = 'brestore.glade' ;
9 brestore.pl - A Perl/Gtk console for Bacula
17 Setup ~/.brestore.conf to find your brestore.glade
19 On debian like system, you need :
20 - libgtk2-gladexml-perl
21 - libdbd-mysql-perl or libdbd-pg-perl
24 To speed up database query you have to create theses indexes
25 - CREATE INDEX file_pathid on File(PathId);
28 To follow restore job, you must have a running Bweb installation.
32 Copyright (C) 2006 Marc Cousin and Eric Bollengier
34 This library is free software; you can redistribute it and/or
35 modify it under the terms of the GNU Lesser General Public
36 License as published by the Free Software Foundation; either
37 version 2 of the License, or (at your option) any later version.
39 This library is distributed in the hope that it will be useful,
40 but WITHOUT ANY WARRANTY; without even the implied warranty of
41 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
42 Lesser General Public License for more details.
44 You should have received a copy of the GNU Lesser General Public
45 License along with this library; if not, write to the
46 Free Software Foundation, Inc., 59 Temple Place - Suite 330,
47 Boston, MA 02111-1307, USA.
49 Base 64 functions from Karl Hakimian <hakimian@aha.com>
50 Integrally copied from recover.pl from bacula source distribution.
54 use File::Spec; # portable path manipulations
55 use Gtk2 '-init'; # auto-initialize Gtk2
57 use Gtk2::SimpleList; # easy wrapper for list views
58 use Gtk2::Gdk::Keysyms; # keyboard code constants
59 use Data::Dumper qw/Dumper/;
61 my $debug=0; # can be on brestore.conf
63 ################################################################
65 package DlgFileVersion;
67 sub on_versions_close_clicked
69 my ($self, $widget)=@_;
70 $self->{version}->destroy();
73 sub on_selection_button_press_event
75 print "on_selection_button_press_event()\n";
80 my ($self, $widget, $context, $data, $info, $time,$string) = @_;
82 DlgResto::drag_set_info($widget,
89 my ($class, $dbh, $client, $path, $file) = @_;
92 version => undef, # main window
95 # we load version widget of $glade_file
96 my $glade_box = Gtk2::GladeXML->new($glade_file, "dlg_version");
98 # Connect signals magically
99 $glade_box->signal_autoconnect_from_package($self);
101 $glade_box->get_widget("version_label")
102 ->set_markup("<b>File revisions : $client:$path/$file</b>");
104 my $widget = $glade_box->get_widget('version_fileview');
105 my $fileview = Gtk2::SimpleList->new_from_treeview(
107 'h_name' => 'hidden',
108 'h_jobid' => 'hidden',
109 'h_type' => 'hidden',
111 'InChanger' => 'pixbuf',
118 DlgResto::init_drag_drop($fileview);
120 my @v = DlgResto::get_all_file_versions($dbh,
126 my (undef,$fn,$jobid,$fileindex,$mtime,$size,$inchanger,$md5,$volname)
128 my $icon = ($inchanger)?$DlgResto::yesicon:$DlgResto::noicon;
130 DlgResto::listview_push($fileview,
131 $file, $jobid, 'file',
132 $icon, $volname, $jobid,DlgResto::human($size),
133 scalar(localtime($mtime)), $md5);
136 $self->{version} = $glade_box->get_widget('dlg_version');
137 $self->{version}->show();
142 sub on_forward_keypress
148 ################################################################
153 my ($package, $text) = @_;
157 my $glade = Gtk2::GladeXML->new($glade_file, "dlg_warn");
159 # Connect signals magically
160 $glade->signal_autoconnect_from_package($self);
161 $glade->get_widget('label_warn')->set_text($text);
165 $self->{window} = $glade->get_widget('dlg_warn');
166 $self->{window}->show_all();
173 $self->{window}->destroy();
177 ################################################################
183 # %arg = (bsr_file => '/path/to/bsr', # on director
184 # volumes => [ '00001', '00004']
190 my ($class, %arg) = @_;
193 bsr_file => $arg{bsr_file}, # /path/to/bsr on director
194 pref => $arg{pref}, # Pref ref
195 glade => undef, # GladeXML ref
196 bconsole => undef, # Bconsole ref
199 # we load launch widget of $glade_file
200 my $glade = $self->{glade} = Gtk2::GladeXML->new($glade_file,
203 # Connect signals magically
204 $glade->signal_autoconnect_from_package($self);
206 my $widget = $glade->get_widget('volumeview');
207 my $volview = Gtk2::SimpleList->new_from_treeview(
209 'InChanger' => 'pixbuf',
213 my $infos = get_volume_inchanger($arg{pref}->{dbh}, $arg{volumes}) ;
215 # we replace 0 and 1 by $noicon and $yesicon
216 for my $i (@{$infos}) {
218 $i->[0] = $DlgResto::noicon;
220 $i->[0] = $DlgResto::yesicon;
225 push @{ $volview->{data} }, @{$infos} ;
227 my $console = $self->{bconsole} = new Bconsole(pref => $arg{pref});
229 # fill client combobox (with director defined clients
230 my @clients = $console->list_client() ; # get from bconsole
231 if ($console->{error}) {
232 new DlgWarn("Can't use bconsole:\n$arg{pref}->{bconsole}: $console->{error}") ;
234 my $w = $self->{combo_client} = $glade->get_widget('combo_launch_client') ;
235 $self->{list_client} = DlgResto::init_combo($w, 'text');
236 DlgResto::fill_combo($self->{list_client},
237 $DlgResto::client_list_empty,
241 # fill fileset combobox
242 my @fileset = $console->list_fileset() ;
243 $w = $self->{combo_fileset} = $glade->get_widget('combo_launch_fileset') ;
244 $self->{list_fileset} = DlgResto::init_combo($w, 'text');
245 DlgResto::fill_combo($self->{list_fileset}, '', @fileset);
248 my @job = $console->list_job() ;
249 $w = $self->{combo_job} = $glade->get_widget('combo_launch_job') ;
250 $self->{list_job} = DlgResto::init_combo($w, 'text');
251 DlgResto::fill_combo($self->{list_job}, '', @job);
253 # find default_restore_job in jobs list
254 my $default_restore_job = $arg{pref}->{default_restore_job} ;
258 if ($j =~ /$default_restore_job/io) {
264 $w->set_active($index);
266 # fill storage combobox
267 my @storage = $console->list_storage() ;
268 $w = $self->{combo_storage} = $glade->get_widget('combo_launch_storage') ;
269 $self->{list_storage} = DlgResto::init_combo($w, 'text');
270 DlgResto::fill_combo($self->{list_storage}, '', @storage);
272 $glade->get_widget('dlg_launch')->show_all();
279 my ($self, $client, $jobid) = @_;
281 my $ret = $self->{pref}->go_bweb("?action=dsp_cur_job;jobid=$jobid;client=$client", "view job status");
284 my $widget = Gtk2::MessageDialog->new(undef, 'modal', 'info', 'close',
285 "Your job have been submited to bacula.
286 To follow it, you must use bconsole (or install/configure bweb)");
291 $self->on_cancel_resto_clicked();
294 sub on_cancel_resto_clicked
297 $self->{glade}->get_widget('dlg_launch')->destroy();
300 sub on_submit_resto_clicked
303 my $glade = $self->{glade};
305 my $r = $self->copy_bsr($self->{bsr_file}, $self->{pref}->{bsr_dest}) ;
308 new DlgWarn("Can't copy bsr file to director ($self->{error})");
312 my $fileset = $glade->get_widget('combo_launch_fileset')
315 my $storage = $glade->get_widget('combo_launch_storage')
318 my $where = $glade->get_widget('entry_launch_where')->get_text();
320 my $job = $glade->get_widget('combo_launch_job')
324 new DlgWarn("Can't use this job");
328 my $client = $glade->get_widget('combo_launch_client')
331 if (! $client or $client eq $DlgResto::client_list_empty) {
332 new DlgWarn("Can't use this client ($client)");
336 my $prio = $glade->get_widget('spin_launch_priority')->get_value();
338 my $replace = $glade->get_widget('chkbp_launch_replace')->get_active();
339 $replace=($replace)?'always':'never';
341 my $jobid = $self->{bconsole}->run(job => $job,
350 $self->show_job($client, $jobid);
353 sub on_combo_storage_button_press_event
356 print "on_combo_storage_button_press_event()\n";
359 sub on_combo_fileset_button_press_event
362 print "on_combo_fileset_button_press_event()\n";
366 sub on_combo_job_button_press_event
369 print "on_combo_job_button_press_event()\n";
372 sub get_volume_inchanger
374 my ($dbh, $vols) = @_;
376 my $lst = join(',', map { $dbh->quote($_) } @{ $vols } ) ;
378 my $rq = "SELECT InChanger, VolumeName
380 WHERE VolumeName IN ($lst)
383 my $res = $dbh->selectall_arrayref($rq);
384 return $res; # [ [ 1, VolName].. ]
388 use File::Copy qw/copy/;
389 use File::Basename qw/basename/;
391 # We must kown the path+filename destination
392 # $self->{error} contains error message
393 # it return 0/1 if fail/success
396 my ($self, $src, $dst) = @_ ;
397 print "$src => $dst\n"
404 if ($dst =~ m!file:/(/.+)!) {
405 $ret = copy($src, $1);
407 $dstfile = "$1/" . basename($src) ;
409 } elsif ($dst =~ m!scp://([^:]+:(.+))!) {
410 $err = `scp $src $1 2>&1` ;
412 $dstfile = "$2/" . basename($src) ;
416 $err = "$dst not implemented yet";
417 File::Copy::copy($src, \*STDOUT);
420 $self->{error} = $err;
423 $self->{error} = $err;
432 ################################################################
440 unless ($about_widget) {
441 my $glade_box = Gtk2::GladeXML->new($glade_file, "dlg_about") ;
442 $about_widget = $glade_box->get_widget("dlg_about") ;
443 $glade_box->signal_autoconnect_from_package('DlgAbout');
445 $about_widget->show() ;
448 sub on_about_okbutton_clicked
450 $about_widget->hide() ;
455 ################################################################
461 my ($class, $config_file) = @_;
464 config_file => $config_file,
465 password => '', # db passwd
466 username => '', # db username
467 connection_string => '',# db connection string
468 bconsole => 'bconsole', # path and arg to bconsole
469 bsr_dest => '', # destination url for bsr files
470 debug => 0, # debug level 0|1
471 use_ok_bkp_only => 1, # dont use bad backup
472 bweb => 'http://localhost/cgi-bin/bweb/bweb.pl', # bweb url
473 glade_file => $glade_file,
474 see_all_versions => 0, # display all file versions in FileInfo
475 mozilla => 'mozilla', # mozilla bin
476 default_restore_job => 'restore', # regular expression to select default
479 # keywords that are used to fill DlgPref
480 chk_keyword => [ qw/use_ok_bkp_only debug see_all_versions/ ],
481 entry_keyword => [ qw/username password bweb mozilla
482 connection_string default_restore_job
483 bconsole bsr_dest glade_file/],
486 $self->read_config();
495 # We read the parameters. They come from the configuration files
496 my $cfgfile ; my $tmpbuffer;
497 if (open FICCFG, $self->{config_file})
499 while(read FICCFG,$tmpbuffer,4096)
501 $cfgfile .= $tmpbuffer;
505 no strict; # I have no idea of the contents of the file
506 eval '$refparams' . " = $cfgfile";
509 for my $p (keys %{$refparams}) {
510 $self->{$p} = $refparams->{$p};
513 if (defined $self->{debug}) {
514 $debug = $self->{debug} ;
517 # TODO : Force dumb default values and display a message
527 for my $k (@{ $self->{entry_keyword} }) {
528 $parameters{$k} = $self->{$k};
531 for my $k (@{ $self->{chk_keyword} }) {
532 $parameters{$k} = $self->{$k};
535 if (open FICCFG,">$self->{config_file}")
537 print FICCFG Data::Dumper->Dump([\%parameters], [qw($parameters)]);
542 # TODO : Display a message
551 $self->{dbh}->disconnect() ;
555 delete $self->{error};
557 if (not $self->{connection_string})
559 # The parameters have not been set. Maybe the conf
560 # file is empty for now
561 $self->{error} = "No configuration found for database connection. " .
562 "Please set this up.";
567 $self->{dbh} = DBI->connect($self->{connection_string},
572 $self->{error} = "Can't open bacula database. " .
573 "Database connect string '" .
574 $self->{connection_string} ."' $!";
577 $self->{dbh}->{RowCacheSize}=100;
583 my ($self, $url, $msg) = @_;
585 unless ($self->{mozilla} and $self->{bweb}) {
586 new DlgWarn("You must install Bweb and set your mozilla bin to $msg");
590 system("$self->{mozilla} -remote 'Ping()'");
592 new DlgWarn("Warning, you must have a running $self->{mozilla} to $msg");
596 my $cmd = "$self->{mozilla} -remote 'OpenURL($self->{bweb}$url,new-tab)'" ;
604 ################################################################
608 # my $pref = new Pref(config_file => 'brestore.conf');
609 # my $dlg = new DlgPref($pref);
610 # my $dlg_resto = new DlgResto($pref);
611 # $dlg->display($dlg_resto);
614 my ($class, $pref) = @_;
617 pref => $pref, # Pref ref
618 dlgresto => undef, # DlgResto ref
626 my ($self, $dlgresto) = @_ ;
628 unless ($self->{glade}) {
629 $self->{glade} = Gtk2::GladeXML->new($glade_file, "dlg_pref") ;
630 $self->{glade}->signal_autoconnect_from_package($self);
633 $self->{dlgresto} = $dlgresto;
635 my $g = $self->{glade};
636 my $p = $self->{pref};
638 for my $k (@{ $p->{entry_keyword} }) {
639 $g->get_widget("entry_$k")->set_text($p->{$k}) ;
642 for my $k (@{ $p->{chk_keyword} }) {
643 $g->get_widget("chkbp_$k")->set_active($p->{$k}) ;
646 $g->get_widget("dlg_pref")->show_all() ;
649 sub on_applybutton_clicked
652 my $glade = $self->{glade};
653 my $pref = $self->{pref};
655 for my $k (@{ $pref->{entry_keyword} }) {
656 my $w = $glade->get_widget("entry_$k") ;
657 $pref->{$k} = $w->get_text();
660 for my $k (@{ $pref->{chk_keyword} }) {
661 my $w = $glade->get_widget("chkbp_$k") ;
662 $pref->{$k} = $w->get_active();
665 $pref->write_config();
666 if ($pref->connect_db()) {
667 $self->{dlgresto}->set_dbh($pref->{dbh});
668 $self->{dlgresto}->set_status('Preferences updated');
669 $self->{dlgresto}->init_server_backup_combobox();
671 $self->{dlgresto}->set_status($pref->{error});
675 # Handle prefs ok click (apply/dismiss dialog)
676 sub on_okbutton_clicked
679 $self->on_applybutton_clicked();
681 unless ($self->{pref}->{error}) {
682 $self->on_cancelbutton_clicked();
685 sub on_dialog_delete_event
688 $self->on_cancelbutton_clicked();
692 sub on_cancelbutton_clicked
695 $self->{glade}->get_widget('dlg_pref')->hide();
696 delete $self->{dlgresto};
700 ################################################################
710 # Kept as is from the perl-gtk example. Draws the pretty icons
716 $diricon = $self->{mainwin}->render_icon('gtk-open', $size);
717 $fileicon = $self->{mainwin}->render_icon('gtk-new', $size);
718 $yesicon = $self->{mainwin}->render_icon('gtk-yes', $size);
719 $noicon = $self->{mainwin}->render_icon('gtk-no', $size);
723 # init combo (and create ListStore object)
726 my ($widget, @type) = @_ ;
727 my %type_info = ('text' => 'Glib::String',
728 'markup' => 'Glib::String',
731 my $lst = new Gtk2::ListStore ( map { $type_info{$_} } @type );
733 $widget->set_model($lst);
737 if ($t eq 'text' or $t eq 'markup') {
738 $cell = new Gtk2::CellRendererText();
740 $widget->pack_start($cell, 1);
741 $widget->add_attribute($cell, $t, $i++);
746 # fill simple combo (one element per row)
749 my ($list, @what) = @_;
753 foreach my $w (@what)
756 my $i = $list->append();
757 $list->set($i, 0, $w);
764 my @unit = qw(b Kb Mb Gb Tb);
767 my $format = '%i %s';
768 while ($val / 1024 > 1) {
772 $format = ($i>0)?'%0.1f %s':'%i %s';
773 return sprintf($format, $val, $unit[$i]);
778 my ($self, $dbh) = @_;
784 my ($fileview) = shift;
785 my $fileview_target_entry = {target => 'STRING',
786 flags => ['GTK_TARGET_SAME_APP'],
789 $fileview->enable_model_drag_source(['button1_mask', 'button3_mask'],
790 ['copy'],$fileview_target_entry);
791 $fileview->get_selection->set_mode('multiple');
793 # set some useful SimpleList properties
794 $fileview->set_headers_clickable(0);
795 foreach ($fileview->get_columns())
797 $_->set_resizable(1);
798 $_->set_sizing('grow-only');
804 my ($class, $pref) = @_;
809 location => undef, # location entry widget
810 mainwin => undef, # mainwin widget
811 filelist_file_menu => undef, # file menu widget
812 filelist_dir_menu => undef, # dir menu widget
813 glade => undef, # glade object
814 status => undef, # status bar widget
815 dlg_pref => undef, # DlgPref object
816 fileattrib => {}, # cache file
817 fileview => undef, # fileview widget SimpleList
818 fileinfo => undef, # fileinfo widget SimpleList
820 client_combobox => undef, # client_combobox widget
821 restore_backup_combobox => undef, # date combobox widget
822 list_client => undef, # Gtk2::ListStore
823 list_backup => undef, # Gtk2::ListStore
826 # load menu (to use handler with self reference)
827 my $glade = Gtk2::GladeXML->new($glade_file, "filelist_file_menu");
828 $glade->signal_autoconnect_from_package($self);
829 $self->{filelist_file_menu} = $glade->get_widget("filelist_file_menu");
831 $glade = Gtk2::GladeXML->new($glade_file, "filelist_dir_menu");
832 $glade->signal_autoconnect_from_package($self);
833 $self->{filelist_dir_menu} = $glade->get_widget("filelist_dir_menu");
835 $glade = $self->{glade} = Gtk2::GladeXML->new($glade_file, "dlg_resto");
836 $glade->signal_autoconnect_from_package($self);
838 $self->{status} = $glade->get_widget('statusbar');
839 $self->{mainwin} = $glade->get_widget('dlg_resto');
840 $self->{location} = $glade->get_widget('entry_location');
841 $self->render_icons();
843 $self->{dlg_pref} = new DlgPref($pref);
845 my $c = $self->{client_combobox} = $glade->get_widget('combo_client');
846 $self->{list_client} = init_combo($c, 'text');
848 $c = $self->{restore_backup_combobox} = $glade->get_widget('combo_list_backups');
849 $self->{list_backup} = init_combo($c, 'text', 'markup');
851 # Connect glade-fileview to Gtk2::SimpleList
852 # and set up drag n drop between $fileview and $restore_list
854 # WARNING : we have big dirty thinks with gtk/perl and utf8/iso strings
855 # we use an hidden field uuencoded to bypass theses bugs (h_name)
857 my $widget = $glade->get_widget('fileview');
858 my $fileview = $self->{fileview} = Gtk2::SimpleList->new_from_treeview(
860 'h_name' => 'hidden',
861 'h_jobid' => 'hidden',
862 'h_type' => 'hidden',
865 'File Name' => 'text',
868 init_drag_drop($fileview);
869 $fileview->set_search_column(4); # search on File Name
871 # Connect glade-restore_list to Gtk2::SimpleList
872 $widget = $glade->get_widget('restorelist');
873 my $restore_list = $self->{restore_list} = Gtk2::SimpleList->new_from_treeview(
875 'h_name' => 'hidden',
876 'h_jobid' => 'hidden',
877 'h_type' => 'hidden',
878 'h_curjobid' => 'hidden',
881 'File Name' => 'text',
883 'FileIndex' => 'text',
885 'Nb Files' => 'text', #8
887 'size_b' => 'hidden', #10
890 my @restore_list_target_table = ({'target' => 'STRING',
894 $restore_list->enable_model_drag_dest(['copy'],@restore_list_target_table);
895 $restore_list->get_selection->set_mode('multiple');
897 $widget = $glade->get_widget('infoview');
898 my $infoview = $self->{fileinfo} = Gtk2::SimpleList->new_from_treeview(
900 'h_name' => 'hidden',
901 'h_jobid' => 'hidden',
902 'h_type' => 'hidden',
904 'InChanger' => 'pixbuf',
911 init_drag_drop($infoview);
913 $pref->connect_db() || $self->{dlg_pref}->display($self);
916 $self->{dbh} = $pref->{dbh};
917 $self->init_server_backup_combobox();
921 # set status bar informations
924 my ($self, $string) = @_;
925 my $context = $self->{status}->get_context_id('Main');
926 $self->{status}->push($context, $string);
929 sub on_time_select_changed
937 my $c = $self->{glade}->get_widget('combo_time');
938 return $c->get_active_text;
941 # This sub returns all clients declared in DB
945 my $query = "SELECT Name FROM Client ORDER BY Name";
946 print $query,"\n" if $debug;
947 my $result = $dbh->selectall_arrayref($query);
949 foreach my $refrow (@$result)
951 push @return_array,($refrow->[0]);
953 return @return_array;
956 sub get_wanted_job_status
963 return "'T', 'A', 'E'";
967 # This sub gives a full list of the EndTimes for a ClientId
968 # ( [ 'Date', 'FileSet', 'Type', 'Status', 'JobId'],
969 # ['Date', 'FileSet', 'Type', 'Status', 'JobId']..)
970 sub get_all_endtimes_for_job
972 my ($dbh, $client, $ok_only)=@_;
973 my $status = get_wanted_job_status($ok_only);
975 SELECT Job.EndTime, FileSet.FileSet, Job.Level, Job.JobStatus, Job.JobId
976 FROM Job,Client,FileSet
977 WHERE Job.ClientId=Client.ClientId
978 AND Client.Name = '$client'
980 AND JobStatus IN ($status)
981 AND Job.FileSetId = FileSet.FileSetId
982 ORDER BY EndTime desc";
983 print $query,"\n" if $debug;
984 my $result = $dbh->selectall_arrayref($query);
990 # init infoview widget
994 @{$self->{fileinfo}->{data}} = ();
1001 @{$self->{restore_list}->{data}} = ();
1004 sub on_estimate_clicked
1011 # TODO : If we get here, things could get lenghty ... draw a popup window .
1012 my $widget = Gtk2::MessageDialog->new($self->{mainwin},
1013 'destroy-with-parent',
1015 'Computing size...');
1019 my $title = "Computing size...\n";
1021 foreach my $entry (@{$self->{restore_list}->{data}})
1023 unless ($entry->[9]) {
1024 my ($size, $nb) = $self->estimate_restore_size($entry);
1025 $entry->[10] = $size;
1026 $entry->[9] = human($size);
1030 my $name = unpack('u', $entry->[0]);
1032 $txt .= "\n<i>$name</i> : " . $entry->[8] . " file(s)/" . $entry->[9] ;
1033 $widget->set_markup($title . $txt);
1035 $size_total+=$entry->[10];
1036 $nb_total+=$entry->[8];
1040 $txt .= "\n\n<b>Total</b> : $nb_total file(s)/" . human($size_total);
1041 $widget->set_markup("Size estimation :\n" . $txt);
1042 $widget->signal_connect ("response", sub { my $w=shift; $w->destroy();});
1047 sub on_gen_bsr_clicked
1051 my @options = ("Choose a bsr file", $self->{mainwin}, 'save',
1052 'gtk-save','ok', 'gtk-cancel', 'cancel');
1055 my $w = new Gtk2::FileChooserDialog ( @options );
1060 if ($a eq 'cancel') {
1065 my $f = $w->get_filename();
1067 my $dlg = Gtk2::MessageDialog->new($self->{mainwin},
1068 'destroy-with-parent',
1069 'warning', 'ok-cancel', 'This file already exists, do you want to overwrite it ?');
1070 if ($dlg->run() eq 'ok') {
1084 if (open(FP, ">$save")) {
1085 my $bsr = $self->create_filelist();
1088 $self->set_status("Dumping BSR to $save ok");
1090 $self->set_status("Can't dump BSR to $save: $!");
1095 use File::Temp qw/tempfile/;
1097 sub on_go_button_clicked
1100 my $bsr = $self->create_filelist();
1101 my ($fh, $filename) = tempfile();
1104 chmod(0644, $filename);
1106 print "Dumping BSR info to $filename\n"
1109 # we get Volume list
1110 my %a = map { $_ => 1 } ($bsr =~ /Volume="(.+)"/g);
1111 my $vol = [ keys %a ] ; # need only one occurrence of each volume
1113 new DlgLaunch(pref => $self->{pref},
1115 bsr_file => $filename,
1120 our $client_list_empty = 'Clients list';
1121 our %type_markup = ('F' => '<b>$label F</b>',
1124 'B' => '<b>$label B</b>',
1126 'A' => '<span foreground=\"red\">$label</span>',
1128 'E' => '<span foreground=\"red\">$label</span>',
1131 sub on_list_client_changed
1133 my ($self, $widget) = @_;
1134 return 0 unless defined $self->{fileview};
1135 my $dbh = $self->{dbh};
1137 $self->{list_backup}->clear();
1139 if ($self->current_client eq $client_list_empty) {
1143 my @endtimes=get_all_endtimes_for_job($dbh,
1144 $self->current_client,
1145 $self->{pref}->{use_ok_bkp_only});
1146 foreach my $endtime (@endtimes)
1148 my $i = $self->{list_backup}->append();
1150 my $label = $endtime->[1] . " (" . $endtime->[4] . ")";
1151 eval "\$label = \"$type_markup{$endtime->[2]}\""; # job type
1152 eval "\$label = \"$type_markup{$endtime->[3]}\""; # job status
1154 $self->{list_backup}->set($i,
1159 $self->{restore_backup_combobox}->set_active(0);
1161 $self->{CurrentJobIds} = [
1162 set_job_ids_for_date($dbh,
1163 $self->current_client,
1164 $self->current_date,
1165 $self->{pref}->{use_ok_bkp_only})
1170 # undef $self->{dirtree};
1171 $self->refresh_fileview();
1175 sub fill_server_list
1177 my ($dbh, $combo, $list) = @_;
1179 my @clients=get_all_clients($dbh);
1183 my $i = $list->append();
1184 $list->set($i, 0, $client_list_empty);
1186 foreach my $client (@clients)
1188 $i = $list->append();
1189 $list->set($i, 0, $client);
1191 $combo->set_active(0);
1194 sub init_server_backup_combobox
1197 fill_server_list($self->{dbh},
1198 $self->{client_combobox},
1199 $self->{list_client}) ;
1202 #----------------------------------------------------------------------
1203 #Refreshes the file-view Redraws everything. The dir data is cached, the file
1204 #data isn't. There is additionnal complexity for dirs (visibility problems),
1205 #so the @CurrentJobIds is not sufficient.
1206 sub refresh_fileview
1209 my $fileview = $self->{fileview};
1210 my $client_combobox = $self->{client_combobox};
1211 my $cwd = $self->{cwd};
1213 @{$fileview->{data}} = ();
1215 $self->clear_infoview();
1217 my $client_name = $self->current_client;
1219 if (!$client_name or ($client_name eq $client_list_empty)) {
1220 $self->set_status("Client list empty");
1224 my @dirs = $self->list_dirs($cwd,$client_name);
1225 # [ [listfiles.id, listfiles.Name, File.LStat, File.JobId]..]
1226 my $files = $self->list_files($cwd);
1227 print "CWD : $cwd\n" if ($debug);
1229 my $file_count = 0 ;
1230 my $total_bytes = 0;
1232 # Add directories to view
1233 foreach my $dir (@dirs) {
1234 my $time = localtime($self->dir_attrib("$cwd/$dir",'st_mtime'));
1235 $total_bytes += 4096;
1238 listview_push($fileview,
1240 $self->dir_attrib("$cwd/$dir",'jobid'),
1250 foreach my $file (@$files)
1252 my $size = file_attrib($file,'st_size');
1253 my $time = localtime(file_attrib($file,'st_mtime'));
1254 $total_bytes += $size;
1256 # $file = [listfiles.id, listfiles.Name, File.LStat, File.JobId]
1258 listview_push($fileview,
1265 human($size), $time);
1268 $self->set_status("$file_count files/" . human($total_bytes));
1270 # set a decent default selection (makes keyboard nav easy)
1271 $fileview->select(0);
1275 sub on_about_activate
1277 DlgAbout::display();
1282 my ($tree, $path, $data) = @_;
1284 my @items = listview_get_all($tree) ;
1286 foreach my $i (@items)
1288 my @file_info = @{$i};
1291 # Ok, we have a corner case :
1296 $file = pack("u", $file_info[0]);
1300 $file = pack("u", $path . '/' . $file_info[0]);
1302 push @ret, join(" ; ", $file,
1303 $file_info[1], # $jobid
1304 $file_info[2], # $type
1308 my $data_get = join(" :: ", @ret);
1310 $data->set_text($data_get,-1);
1313 sub fileview_data_get
1315 my ($self, $widget, $context, $data, $info, $time,$string) = @_;
1316 drag_set_info($widget, $self->{cwd}, $data);
1319 sub fileinfo_data_get
1321 my ($self, $widget, $context, $data, $info, $time,$string) = @_;
1322 drag_set_info($widget, $self->{cwd}, $data);
1325 sub restore_list_data_received
1327 my ($self, $widget, $context, $x, $y, $data, $info, $time) = @_;
1330 if ($info eq 40 || $info eq 0) # patch for display!=:0
1332 foreach my $elt (split(/ :: /, $data->data()))
1335 my ($file, $jobid, $type) =
1337 $file = unpack("u", $file);
1339 $self->add_selected_file_to_list($file, $jobid, $type);
1344 sub on_back_button_clicked {
1348 sub on_location_go_button_clicked
1351 $self->ch_dir($self->{location}->get_text());
1353 sub on_quit_activate {Gtk2->main_quit;}
1354 sub on_preferences_activate
1357 $self->{dlg_pref}->display($self) ;
1359 sub on_main_delete_event {Gtk2->main_quit;}
1360 sub on_bweb_activate
1363 $self->set_status("Open bweb on your browser");
1364 $self->{pref}->go_bweb('', "go on bweb");
1367 # Change to parent directory
1371 if ($self->{cwd} eq '/')
1375 my @dirs = File::Spec->splitdir ($self->{cwd});
1377 $self->ch_dir(File::Spec->catdir(@dirs));
1380 # Change the current working directory
1381 # * Updates fileview, location, and selection
1386 $self->{cwd} = shift;
1388 $self->refresh_fileview();
1389 $self->{location}->set_text($self->{cwd});
1394 # Handle dialog 'close' (window-decoration induced close)
1395 # * Just hide the dialog, and tell Gtk not to do anything else
1399 my ($self, $w) = @_;
1402 1; # consume this event!
1405 # Handle key presses in location text edit control
1406 # * Translate a Return/Enter key into a 'Go' command
1407 # * All other key presses left for GTK
1409 sub on_location_entry_key_release_event
1415 my $keypress = $event->keyval;
1416 if ($keypress == $Gtk2::Gdk::Keysyms{KP_Enter} ||
1417 $keypress == $Gtk2::Gdk::Keysyms{Return})
1419 $self->ch_dir($widget->get_text());
1421 return 1; # consume keypress
1424 return 0; # let gtk have the keypress
1427 sub on_fileview_key_press_event
1429 my ($self, $widget, $event) = @_;
1433 sub listview_get_first
1436 my @selected = $list->get_selected_indices();
1437 if (@selected > 0) {
1438 my ($name, @other) = @{$list->{data}->[$selected[0]]};
1439 return (unpack('u', $name), @other);
1445 sub listview_get_all
1449 my @selected = $list->get_selected_indices();
1451 for my $i (@selected) {
1452 my ($name, @other) = @{$list->{data}->[$i]};
1453 push @ret, [unpack('u', $name), @other];
1461 my ($list, $name, @other) = @_;
1462 push @{$list->{data}}, [pack('u', $name), @other];
1465 #----------------------------------------------------------------------
1466 # Handle keypress in file-view
1467 # * Translates backspace into a 'cd ..' command
1468 # * All other key presses left for GTK
1470 sub on_fileview_key_release_event
1472 my ($self, $widget, $event) = @_;
1473 if (not $event->keyval)
1477 if ($event->keyval == $Gtk2::Gdk::Keysyms{BackSpace}) {
1479 return 1; # eat keypress
1482 return 0; # let gtk have keypress
1485 sub on_forward_keypress
1490 #----------------------------------------------------------------------
1491 # Handle double-click (or enter) on file-view
1492 # * Translates into a 'cd <dir>' command
1494 sub on_fileview_row_activated
1496 my ($self, $widget) = @_;
1498 my ($name, undef, $type, undef) = listview_get_first($widget);
1502 if ($self->{cwd} eq '')
1504 $self->ch_dir($name);
1506 elsif ($self->{cwd} eq '/')
1508 $self->ch_dir('/' . $name);
1512 $self->ch_dir($self->{cwd} . '/' . $name);
1516 $self->fill_infoview($self->{cwd}, $name);
1519 return 1; # consume event
1524 my ($self, $path, $file) = @_;
1525 $self->clear_infoview();
1526 my @v = get_all_file_versions($self->{dbh},
1529 $self->current_client,
1530 $self->{pref}->{see_all_versions});
1532 my (undef,$fn,$jobid,$fileindex,$mtime,$size,$inchanger,$md5,$volname)
1534 my $icon = ($inchanger)?$yesicon:$noicon;
1536 $mtime = localtime($mtime) ;
1538 listview_push($self->{fileinfo},
1539 $file, $jobid, 'file',
1540 $icon, $volname, $jobid, human($size), $mtime, $md5);
1547 return $self->{restore_backup_combobox}->get_active_text;
1553 return $self->{client_combobox}->get_active_text;
1556 sub on_list_backups_changed
1558 my ($self, $widget) = @_;
1559 return 0 unless defined $self->{fileview};
1561 $self->{CurrentJobIds} = [
1562 set_job_ids_for_date($self->{dbh},
1563 $self->current_client,
1564 $self->current_date,
1565 $self->{pref}->{use_ok_bkp_only})
1568 $self->refresh_fileview();
1572 sub on_restore_list_keypress
1574 my ($self, $widget, $event) = @_;
1575 if ($event->keyval == $Gtk2::Gdk::Keysyms{Delete})
1577 my @sel = $widget->get_selected_indices;
1578 foreach my $elt (reverse(sort {$a <=> $b} @sel))
1580 splice @{$self->{restore_list}->{data}},$elt,1;
1585 sub on_fileview_button_press_event
1587 my ($self,$widget,$event) = @_;
1588 if ($event->button == 3)
1590 $self->on_right_click_filelist($widget,$event);
1594 if ($event->button == 2)
1596 $self->on_see_all_version();
1603 sub on_see_all_version
1607 my @lst = listview_get_all($self->{fileview});
1610 my ($name, undef) = @{$i};
1612 new DlgFileVersion($self->{dbh},
1613 $self->current_client,
1614 $self->{cwd}, $name);
1618 sub on_right_click_filelist
1620 my ($self,$widget,$event) = @_;
1621 # I need to know what's selected
1622 my @sel = listview_get_all($self->{fileview});
1627 $type = $sel[0]->[2]; # $type
1632 if (@sel >=2 or $type eq 'dir')
1634 # We have selected more than one or it is a directories
1635 $w = $self->{filelist_dir_menu};
1639 $w = $self->{filelist_file_menu};
1645 $event->button, $event->time);
1648 sub context_add_to_filelist
1652 my @sel = listview_get_all($self->{fileview});
1654 foreach my $i (@sel)
1656 my ($file, $jobid, $type, undef) = @{$i};
1657 $file = $self->{cwd} . '/' . $file;
1658 $self->add_selected_file_to_list($file, $jobid, $type);
1662 # Adds a file to the filelist
1663 sub add_selected_file_to_list
1665 my ($self, $name, $jobid, $type)=@_;
1667 my $dbh = $self->{dbh};
1668 my $restore_list = $self->{restore_list};
1670 my $curjobids=join(',', @{$self->{CurrentJobIds}});
1677 if ($name and substr $name,-1 ne '/')
1679 $name .= '/'; # For bacula
1681 my $dirfileindex = get_fileindex_from_dir_jobid($dbh,$name,$jobid);
1682 listview_push($restore_list,
1683 $name, $jobid, 'dir', $curjobids,
1684 $diricon, $name,$curjobids,$dirfileindex);
1686 elsif ($type eq 'file')
1688 my $fileindex = get_fileindex_from_file_jobid($dbh,$name,$jobid);
1690 listview_push($restore_list,
1691 $name, $jobid, 'file', $curjobids,
1692 $fileicon, $name, $jobid, $fileindex );
1696 # TODO : we want be able to restore files from a bad ended backup
1697 # we have JobStatus IN ('T', 'A', 'E') and we must
1699 # Data acces subs from here. Interaction with SGBD and caching
1701 # This sub retrieves the list of jobs corresponding to the jobs selected in the
1702 # GUI and stores them in @CurrentJobIds
1703 sub set_job_ids_for_date
1705 my ($dbh, $client, $date, $only_ok)=@_;
1707 if (!$client or !$date) {
1711 my $status = get_wanted_job_status($only_ok);
1713 # The algorithm : for a client, we get all the backups for each
1714 # fileset, in reverse order Then, for each fileset, we store the 'good'
1715 # incrementals and differentials until we have found a full so it goes
1716 # like this : store all incrementals until we have found a differential
1717 # or a full, then find the full #
1719 my $query = "SELECT JobId, FileSet, Level, JobStatus
1720 FROM Job, Client, FileSet
1721 WHERE Job.ClientId = Client.ClientId
1722 AND FileSet.FileSetId = Job.FileSetId
1723 AND EndTime <= '$date'
1724 AND Client.Name = '$client'
1726 AND JobStatus IN ($status)
1727 ORDER BY FileSet, JobTDate DESC";
1729 print $query,"\n" if $debug;
1731 my $result = $dbh->selectall_arrayref($query);
1733 foreach my $refrow (@$result)
1735 my $jobid = $refrow->[0];
1736 my $fileset = $refrow->[1];
1737 my $level = $refrow->[2];
1739 defined $progress{$fileset} or $progress{$fileset}='U'; # U for unknown
1741 next if $progress{$fileset} eq 'F'; # It's over for this fileset...
1745 next unless ($progress{$fileset} eq 'U' or $progress{$fileset} eq 'I');
1746 push @CurrentJobIds,($jobid);
1748 elsif ($level eq 'D')
1750 next if $progress{$fileset} eq 'D'; # We allready have a differential
1751 push @CurrentJobIds,($jobid);
1753 elsif ($level eq 'F')
1755 push @CurrentJobIds,($jobid);
1758 my $status = $refrow->[3] ;
1759 if ($status eq 'T') { # good end of job
1760 $progress{$fileset} = $level;
1763 print Data::Dumper::Dumper(\@CurrentJobIds) if $debug;
1765 return @CurrentJobIds;
1768 # Lists all directories contained inside a directory.
1769 # Uses the current dir, the client name, and CurrentJobIds for visibility.
1770 # Returns an array of dirs
1773 my ($self,$dir,$client)=@_;
1774 print "list_dirs($dir, $client)\n";
1776 # Is data allready cached ?
1777 if (not $self->{dirtree}->{$client})
1779 $self->cache_dirs($client);
1782 if ($dir ne '' and substr $dir,-1 ne '/')
1784 $dir .= '/'; # In the db, there is a / at the end of the dirs ...
1786 # Here, the tree is cached in ram
1787 my @dir = split('/',$dir,-1);
1788 pop @dir; # We don't need the empty trailing element
1790 # We have to get the reference of the hash containing $dir contents
1792 my $refdir=$self->{dirtree}->{$client};
1795 foreach my $subdir (@dir)
1801 $refdir = $refdir->[0]->{$subdir};
1804 # We reached the directory
1807 foreach my $dir (sort(keys %{$refdir->[0]}))
1809 # We return the directory's content : only visible directories
1810 foreach my $jobid (reverse(sort(@{$self->{CurrentJobIds}})))
1812 if (defined $refdir->[0]->{$dir}->[1]->{$jobid})
1814 my $dirname = $refdir->[0]->{$dir}->[2]; # The real dirname...
1815 push @return_list,($dirname);
1816 next DIRLOOP; # No need to waste more CPU cycles...
1820 print "LIST DIR : ", Data::Dumper::Dumper(\@return_list),"\n";
1821 return @return_list;
1825 # List all files in a directory. dir as parameter, CurrentJobIds for visibility
1826 # Returns an array of dirs
1829 my ($self, $dir)=@_;
1830 my $dbh = $self->{dbh};
1834 print "list_files($dir)\n";
1836 if ($dir ne '' and substr $dir,-1 ne '/')
1838 $dir .= '/'; # In the db, there is a / at the end of the dirs ...
1841 my $query = "SELECT Path.PathId FROM Path WHERE Path.Path = '$dir'";
1842 print $query,"\n" if $debug;
1844 my $result = $dbh->selectall_arrayref($query);
1845 foreach my $refrow (@$result)
1847 push @list_pathid,($refrow->[0]);
1850 if (@list_pathid == 0)
1852 print "No pathid found for $dir\n" if $debug;
1856 my $inlistpath = join (',', @list_pathid);
1857 my $inclause = join (',', @{$self->{CurrentJobIds}});
1858 if ($inclause eq '')
1864 "SELECT listfiles.id, listfiles.Name, File.LStat, File.JobId
1866 (SELECT Filename.Name, max(File.FileId) as id
1868 WHERE File.FilenameId = Filename.FilenameId
1869 AND Filename.Name != ''
1870 AND File.PathId IN ($inlistpath)
1871 AND File.JobId IN ($inclause)
1872 GROUP BY Filename.Name
1873 ORDER BY Filename.Name) AS listfiles,
1875 WHERE File.FileId = listfiles.id";
1877 print $query,"\n" if $debug;
1878 $result = $dbh->selectall_arrayref($query);
1885 Gtk2->main_iteration while (Gtk2->events_pending);
1888 # For the dirs, because of the db schema, it's inefficient to get the
1889 # directories contained inside other directories (regexp match or tossing
1890 # lots of records...). So we load all the tree and cache it. The data is
1891 # stored in a structure of this form :
1892 # Each directory is an array.
1893 # - In this array, the first element is a ref to next dir (hash)
1894 # - The second element is a hash containing all jobids pointing
1895 # on an array containing their lstat (or 1 if this jobid is there because
1897 # - The third is the filename itself (it could get mangled because of
1900 # So it looks like this :
1901 # $reftree->[ { 'dir1' => $refdir1
1902 # 'dir2' => $refdir2
1905 # { 'jobid1' => 'lstat1',
1906 # 'jobid2' => 'lstat2',
1907 # 'jobid3' => 1 # This one is here for "visibility"
1912 # Client as a parameter
1913 # Returns an array of dirs
1916 my ($self, $client) = @_;
1917 print "cache_dirs()\n";
1919 $self->{dirtree}->{$client} = []; # reset cache
1920 my $dbh = $self->{dbh};
1922 # TODO : If we get here, things could get lenghty ... draw a popup window .
1923 my $widget = Gtk2::MessageDialog->new($self->{mainwin},
1924 'destroy-with-parent',
1926 'Populating cache');
1929 # We have to build the tree, as it's the first time it is asked...
1932 # First, we only need the jobids of the selected server.
1933 # It's not the same as @CurrentJobIds (we need ALL the jobs)
1934 # We get the JobIds first in order to have the best execution
1935 # plan possible for the big query, with an in clause.
1937 my $status = get_wanted_job_status($self->{pref}->{use_ok_bkp_only});
1941 WHERE Job.ClientId = Client.ClientId
1942 AND Client.Name = '$client'
1943 AND Job.JobStatus IN ($status)
1944 AND Job.Type = 'B'";
1946 print $query,"\n" if $debug;
1947 my $result = $dbh->selectall_arrayref($query);
1951 foreach my $record (@{$result})
1953 push @jobids,($record->[0]);
1955 my $inclause = join(',',@jobids);
1956 if ($inclause eq '')
1959 $self->set_status("No previous backup found for $client");
1963 # Then, still to help dear mysql, we'll retrieve the PathId from empty Path (directory entries...)
1966 "SELECT Filename.FilenameId FROM Filename WHERE Filename.Name=''";
1968 print $query,"\n" if $debug;
1969 $result = $dbh->selectall_arrayref($query);
1972 foreach my $record (@{$result})
1974 push @dirids,$record->[0];
1976 my $dirinclause = join(',',@dirids);
1978 # This query is a bit complicated :
1979 # whe need to find all dir entries that should be displayed, even
1980 # if the directory itself has no entry in File table (it means a file
1981 # is explicitely chosen in the backup configuration)
1982 # Here's what I wanted to do :
1985 # SELECT T1.Path, T2.Lstat, T2.JobId
1986 # FROM ( SELECT DISTINCT Path.PathId, Path.Path FROM File, Path
1987 # WHERE File.PathId = Path.PathId
1988 # AND File.JobId IN ($inclause)) AS T1
1990 # ( SELECT File.Lstat, File.JobId, File.PathId FROM File
1991 # WHERE File.FilenameId IN ($dirinclause)
1992 # AND File.JobId IN ($inclause)) AS T2
1993 # ON (T1.PathId = T2.PathId)
1995 # It works perfectly with postgresql, but mysql doesn't seem to be able
1996 # to do the hash join correcty, so the performance sucks.
1997 # So it will be done in 4 steps :
1998 # o create T1 and T2 as temp tables
1999 # o create an index on T2.PathId
2001 # o remove the temp tables
2003 CREATE TEMPORARY TABLE T1 AS
2004 SELECT DISTINCT Path.PathId, Path.Path FROM File, Path
2005 WHERE File.PathId = Path.PathId
2006 AND File.JobId IN ($inclause)
2008 print $query,"\n" if $debug;
2013 CREATE TEMPORARY TABLE T2 AS
2014 SELECT File.Lstat, File.JobId, File.PathId FROM File
2015 WHERE File.FilenameId IN ($dirinclause)
2016 AND File.JobId IN ($inclause)
2018 print $query,"\n" if $debug;
2023 CREATE INDEX tmp2 ON T2(PathId)
2025 print $query,"\n" if $debug;
2030 SELECT T1.Path, T2.Lstat, T2.JobId
2031 FROM T1 LEFT JOIN T2
2032 ON (T1.PathId = T2.PathId)
2034 print $query,"\n" if $debug;
2035 $result = $dbh->selectall_arrayref($query);
2039 foreach my $record (@{$result})
2041 if ($rcount > 15000) {
2047 # Dirty hack to force the string encoding on perl... we don't
2048 # want implicit conversions
2049 my $path = pack "U0C*", unpack "C*",$record->[0];
2051 my @path = split('/',$path,-1);
2052 pop @path; # we don't need the trailing empty element
2053 my $lstat = $record->[1];
2054 my $jobid = $record->[2];
2056 # We're going to store all the data on the cache tree.
2057 # We find the leaf, then store data there
2058 my $reftree=$self->{dirtree}->{$client};
2059 foreach my $dir(@path)
2065 if (not defined($reftree->[0]->{$dir}))
2068 $reftree->[0]->{$dir}=\@tmparray;
2070 $reftree=$reftree->[0]->{$dir};
2073 # We can now add the metadata for this dir ...
2075 # $result = $dbh->selectall_arrayref($query);
2078 # contains something
2079 $reftree->[1]->{$jobid}=$lstat;
2083 # We have a very special case here...
2084 # lstat is not defined.
2085 # it means the directory is there because a file has been
2086 # backuped. so the dir has no entry in File table.
2087 # That's a rare case, so we can afford to determine it's
2088 # visibility with a query
2089 my $select_path=$record->[0];
2090 $select_path=$dbh->quote($select_path); # gotta be careful
2094 WHERE File.PathId = Path.PathId
2095 AND Path.Path = $select_path
2097 print $query,"\n" if $debug;
2098 my $result2 = $dbh->selectall_arrayref($query);
2099 foreach my $record (@{$result2})
2101 my $jobid=$record->[0];
2102 $reftree->[1]->{$jobid}=1;
2110 print $query,"\n" if $debug;
2115 print $query,"\n" if $debug;
2119 list_visible($self->{dirtree}->{$client});
2122 # print Data::Dumper::Dumper($self->{dirtree});
2125 # Recursive function to calculate the visibility of each directory in the cache
2126 # tree Working with references to save time and memory
2127 # For each directory, we want to propagate it's visible jobids onto it's
2128 # parents directory.
2129 # A tree is visible if
2130 # - it's been in a backup pointed by the CurrentJobIds
2131 # - one of it's subdirs is in a backup pointed by the CurrentJobIds
2132 # In the second case, the directory is visible but has no metadata.
2133 # We symbolize this with lstat = 1 for this jobid in the cache.
2135 # Input : reference directory
2136 # Output : visibility of this dir. Has to know visibility of all subdirs
2137 # to know it's visibility, hence the recursing.
2143 # Get the subdirs array references list
2144 my @list_ref_subdirs;
2145 while( my (undef,$ref_subdir) = each (%{$refdir->[0]}))
2147 push @list_ref_subdirs,($ref_subdir);
2150 # Now lets recurse over these subdirs and retrieve the reference of a hash
2151 # containing the jobs where they are visible
2152 foreach my $ref_subdir (@list_ref_subdirs)
2154 my $ref_list_jobs = list_visible($ref_subdir);
2155 foreach my $jobid (keys %$ref_list_jobs)
2157 $visibility{$jobid}=1;
2161 # Ok. Now, we've got the list of those jobs. We are going to update our
2162 # hash (element 1 of the dir array) containing our jobs Do NOT overwrite
2163 # the lstat for the known jobids. Put 1 in the new elements... But first,
2164 # let's store the current jobids
2166 foreach my $jobid (keys %{$refdir->[1]})
2168 push @known_jobids,($jobid);
2172 foreach my $jobid (keys %visibility)
2174 next if ($refdir->[1]->{$jobid});
2175 $refdir->[1]->{$jobid} = 1;
2177 # Add the known_jobids to %visibility
2178 foreach my $jobid (@known_jobids)
2180 $visibility{$jobid}=1;
2182 return \%visibility;
2185 # Returns the list of media required for a list of jobids.
2186 # Input : dbh, jobid1, jobid2...
2187 # Output : reference to array of (joibd, inchanger)
2188 sub get_required_media_from_jobid
2190 my ($dbh, @jobids)=@_;
2191 my $inclause = join(',',@jobids);
2193 SELECT DISTINCT JobMedia.MediaId, Media.InChanger
2194 FROM JobMedia, Media
2195 WHERE JobMedia.MediaId=Media.MediaId
2196 AND JobId In ($inclause)
2198 my $result = $dbh->selectall_arrayref($query);
2202 # Returns the fileindex from dirname and jobid.
2203 # Input : dbh, dirname, jobid
2204 # Output : fileindex
2205 sub get_fileindex_from_dir_jobid
2207 my ($dbh, $dirname, $jobid)=@_;
2209 $query = "SELECT File.FileIndex
2210 FROM File, Filename, Path
2211 WHERE File.FilenameId = Filename.FilenameId
2212 AND File.PathId = Path.PathId
2213 AND Filename.Name = ''
2214 AND Path.Path = '$dirname'
2215 AND File.JobId = '$jobid'
2218 print $query,"\n" if $debug;
2219 my $result = $dbh->selectall_arrayref($query);
2220 return $result->[0]->[0];
2223 # Returns the fileindex from filename and jobid.
2224 # Input : dbh, filename, jobid
2225 # Output : fileindex
2226 sub get_fileindex_from_file_jobid
2228 my ($dbh, $filename, $jobid)=@_;
2230 my @dirs = File::Spec->splitdir ($filename);
2231 $filename=pop(@dirs);
2232 my $dirname = File::Spec->catdir(@dirs) . '/';
2237 "SELECT File.FileIndex
2238 FROM File, Filename, Path
2239 WHERE File.FilenameId = Filename.FilenameId
2240 AND File.PathId = Path.PathId
2241 AND Filename.Name = '$filename'
2242 AND Path.Path = '$dirname'
2243 AND File.JobId = '$jobid'";
2245 print $query,"\n" if $debug;
2246 my $result = $dbh->selectall_arrayref($query);
2247 return $result->[0]->[0];
2251 # Returns list of versions of a file that could be restored
2252 # returns an array of
2253 # ('FILE:',filename,jobid,fileindex,mtime,size,inchanger,md5,volname)
2254 # It's the same as entries of restore_list (hidden) + mtime and size and inchanger
2255 # and volname and md5
2256 # and of course, there will be only one jobid in the array of jobids...
2257 sub get_all_file_versions
2259 my ($dbh,$path,$file,$client,$see_all)=@_;
2261 defined $see_all or $see_all=0;
2266 "SELECT File.JobId, File.FileIndex, File.Lstat,
2267 File.Md5, Media.VolumeName, Media.InChanger
2268 FROM File, Filename, Path, Job, Client, JobMedia, Media
2269 WHERE File.FilenameId = Filename.FilenameId
2270 AND File.PathId=Path.PathId
2271 AND File.JobId = Job.JobId
2272 AND Job.ClientId = Client.ClientId
2273 AND Job.JobId = JobMedia.JobId
2274 AND File.FileIndex >= JobMedia.FirstIndex
2275 AND File.FileIndex <= JobMedia.LastIndex
2276 AND JobMedia.MediaId = Media.MediaId
2277 AND Path.Path = '$path'
2278 AND Filename.Name = '$file'
2279 AND Client.Name = '$client'";
2281 print $query if $debug;
2283 my $result = $dbh->selectall_arrayref($query);
2285 foreach my $refrow (@$result)
2287 my ($jobid, $fileindex, $lstat, $md5, $volname, $inchanger) = @$refrow;
2288 my @attribs = parse_lstat($lstat);
2289 my $mtime = array_attrib('st_mtime',\@attribs);
2290 my $size = array_attrib('st_size',\@attribs);
2292 my @list = ('FILE:', $path.$file, $jobid, $fileindex, $mtime, $size,
2293 $inchanger, $md5, $volname);
2294 push @versions, (\@list);
2297 # We have the list of all versions of this file.
2298 # We'll sort it by mtime desc, size, md5, inchanger desc
2299 # the rest of the algorithm will be simpler
2300 # ('FILE:',filename,jobid,fileindex,mtime,size,inchanger,md5,volname)
2301 @versions = sort { $b->[4] <=> $a->[4]
2302 || $a->[5] <=> $b->[5]
2303 || $a->[7] cmp $a->[7]
2304 || $b->[6] <=> $a->[6]} @versions;
2307 my %allready_seen_by_mtime;
2308 my %allready_seen_by_md5;
2309 # Now we should create a new array with only the interesting records
2310 foreach my $ref (@versions)
2314 # The file has a md5. We compare his md5 to other known md5...
2315 # We take size into account. It may happen that 2 files
2316 # have the same md5sum and are different. size is a supplementary
2319 # If we allready have a (better) version
2320 next if ( (not $see_all)
2321 and $allready_seen_by_md5{$ref->[7] .'-'. $ref->[5]});
2323 # we never met this one before...
2324 $allready_seen_by_md5{$ref->[7] .'-'. $ref->[5]}=1;
2326 # Even if it has a md5, we should also work with mtimes
2327 # We allready have a (better) version
2328 next if ( (not $see_all)
2329 and $allready_seen_by_mtime{$ref->[4] .'-'. $ref->[5]});
2330 $allready_seen_by_mtime{$ref->[4] .'-'. $ref->[5] . '-' . $ref->[7]}=1;
2332 # We reached there. The file hasn't been seen.
2333 push @good_versions,($ref);
2336 # To be nice with the user, we re-sort good_versions by
2337 # inchanger desc, mtime desc
2338 @good_versions = sort { $b->[4] <=> $a->[4]
2339 || $b->[2] <=> $a->[2]} @good_versions;
2341 return @good_versions;
2344 # TODO : bsr must use only good backup or not (see use_ok_bkp_only)
2345 # This sub creates a BSR from the information in the restore_list
2346 # Returns the BSR as a string
2350 my $dbh = $self->{dbh};
2352 # This query gets all jobid/jobmedia/media combination.
2354 SELECT Job.JobId, Job.VolsessionId, Job.VolsessionTime, JobMedia.StartFile,
2355 JobMedia.EndFile, JobMedia.FirstIndex, JobMedia.LastIndex,
2356 JobMedia.StartBlock, JobMedia.EndBlock, JobMedia.VolIndex,
2357 Media.Volumename, Media.MediaType
2358 FROM Job, JobMedia, Media
2359 WHERE Job.JobId = JobMedia.JobId
2360 AND JobMedia.MediaId = Media.MediaId
2361 ORDER BY JobMedia.FirstIndex, JobMedia.LastIndex";
2364 my $result = $dbh->selectall_arrayref($query);
2366 # We will store everything hashed by jobid.
2368 foreach my $refrow (@$result)
2370 my ($jobid, $volsessionid, $volsessiontime, $startfile, $endfile,
2371 $firstindex, $lastindex, $startblock, $endblock,
2372 $volindex, $volumename, $mediatype) = @{$refrow};
2374 # We just have to deal with the case where starfile != endfile
2375 # In this case, we concatenate both, for the bsr
2376 if ($startfile != $endfile) {
2377 $startfile = $startfile . '-' . $endfile;
2381 ($jobid, $volsessionid, $volsessiontime, $startfile,
2382 $firstindex, $lastindex, $startblock .'-'. $endblock,
2383 $volindex, $volumename, $mediatype);
2385 push @{$mediainfos{$refrow->[0]}},(\@tmparray);
2389 # reminder : restore_list looks like this :
2390 # ($name,$jobid,'file',$curjobids, undef, undef, undef, $dirfileindex);
2392 # Here, we retrieve every file/dir that could be in the restore
2393 # We do as simple as possible for the SQL engine (no crazy joins,
2394 # no pseudo join (>= FirstIndex ...), etc ...
2395 # We do a SQL union of all the files/dirs specified in the restore_list
2397 foreach my $entry (@{$self->{restore_list}->{data}})
2399 if ($entry->[2] eq 'dir')
2401 my $dir = unpack('u', $entry->[0]);
2402 my $inclause = $entry->[3]; #curjobids
2405 "(SELECT Path.Path, Filename.Name, File.FileIndex, File.JobId
2406 FROM File, Path, Filename
2407 WHERE Path.PathId = File.PathId
2408 AND File.FilenameId = Filename.FilenameId
2409 AND Path.Path LIKE '$dir%'
2410 AND File.JobId IN ($inclause) )";
2411 push @select_queries,($query);
2415 # It's a file. Great, we allready have most
2416 # of what is needed. Simple and efficient query
2417 my $file = unpack('u', $entry->[0]);
2418 my @file = split '/',$file;
2420 my $dir = join('/',@file);
2422 my $jobid = $entry->[1];
2423 my $fileindex = $entry->[7];
2424 my $inclause = $entry->[3]; # curjobids
2426 "(SELECT Path.Path, Filename.Name, File.FileIndex, File.JobId
2427 FROM File, Path, Filename
2428 WHERE Path.PathId = File.PathId
2429 AND File.FilenameId = Filename.FilenameId
2430 AND Path.Path = '$dir/'
2431 AND Filename.Name = '$file'
2432 AND File.JobId = $jobid)";
2433 push @select_queries,($query);
2436 $query = join("\nUNION ALL\n",@select_queries) . "\nORDER BY FileIndex\n";
2438 print $query,"\n" if $debug;
2440 #Now we run the query and parse the result...
2441 # there may be a lot of records, so we better be efficient
2442 # We use the bind column method, working with references...
2444 my $sth = $dbh->prepare($query);
2447 my ($path,$name,$fileindex,$jobid);
2448 $sth->bind_columns(\$path,\$name,\$fileindex,\$jobid);
2450 # The temp place we're going to save all file
2451 # list to before the real list
2455 while ($sth->fetchrow_arrayref())
2457 # This may look dumb, but we're going to do a join by ourselves,
2458 # to save memory and avoid sending a complex query to mysql
2459 my $complete_path = $path . $name;
2467 # Remove trailing slash (normalize file and dir name)
2468 $complete_path =~ s/\/$//;
2470 # Let's find the ref(s) for the %mediainfo element(s)
2471 # containing the data for this file
2472 # There can be several matches. It is the pseudo join.
2474 my $max_elt=@{$mediainfos{$jobid}}-1;
2476 while($med_idx <= $max_elt)
2478 my $ref = $mediainfos{$jobid}->[$med_idx];
2479 # First, can we get rid of the first elements of the
2480 # array ? (if they don't contain valuable records
2482 if ($fileindex > $ref->[5])
2484 # It seems we don't need anymore
2485 # this entry in %mediainfo (the input data
2488 shift @{$mediainfos{$jobid}};
2492 # We will do work on this elt. We can ++
2493 # $med_idx for next loop
2496 # %mediainfo row looks like :
2497 # (jobid,VolsessionId,VolsessionTime,File,FirstIndex,
2498 # LastIndex,StartBlock-EndBlock,VolIndex,Volumename,
2501 # We are in range. We store and continue looping
2503 if ($fileindex >= $ref->[4])
2505 my @data = ($complete_path,$is_dir,
2507 push @temp_list,(\@data);
2511 # We are not in range. No point in continuing looping
2512 # We go to next record.
2516 # Now we have the array.
2517 # We're going to sort it, by
2518 # path, volsessiontime DESC (get the most recent file...)
2519 # The array rows look like this :
2520 # complete_path,is_dir,fileindex,
2521 # ref->(jobid,VolsessionId,VolsessionTime,File,FirstIndex,
2522 # LastIndex,StartBlock-EndBlock,VolIndex,Volumename,MediaType)
2523 @temp_list = sort {$a->[0] cmp $b->[0]
2524 || $b->[3]->[2] <=> $a->[3]->[2]
2528 my $prev_complete_path='////'; # Sure not to match
2532 while (my $refrow = shift @temp_list)
2534 # For the sake of readability, we load $refrow
2535 # contents in real scalars
2536 my ($complete_path, $is_dir, $fileindex, $refother)=@{$refrow};
2537 my $jobid= $refother->[0]; # We don't need the rest...
2539 # We skip this entry.
2540 # We allready have a newer one and this
2541 # isn't a continuation of the same file
2542 next if ($complete_path eq $prev_complete_path
2543 and $jobid != $prev_jobid);
2547 and $complete_path =~ m|^\Q$prev_complete_path\E/|)
2549 # We would be recursing inside a file.
2550 # Just what we don't want (dir replaced by file
2551 # between two backups
2557 push @restore_list,($refrow);
2559 $prev_complete_path = $complete_path;
2560 $prev_jobid = $jobid;
2566 push @restore_list,($refrow);
2568 $prev_complete_path = $complete_path;
2569 $prev_jobid = $jobid;
2573 # We get rid of @temp_list... save memory
2576 # Ok everything is in the list. Let's sort it again in another way.
2577 # This time it will be in the bsr file order
2579 # we sort the results by
2580 # volsessiontime, volsessionid, volindex, fileindex
2581 # to get all files in right order...
2582 # Reminder : The array rows look like this :
2583 # complete_path,is_dir,fileindex,
2584 # ref->(jobid,VolsessionId,VolsessionTime,File,FirstIndex,LastIndex,
2585 # StartBlock-EndBlock,VolIndex,Volumename,MediaType)
2587 @restore_list= sort { $a->[3]->[2] <=> $b->[3]->[2]
2588 || $a->[3]->[1] <=> $b->[3]->[1]
2589 || $a->[3]->[7] <=> $b->[3]->[7]
2590 || $a->[2] <=> $b->[2] }
2593 # Now that everything is ready, we create the bsr
2594 my $prev_fileindex=-1;
2595 my $prev_volsessionid=-1;
2596 my $prev_volsessiontime=-1;
2597 my $prev_volumename=-1;
2598 my $prev_volfile=-1;
2602 my $first_of_current_range=0;
2603 my @fileindex_ranges;
2606 foreach my $refrow (@restore_list)
2608 my (undef,undef,$fileindex,$refother)=@{$refrow};
2609 my (undef,$volsessionid,$volsessiontime,$volfile,undef,undef,
2610 $volblocks,undef,$volumename,$mediatype)=@{$refother};
2612 # We can specifiy the number of files in each section of the
2613 # bsr to speedup restore (bacula can then jump over the
2614 # end of tape files.
2618 if ($prev_volumename eq '-1')
2620 # We only have to start the new range...
2621 $first_of_current_range=$fileindex;
2623 elsif ($prev_volsessionid != $volsessionid
2624 or $prev_volsessiontime != $volsessiontime
2625 or $prev_volumename ne $volumename
2626 or $prev_volfile ne $volfile)
2628 # We have to create a new section in the bsr...
2629 # We print the previous one ...
2630 # (before that, save the current range ...)
2631 if ($first_of_current_range != $prev_fileindex)
2634 push @fileindex_ranges,
2635 ("$first_of_current_range-$prev_fileindex");
2639 # We are out of a range,
2640 # but there is only one element in the range
2641 push @fileindex_ranges,
2642 ("$first_of_current_range");
2645 $bsr.=print_bsr_section(\@fileindex_ranges,
2647 $prev_volsessiontime,
2654 # Reset for next loop
2655 @fileindex_ranges=();
2656 $first_of_current_range=$fileindex;
2658 elsif ($fileindex-1 != $prev_fileindex)
2660 # End of a range of fileindexes
2661 if ($first_of_current_range != $prev_fileindex)
2664 push @fileindex_ranges,
2665 ("$first_of_current_range-$prev_fileindex");
2669 # We are out of a range,
2670 # but there is only one element in the range
2671 push @fileindex_ranges,
2672 ("$first_of_current_range");
2674 $first_of_current_range=$fileindex;
2676 $prev_fileindex=$fileindex;
2677 $prev_volsessionid = $volsessionid;
2678 $prev_volsessiontime = $volsessiontime;
2679 $prev_volumename = $volumename;
2680 $prev_volfile=$volfile;
2681 $prev_mediatype=$mediatype;
2682 $prev_volblocks=$volblocks;
2686 # Ok, we're out of the loop. Alas, there's still the last record ...
2687 if ($first_of_current_range != $prev_fileindex)
2690 push @fileindex_ranges,("$first_of_current_range-$prev_fileindex");
2695 # We are out of a range,
2696 # but there is only one element in the range
2697 push @fileindex_ranges,("$first_of_current_range");
2700 $bsr.=print_bsr_section(\@fileindex_ranges,
2702 $prev_volsessiontime,
2712 sub print_bsr_section
2714 my ($ref_fileindex_ranges,$volsessionid,
2715 $volsessiontime,$volumename,$volfile,
2716 $mediatype,$volblocks,$count)=@_;
2719 $bsr .= "Volume=\"$volumename\"\n";
2720 $bsr .= "MediaType=\"$mediatype\"\n";
2721 $bsr .= "VolSessionId=$volsessionid\n";
2722 $bsr .= "VolSessionTime=$volsessiontime\n";
2723 $bsr .= "VolFile=$volfile\n";
2724 $bsr .= "VolBlock=$volblocks\n";
2726 foreach my $range (@{$ref_fileindex_ranges})
2728 $bsr .= "FileIndex=$range\n";
2731 $bsr .= "Count=$count\n";
2735 # This function estimates the size to be restored for an entry of the restore
2737 # In : self,reference to the entry
2738 # Out : size in bytes, number of files
2739 sub estimate_restore_size
2741 # reminder : restore_list looks like this :
2742 # ($name,$jobid,'file',$curjobids, undef, undef, undef, $dirfileindex);
2746 my $dbh = $self->{dbh};
2747 if ($entry->[2] eq 'dir')
2749 my $dir = unpack('u', $entry->[0]);
2750 my $inclause = $entry->[3]; #curjobids
2752 "SELECT Path.Path, File.FilenameId, File.LStat
2753 FROM File, Path, Job
2754 WHERE Path.PathId = File.PathId
2755 AND File.JobId = Job.JobId
2756 AND Path.Path LIKE '$dir%'
2757 AND File.JobId IN ($inclause)
2758 ORDER BY Path.Path, File.FilenameId, Job.StartTime DESC";
2762 # It's a file. Great, we allready have most
2763 # of what is needed. Simple and efficient query
2764 my $file = unpack('u', $entry->[0]);
2765 my @file = split '/',$file;
2767 my $dir = join('/',@file);
2769 my $jobid = $entry->[1];
2770 my $fileindex = $entry->[7];
2771 my $inclause = $entry->[3]; # curjobids
2773 "SELECT Path.Path, File.FilenameId, File.Lstat
2774 FROM File, Path, Filename
2775 WHERE Path.PathId = File.PathId
2776 AND Path.Path = '$dir/'
2777 AND Filename.Name = '$file'
2778 AND File.JobId = $jobid
2779 AND Filename.FilenameId = File.FilenameId";
2782 print $query,"\n" if $debug;
2783 my ($path,$nameid,$lstat);
2784 my $sth = $dbh->prepare($query);
2786 $sth->bind_columns(\$path,\$nameid,\$lstat);
2796 while ($sth->fetchrow_arrayref())
2798 # Only the latest version of a file
2799 next if ($nameid eq $old_nameid and $path eq $old_path);
2801 if ($rcount > 15000) {
2808 # We get the size of this file
2809 my $size=lstat_attrib($lstat,'st_size');
2810 $total_size += $size;
2813 $old_nameid=$nameid;
2815 return ($total_size,$total_files);
2821 my %attrib_name_id = ( 'st_dev' => 0,'st_ino' => 1,'st_mode' => 2,
2822 'st_nlink' => 3,'st_uid' => 4,'st_gid' => 5,
2823 'st_rdev' => 6,'st_size' => 7,'st_blksize' => 8,
2824 'st_blocks' => 9,'st_atime' => 10,'st_mtime' => 11,
2825 'st_ctime' => 12,'LinkFI' => 13,'st_flags' => 14,
2826 'data_stream' => 15);;
2829 my ($attrib,$ref_attrib)=@_;
2830 return $ref_attrib->[$attrib_name_id{$attrib}];
2834 { # $file = [listfiles.id, listfiles.Name, File.LStat, File.JobId]
2836 my ($file, $attrib)=@_;
2838 if (defined $attrib_name_id{$attrib}) {
2840 my @d = split(' ', $file->[2]) ; # TODO : cache this
2842 return from_base64($d[$attrib_name_id{$attrib}]);
2844 } elsif ($attrib eq 'jobid') {
2848 } elsif ($attrib eq 'name') {
2853 die "Attribute not known : $attrib.\n";
2857 # Return the jobid or attribute asked for a dir
2860 my ($self,$dir,$attrib)=@_;
2862 my @dir = split('/',$dir,-1);
2863 my $refdir=$self->{dirtree}->{$self->current_client};
2865 if (not defined $attrib_name_id{$attrib} and $attrib ne 'jobid')
2867 die "Attribute not known : $attrib.\n";
2870 foreach my $subdir (@dir)
2872 $refdir = $refdir->[0]->{$subdir};
2875 # $refdir is now the reference to the dir's array
2876 # Is the a jobid in @CurrentJobIds where the lstat is
2877 # defined (we'll search in reverse order)
2878 foreach my $jobid (reverse(sort {$a <=> $b } @{$self->{CurrentJobIds}}))
2880 if (defined $refdir->[1]->{$jobid} and $refdir->[1]->{$jobid} ne '1')
2882 if ($attrib eq 'jobid')
2888 my @attribs = parse_lstat($refdir->[1]->{$jobid});
2889 return $attribs[$attrib_name_id{$attrib}+1];
2894 return 0; # We cannot get a good attribute.
2895 # This directory is here for the sake of visibility
2900 my ($lstat,$attrib)=@_;
2901 if (defined $attrib_name_id{$attrib})
2903 my @d = split(' ', $lstat) ; # TODO : cache this
2904 return from_base64($d[$attrib_name_id{$attrib}]);
2910 # Base 64 functions, directly from recover.pl.
2912 # Karl Hakimian <hakimian@aha.com>
2913 # This section is also under GPL v2 or later.
2920 'A', 'B', 'C', 'D', 'E', 'F', 'G', 'H', 'I', 'J', 'K', 'L', 'M',
2921 'N', 'O', 'P', 'Q', 'R', 'S', 'T', 'U', 'V', 'W', 'X', 'Y', 'Z',
2922 'a', 'b', 'c', 'd', 'e', 'f', 'g', 'h', 'i', 'j', 'k', 'l', 'm',
2923 'n', 'o', 'p', 'q', 'r', 's', 't', 'u', 'v', 'w', 'x', 'y', 'z',
2924 '0', '1', '2', '3', '4', '5', '6', '7', '8', '9', '+', '/'
2926 @base64_map = (0) x 128;
2928 for (my $i=0; $i<64; $i++) {
2929 $base64_map[ord($base64_digits[$i])] = $i;
2944 if (substr($where, 0, 1) eq '-') {
2946 $where = substr($where, 1);
2949 while ($where ne '') {
2951 my $d = substr($where, 0, 1);
2952 $val += $base64_map[ord(substr($where, 0, 1))];
2953 $where = substr($where, 1);
2961 my @attribs = split(' ',$lstat);
2962 foreach my $element (@attribs)
2964 $element = from_base64($element);
2971 ################################################################
2975 my $conf = "$ENV{HOME}/.brestore.conf" ;
2976 my $p = new Pref($conf);
2982 $glade_file = $p->{glade_file};
2984 foreach my $path ('','.','/usr/share/brestore','/usr/local/share/brestore') {
2985 if (-f "$path/$glade_file") {
2986 $glade_file = "$path/$glade_file" ;
2991 if ( -f $glade_file) {
2992 my $w = new DlgResto($p);
2995 my $widget = Gtk2::MessageDialog->new(undef, 'modal', 'error', 'close',
2996 "Can't find your brestore.glade (glade_file => '$glade_file')
2997 Please, edit your $conf to setup it." );
2999 $widget->signal_connect('destroy', sub { Gtk2->main_quit() ; });
3004 Gtk2->main; # Start Gtk2 main loop
3016 # Code pour trier les colonnes
3017 my $mod = $fileview->get_model();
3018 $mod->set_default_sort_func(sub {
3019 my ($model, $item1, $item2) = @_;
3020 my $a = $model->get($item1, 1); # récupération de la valeur de la 2ème
3021 my $b = $model->get($item2, 1); # colonne (indice 1)
3026 $fileview->set_headers_clickable(1);
3027 my $col = $fileview->get_column(1); # la colonne NOM, colonne numéro 2
3028 $col->signal_connect('clicked', sub {
3029 my ($colonne, $model) = @_;
3030 $model->set_sort_column_id (1, 'ascending');