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, $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 my @restore_list_target_table = ({'target' => 'STRING',
889 $restore_list->enable_model_drag_dest(['copy'],@restore_list_target_table);
890 $restore_list->get_selection->set_mode('multiple');
892 $widget = $glade->get_widget('infoview');
893 my $infoview = $self->{fileinfo} = Gtk2::SimpleList->new_from_treeview(
895 'h_name' => 'hidden',
896 'h_jobid' => 'hidden',
897 'h_type' => 'hidden',
899 'InChanger' => 'pixbuf',
906 init_drag_drop($infoview);
908 $pref->connect_db() || $self->{dlg_pref}->display($self);
911 $self->{dbh} = $pref->{dbh};
912 $self->init_server_backup_combobox();
916 # set status bar informations
919 my ($self, $string) = @_;
920 my $context = $self->{status}->get_context_id('Main');
921 $self->{status}->push($context, $string);
924 sub on_time_select_changed
932 my $c = $self->{glade}->get_widget('combo_time');
933 return $c->get_active_text;
936 # This sub returns all clients declared in DB
940 my $query = "SELECT Name FROM Client ORDER BY Name";
941 print $query,"\n" if $debug;
942 my $result = $dbh->selectall_arrayref($query);
944 foreach my $refrow (@$result)
946 push @return_array,($refrow->[0]);
948 return @return_array;
951 sub get_wanted_job_status
958 return "'T', 'A', 'E'";
962 # This sub gives a full list of the EndTimes for a ClientId
963 # ( [ 'Date', 'FileSet', 'Type', 'Status', 'JobId'],
964 # ['Date', 'FileSet', 'Type', 'Status', 'JobId']..)
965 sub get_all_endtimes_for_job
967 my ($dbh, $client, $ok_only)=@_;
968 my $status = get_wanted_job_status($ok_only);
970 SELECT Job.EndTime, FileSet.FileSet, Job.Level, Job.JobStatus, Job.JobId
971 FROM Job,Client,FileSet
972 WHERE Job.ClientId=Client.ClientId
973 AND Client.Name = '$client'
975 AND JobStatus IN ($status)
976 AND Job.FileSetId = FileSet.FileSetId
977 ORDER BY EndTime desc";
978 print $query,"\n" if $debug;
979 my $result = $dbh->selectall_arrayref($query);
985 # init infoview widget
989 @{$self->{fileinfo}->{data}} = ();
996 @{$self->{restore_list}->{data}} = ();
999 use File::Temp qw/tempfile/;
1001 sub on_go_button_clicked
1004 my $bsr = $self->create_filelist();
1005 my ($fh, $filename) = tempfile();
1008 chmod(0644, $filename);
1010 print "Dumping BSR info to $filename\n"
1013 # we get Volume list
1014 my %a = map { $_ => 1 } ($bsr =~ /Volume="(.+)"/g);
1015 my $vol = [ keys %a ] ; # need only one occurrence of each volume
1017 new DlgLaunch(pref => $self->{pref},
1019 bsr_file => $filename,
1024 our $client_list_empty = 'Clients list';
1025 our %type_markup = ('F' => '<b>$label F</b>',
1028 'B' => '<b>$label B</b>',
1030 'A' => '<span foreground=\"red\">$label</span>',
1032 'E' => '<span foreground=\"red\">$label</span>',
1035 sub on_list_client_changed
1037 my ($self, $widget) = @_;
1038 return 0 unless defined $self->{fileview};
1039 my $dbh = $self->{dbh};
1041 $self->{list_backup}->clear();
1043 if ($self->current_client eq $client_list_empty) {
1047 my @endtimes=get_all_endtimes_for_job($dbh,
1048 $self->current_client,
1049 $self->{pref}->{use_ok_bkp_only});
1050 foreach my $endtime (@endtimes)
1052 my $i = $self->{list_backup}->append();
1054 my $label = $endtime->[1] . " (" . $endtime->[4] . ")";
1055 eval "\$label = \"$type_markup{$endtime->[2]}\""; # job type
1056 eval "\$label = \"$type_markup{$endtime->[3]}\""; # job status
1058 $self->{list_backup}->set($i,
1063 $self->{restore_backup_combobox}->set_active(0);
1065 $self->{CurrentJobIds} = [
1066 set_job_ids_for_date($dbh,
1067 $self->current_client,
1068 $self->current_date,
1069 $self->{pref}->{use_ok_bkp_only})
1074 # undef $self->{dirtree};
1075 $self->refresh_fileview();
1079 sub fill_server_list
1081 my ($dbh, $combo, $list) = @_;
1083 my @clients=get_all_clients($dbh);
1087 my $i = $list->append();
1088 $list->set($i, 0, $client_list_empty);
1090 foreach my $client (@clients)
1092 $i = $list->append();
1093 $list->set($i, 0, $client);
1095 $combo->set_active(0);
1098 sub init_server_backup_combobox
1101 fill_server_list($self->{dbh},
1102 $self->{client_combobox},
1103 $self->{list_client}) ;
1106 #----------------------------------------------------------------------
1107 #Refreshes the file-view Redraws everything. The dir data is cached, the file
1108 #data isn't. There is additionnal complexity for dirs (visibility problems),
1109 #so the @CurrentJobIds is not sufficient.
1110 sub refresh_fileview
1113 my $fileview = $self->{fileview};
1114 my $client_combobox = $self->{client_combobox};
1115 my $cwd = $self->{cwd};
1117 @{$fileview->{data}} = ();
1119 $self->clear_infoview();
1121 my $client_name = $self->current_client;
1123 if (!$client_name or ($client_name eq $client_list_empty)) {
1124 $self->set_status("Client list empty");
1128 my @dirs = $self->list_dirs($cwd,$client_name);
1129 # [ [listfiles.id, listfiles.Name, File.LStat, File.JobId]..]
1130 my $files = $self->list_files($cwd);
1131 print "CWD : $cwd\n" if ($debug);
1133 my $file_count = 0 ;
1134 my $total_bytes = 0;
1136 # Add directories to view
1137 foreach my $dir (@dirs) {
1138 my $time = localtime($self->dir_attrib("$cwd/$dir",'st_mtime'));
1139 $total_bytes += 4096;
1142 listview_push($fileview,
1144 $self->dir_attrib("$cwd/$dir",'jobid'),
1154 foreach my $file (@$files)
1156 my $size = file_attrib($file,'st_size');
1157 my $time = localtime(file_attrib($file,'st_mtime'));
1158 $total_bytes += $size;
1160 # $file = [listfiles.id, listfiles.Name, File.LStat, File.JobId]
1162 listview_push($fileview,
1169 human($size), $time);
1172 $self->set_status("$file_count files/" . human($total_bytes));
1174 # set a decent default selection (makes keyboard nav easy)
1175 $fileview->select(0);
1179 sub on_about_activate
1181 DlgAbout::display();
1186 my ($tree, $path, $data) = @_;
1188 my @items = listview_get_all($tree) ;
1190 foreach my $i (@items)
1192 my @file_info = @{$i};
1195 # Ok, we have a corner case :
1200 $file = pack("u", $file_info[0]);
1204 $file = pack("u", $path . '/' . $file_info[0]);
1206 push @ret, join(" ; ", $file,
1207 $file_info[1], # $jobid
1208 $file_info[2], # $type
1212 my $data_get = join(" :: ", @ret);
1214 $data->set_text($data_get,-1);
1217 sub fileview_data_get
1219 my ($self, $widget, $context, $data, $info, $time,$string) = @_;
1220 drag_set_info($widget, $self->{cwd}, $data);
1223 sub fileinfo_data_get
1225 my ($self, $widget, $context, $data, $info, $time,$string) = @_;
1226 drag_set_info($widget, $self->{cwd}, $data);
1229 sub restore_list_data_received
1231 my ($self, $widget, $context, $x, $y, $data, $info, $time) = @_;
1234 if ($info eq 40 || $info eq 0) # patch for display!=:0
1236 foreach my $elt (split(/ :: /, $data->data()))
1239 my ($file, $jobid, $type) =
1241 $file = unpack("u", $file);
1243 $self->add_selected_file_to_list($file, $jobid, $type);
1248 sub on_back_button_clicked {
1252 sub on_location_go_button_clicked
1255 $self->ch_dir($self->{location}->get_text());
1257 sub on_quit_activate {Gtk2->main_quit;}
1258 sub on_preferences_activate
1261 $self->{dlg_pref}->display($self) ;
1263 sub on_main_delete_event {Gtk2->main_quit;}
1264 sub on_bweb_activate
1267 $self->set_status("Open bweb on your browser");
1268 $self->{pref}->go_bweb('', "go on bweb");
1271 # Change to parent directory
1275 if ($self->{cwd} eq '/')
1279 my @dirs = File::Spec->splitdir ($self->{cwd});
1281 $self->ch_dir(File::Spec->catdir(@dirs));
1284 # Change the current working directory
1285 # * Updates fileview, location, and selection
1290 $self->{cwd} = shift;
1292 $self->refresh_fileview();
1293 $self->{location}->set_text($self->{cwd});
1298 # Handle dialog 'close' (window-decoration induced close)
1299 # * Just hide the dialog, and tell Gtk not to do anything else
1303 my ($self, $w) = @_;
1306 1; # consume this event!
1309 # Handle key presses in location text edit control
1310 # * Translate a Return/Enter key into a 'Go' command
1311 # * All other key presses left for GTK
1313 sub on_location_entry_key_release_event
1319 my $keypress = $event->keyval;
1320 if ($keypress == $Gtk2::Gdk::Keysyms{KP_Enter} ||
1321 $keypress == $Gtk2::Gdk::Keysyms{Return})
1323 $self->ch_dir($widget->get_text());
1325 return 1; # consume keypress
1328 return 0; # let gtk have the keypress
1331 sub on_fileview_key_press_event
1333 my ($self, $widget, $event) = @_;
1337 sub listview_get_first
1340 my @selected = $list->get_selected_indices();
1341 if (@selected > 0) {
1342 my ($name, @other) = @{$list->{data}->[$selected[0]]};
1343 return (unpack('u', $name), @other);
1349 sub listview_get_all
1353 my @selected = $list->get_selected_indices();
1355 for my $i (@selected) {
1356 my ($name, @other) = @{$list->{data}->[$i]};
1357 push @ret, [unpack('u', $name), @other];
1365 my ($list, $name, @other) = @_;
1366 push @{$list->{data}}, [pack('u', $name), @other];
1369 #----------------------------------------------------------------------
1370 # Handle keypress in file-view
1371 # * Translates backspace into a 'cd ..' command
1372 # * All other key presses left for GTK
1374 sub on_fileview_key_release_event
1376 my ($self, $widget, $event) = @_;
1377 if (not $event->keyval)
1381 if ($event->keyval == $Gtk2::Gdk::Keysyms{BackSpace}) {
1383 return 1; # eat keypress
1386 return 0; # let gtk have keypress
1389 sub on_forward_keypress
1394 #----------------------------------------------------------------------
1395 # Handle double-click (or enter) on file-view
1396 # * Translates into a 'cd <dir>' command
1398 sub on_fileview_row_activated
1400 my ($self, $widget) = @_;
1402 my ($name, undef, $type, undef) = listview_get_first($widget);
1406 if ($self->{cwd} eq '')
1408 $self->ch_dir($name);
1410 elsif ($self->{cwd} eq '/')
1412 $self->ch_dir('/' . $name);
1416 $self->ch_dir($self->{cwd} . '/' . $name);
1420 $self->fill_infoview($self->{cwd}, $name);
1423 return 1; # consume event
1428 my ($self, $path, $file) = @_;
1429 $self->clear_infoview();
1430 my @v = get_all_file_versions($self->{dbh},
1433 $self->current_client,
1434 $self->{pref}->{see_all_versions});
1436 my (undef,$fn,$jobid,$fileindex,$mtime,$size,$inchanger,$md5,$volname)
1438 my $icon = ($inchanger)?$yesicon:$noicon;
1440 $mtime = localtime($mtime) ;
1442 listview_push($self->{fileinfo},
1443 $file, $jobid, 'file',
1444 $icon, $volname, $jobid, human($size), $mtime, $md5);
1451 return $self->{restore_backup_combobox}->get_active_text;
1457 return $self->{client_combobox}->get_active_text;
1460 sub on_list_backups_changed
1462 my ($self, $widget) = @_;
1463 return 0 unless defined $self->{fileview};
1465 $self->{CurrentJobIds} = [
1466 set_job_ids_for_date($self->{dbh},
1467 $self->current_client,
1468 $self->current_date,
1469 $self->{pref}->{use_ok_bkp_only})
1472 $self->refresh_fileview();
1476 sub on_restore_list_keypress
1478 my ($self, $widget, $event) = @_;
1479 if ($event->keyval == $Gtk2::Gdk::Keysyms{Delete})
1481 my @sel = $widget->get_selected_indices;
1482 foreach my $elt (reverse(sort {$a <=> $b} @sel))
1484 splice @{$self->{restore_list}->{data}},$elt,1;
1489 sub on_fileview_button_press_event
1491 my ($self,$widget,$event) = @_;
1492 if ($event->button == 3)
1494 $self->on_right_click_filelist($widget,$event);
1498 if ($event->button == 2)
1500 $self->on_see_all_version();
1507 sub on_see_all_version
1511 my @lst = listview_get_all($self->{fileview});
1514 my ($name, undef) = @{$i};
1516 new DlgFileVersion($self->{dbh},
1517 $self->current_client,
1518 $self->{cwd}, $name);
1522 sub on_right_click_filelist
1524 my ($self,$widget,$event) = @_;
1525 # I need to know what's selected
1526 my @sel = listview_get_all($self->{fileview});
1531 $type = $sel[0]->[2]; # $type
1536 if (@sel >=2 or $type eq 'dir')
1538 # We have selected more than one or it is a directories
1539 $w = $self->{filelist_dir_menu};
1543 $w = $self->{filelist_file_menu};
1549 $event->button, $event->time);
1552 sub context_add_to_filelist
1556 my @sel = listview_get_all($self->{fileview});
1558 foreach my $i (@sel)
1560 my ($file, $jobid, $type, undef) = @{$i};
1561 $file = $self->{cwd} . '/' . $file;
1562 $self->add_selected_file_to_list($file, $jobid, $type);
1566 # Adds a file to the filelist
1567 sub add_selected_file_to_list
1569 my ($self, $name, $jobid, $type)=@_;
1571 my $dbh = $self->{dbh};
1572 my $restore_list = $self->{restore_list};
1574 my $curjobids=join(',', @{$self->{CurrentJobIds}});
1581 if ($name and substr $name,-1 ne '/')
1583 $name .= '/'; # For bacula
1585 my $dirfileindex = get_fileindex_from_dir_jobid($dbh,$name,$jobid);
1586 listview_push($restore_list,
1587 $name, $jobid, 'dir', $curjobids,
1588 $diricon, $name,$jobid,$dirfileindex);
1590 elsif ($type eq 'file')
1592 my $fileindex = get_fileindex_from_file_jobid($dbh,$name,$jobid);
1594 listview_push($restore_list,
1595 $name, $jobid, 'file', $curjobids,
1596 $fileicon, $name, $jobid, $fileindex );
1600 # TODO : we want be able to restore files from a bad ended backup
1601 # we have JobStatus IN ('T', 'A', 'E') and we must
1603 # Data acces subs from here. Interaction with SGBD and caching
1605 # This sub retrieves the list of jobs corresponding to the jobs selected in the
1606 # GUI and stores them in @CurrentJobIds
1607 sub set_job_ids_for_date
1609 my ($dbh, $client, $date, $only_ok)=@_;
1611 if (!$client or !$date) {
1615 my $status = get_wanted_job_status($only_ok);
1617 # The algorithm : for a client, we get all the backups for each
1618 # fileset, in reverse order Then, for each fileset, we store the 'good'
1619 # incrementals and differentials until we have found a full so it goes
1620 # like this : store all incrementals until we have found a differential
1621 # or a full, then find the full #
1623 my $query = "SELECT JobId, FileSet, Level, JobStatus
1624 FROM Job, Client, FileSet
1625 WHERE Job.ClientId = Client.ClientId
1626 AND FileSet.FileSetId = Job.FileSetId
1627 AND EndTime <= '$date'
1628 AND Client.Name = '$client'
1630 AND JobStatus IN ($status)
1631 ORDER BY FileSet, JobTDate DESC";
1633 print $query,"\n" if $debug;
1635 my $result = $dbh->selectall_arrayref($query);
1637 foreach my $refrow (@$result)
1639 my $jobid = $refrow->[0];
1640 my $fileset = $refrow->[1];
1641 my $level = $refrow->[2];
1643 defined $progress{$fileset} or $progress{$fileset}='U'; # U for unknown
1645 next if $progress{$fileset} eq 'F'; # It's over for this fileset...
1649 next unless ($progress{$fileset} eq 'U' or $progress{$fileset} eq 'I');
1650 push @CurrentJobIds,($jobid);
1652 elsif ($level eq 'D')
1654 next if $progress{$fileset} eq 'D'; # We allready have a differential
1655 push @CurrentJobIds,($jobid);
1657 elsif ($level eq 'F')
1659 push @CurrentJobIds,($jobid);
1662 my $status = $refrow->[3] ;
1663 if ($status eq 'T') { # good end of job
1664 $progress{$fileset} = $level;
1667 print Data::Dumper::Dumper(\@CurrentJobIds) if $debug;
1669 return @CurrentJobIds;
1672 # Lists all directories contained inside a directory.
1673 # Uses the current dir, the client name, and CurrentJobIds for visibility.
1674 # Returns an array of dirs
1677 my ($self,$dir,$client)=@_;
1678 print "list_dirs($dir, $client)\n";
1680 # Is data allready cached ?
1681 if (not $self->{dirtree}->{$client})
1683 $self->cache_dirs($client);
1686 if ($dir ne '' and substr $dir,-1 ne '/')
1688 $dir .= '/'; # In the db, there is a / at the end of the dirs ...
1690 # Here, the tree is cached in ram
1691 my @dir = split('/',$dir,-1);
1692 pop @dir; # We don't need the empty trailing element
1694 # We have to get the reference of the hash containing $dir contents
1696 my $refdir=$self->{dirtree}->{$client};
1699 foreach my $subdir (@dir)
1705 $refdir = $refdir->[0]->{$subdir};
1708 # We reached the directory
1711 foreach my $dir (sort(keys %{$refdir->[0]}))
1713 # We return the directory's content : only visible directories
1714 foreach my $jobid (reverse(sort(@{$self->{CurrentJobIds}})))
1716 if (defined $refdir->[0]->{$dir}->[1]->{$jobid})
1718 my $dirname = $refdir->[0]->{$dir}->[2]; # The real dirname...
1719 push @return_list,($dirname);
1720 next DIRLOOP; # No need to waste more CPU cycles...
1724 print "LIST DIR : ", Data::Dumper::Dumper(\@return_list),"\n";
1725 return @return_list;
1729 # List all files in a directory. dir as parameter, CurrentJobIds for visibility
1730 # Returns an array of dirs
1733 my ($self, $dir)=@_;
1734 my $dbh = $self->{dbh};
1738 print "list_files($dir)\n";
1740 if ($dir ne '' and substr $dir,-1 ne '/')
1742 $dir .= '/'; # In the db, there is a / at the end of the dirs ...
1745 my $query = "SELECT Path.PathId FROM Path WHERE Path.Path = '$dir'";
1746 print $query,"\n" if $debug;
1748 my $result = $dbh->selectall_arrayref($query);
1749 foreach my $refrow (@$result)
1751 push @list_pathid,($refrow->[0]);
1754 if (@list_pathid == 0)
1756 print "No pathid found for $dir\n" if $debug;
1760 my $inlistpath = join (',', @list_pathid);
1761 my $inclause = join (',', @{$self->{CurrentJobIds}});
1762 if ($inclause eq '')
1768 "SELECT listfiles.id, listfiles.Name, File.LStat, File.JobId
1770 (SELECT Filename.Name, max(File.FileId) as id
1772 WHERE File.FilenameId = Filename.FilenameId
1773 AND Filename.Name != ''
1774 AND File.PathId IN ($inlistpath)
1775 AND File.JobId IN ($inclause)
1776 GROUP BY Filename.Name
1777 ORDER BY Filename.Name) AS listfiles,
1779 WHERE File.FileId = listfiles.id";
1781 print $query,"\n" if $debug;
1782 $result = $dbh->selectall_arrayref($query);
1787 # For the dirs, because of the db schema, it's inefficient to get the
1788 # directories contained inside other directories (regexp match or tossing
1789 # lots of records...). So we load all the tree and cache it. The data is
1790 # stored in a structure of this form :
1791 # Each directory is an array.
1792 # - In this array, the first element is a ref to next dir (hash)
1793 # - The second element is a hash containing all jobids pointing
1794 # on an array containing their lstat (or 1 if this jobid is there because
1796 # - The third is the filename itself (it could get mangled because of
1799 # So it looks like this :
1800 # $reftree->[ { 'dir1' => $refdir1
1801 # 'dir2' => $refdir2
1804 # { 'jobid1' => 'lstat1',
1805 # 'jobid2' => 'lstat2',
1806 # 'jobid3' => 1 # This one is here for "visibility"
1811 # Client as a parameter
1812 # Returns an array of dirs
1815 my ($self, $client) = @_;
1816 print "cache_dirs()\n";
1818 $self->{dirtree}->{$client} = []; # reset cache
1819 my $dbh = $self->{dbh};
1821 # TODO : If we get here, things could get lenghty ... draw a popup window .
1822 my $widget = Gtk2::MessageDialog->new($self->{mainwin},
1823 'destroy-with-parent',
1825 'Populating cache');
1827 Gtk2->main_iteration while (Gtk2->events_pending);
1829 # We have to build the tree, as it's the first time it is asked...
1832 # First, we only need the jobids of the selected server.
1833 # It's not the same as @CurrentJobIds (we need ALL the jobs)
1834 # We get the JobIds first in order to have the best execution
1835 # plan possible for the big query, with an in clause.
1837 my $status = get_wanted_job_status($self->{pref}->{use_ok_bkp_only});
1841 WHERE Job.ClientId = Client.ClientId
1842 AND Client.Name = '$client'
1843 AND Job.JobStatus IN ($status)
1844 AND Job.Type = 'B'";
1846 print $query,"\n" if $debug;
1847 my $result = $dbh->selectall_arrayref($query);
1849 foreach my $record (@{$result})
1851 push @jobids,($record->[0]);
1853 my $inclause = join(',',@jobids);
1854 if ($inclause eq '')
1857 $self->set_status("No previous backup found for $client");
1861 # Then, still to help dear mysql, we'll retrieve the PathId from empty Path (directory entries...)
1864 "SELECT Filename.FilenameId FROM Filename WHERE Filename.Name=''";
1866 print $query,"\n" if $debug;
1867 $result = $dbh->selectall_arrayref($query);
1868 foreach my $record (@{$result})
1870 push @dirids,$record->[0];
1872 my $dirinclause = join(',',@dirids);
1874 # This query is a bit complicated :
1875 # whe need to find all dir entries that should be displayed, even
1876 # if the directory itself has no entry in File table (it means a file
1877 # is explicitely chosen in the backup configuration)
1878 # Here's what I wanted to do :
1881 # SELECT T1.Path, T2.Lstat, T2.JobId
1882 # FROM ( SELECT DISTINCT Path.PathId, Path.Path FROM File, Path
1883 # WHERE File.PathId = Path.PathId
1884 # AND File.JobId IN ($inclause)) AS T1
1886 # ( SELECT File.Lstat, File.JobId, File.PathId FROM File
1887 # WHERE File.FilenameId IN ($dirinclause)
1888 # AND File.JobId IN ($inclause)) AS T2
1889 # ON (T1.PathId = T2.PathId)
1891 # It works perfectly with postgresql, but mysql doesn't seem to be able
1892 # to do the hash join correcty, so the performance sucks.
1893 # So it will be done in 4 steps :
1894 # o create T1 and T2 as temp tables
1895 # o create an index on T2.PathId
1897 # o remove the temp tables
1899 CREATE TEMPORARY TABLE T1 AS
1900 SELECT DISTINCT Path.PathId, Path.Path FROM File, Path
1901 WHERE File.PathId = Path.PathId
1902 AND File.JobId IN ($inclause)
1904 print $query,"\n" if $debug;
1907 CREATE TEMPORARY TABLE T2 AS
1908 SELECT File.Lstat, File.JobId, File.PathId FROM File
1909 WHERE File.FilenameId IN ($dirinclause)
1910 AND File.JobId IN ($inclause)
1912 print $query,"\n" if $debug;
1915 CREATE INDEX tmp2 ON T2(PathId)
1917 print $query,"\n" if $debug;
1921 SELECT T1.Path, T2.Lstat, T2.JobId
1922 FROM T1 LEFT JOIN T2
1923 ON (T1.PathId = T2.PathId)
1926 print $query,"\n" if $debug;
1927 $result = $dbh->selectall_arrayref($query);
1929 foreach my $record (@{$result})
1931 # Dirty hack to force the string encoding on perl... we don't
1932 # want implicit conversions
1933 my $path = pack "U0C*", unpack "C*",$record->[0];
1935 my @path = split('/',$path,-1);
1936 pop @path; # we don't need the trailing empty element
1937 my $lstat = $record->[1];
1938 my $jobid = $record->[2];
1940 # We're going to store all the data on the cache tree.
1941 # We find the leaf, then store data there
1942 my $reftree=$self->{dirtree}->{$client};
1943 foreach my $dir(@path)
1949 if (not defined($reftree->[0]->{$dir}))
1952 $reftree->[0]->{$dir}=\@tmparray;
1954 $reftree=$reftree->[0]->{$dir};
1957 # We can now add the metadata for this dir ...
1959 # $result = $dbh->selectall_arrayref($query);
1962 # contains something
1963 $reftree->[1]->{$jobid}=$lstat;
1967 # We have a very special case here...
1968 # lstat is not defined.
1969 # it means the directory is there because a file has been
1970 # backuped. so the dir has no entry in File table.
1971 # That's a rare case, so we can afford to determine it's
1972 # visibility with a query
1973 my $select_path=$record->[0];
1974 $select_path=$dbh->quote($select_path); # gotta be careful
1978 WHERE File.PathId = Path.PathId
1979 AND Path.Path = $select_path
1981 print $query,"\n" if $debug;
1982 my $result2 = $dbh->selectall_arrayref($query);
1983 foreach my $record (@{$result2})
1985 my $jobid=$record->[0];
1986 $reftree->[1]->{$jobid}=1;
1994 print $query,"\n" if $debug;
1999 print $query,"\n" if $debug;
2003 list_visible($self->{dirtree}->{$client});
2006 # print Data::Dumper::Dumper($self->{dirtree});
2009 # Recursive function to calculate the visibility of each directory in the cache
2010 # tree Working with references to save time and memory
2011 # For each directory, we want to propagate it's visible jobids onto it's
2012 # parents directory.
2013 # A tree is visible if
2014 # - it's been in a backup pointed by the CurrentJobIds
2015 # - one of it's subdirs is in a backup pointed by the CurrentJobIds
2016 # In the second case, the directory is visible but has no metadata.
2017 # We symbolize this with lstat = 1 for this jobid in the cache.
2019 # Input : reference directory
2020 # Output : visibility of this dir. Has to know visibility of all subdirs
2021 # to know it's visibility, hence the recursing.
2027 # Get the subdirs array references list
2028 my @list_ref_subdirs;
2029 while( my (undef,$ref_subdir) = each (%{$refdir->[0]}))
2031 push @list_ref_subdirs,($ref_subdir);
2034 # Now lets recurse over these subdirs and retrieve the reference of a hash
2035 # containing the jobs where they are visible
2036 foreach my $ref_subdir (@list_ref_subdirs)
2038 my $ref_list_jobs = list_visible($ref_subdir);
2039 foreach my $jobid (keys %$ref_list_jobs)
2041 $visibility{$jobid}=1;
2045 # Ok. Now, we've got the list of those jobs. We are going to update our
2046 # hash (element 1 of the dir array) containing our jobs Do NOT overwrite
2047 # the lstat for the known jobids. Put 1 in the new elements... But first,
2048 # let's store the current jobids
2050 foreach my $jobid (keys %{$refdir->[1]})
2052 push @known_jobids,($jobid);
2056 foreach my $jobid (keys %visibility)
2058 next if ($refdir->[1]->{$jobid});
2059 $refdir->[1]->{$jobid} = 1;
2061 # Add the known_jobids to %visibility
2062 foreach my $jobid (@known_jobids)
2064 $visibility{$jobid}=1;
2066 return \%visibility;
2069 # Returns the list of media required for a list of jobids.
2070 # Input : dbh, jobid1, jobid2...
2071 # Output : reference to array of (joibd, inchanger)
2072 sub get_required_media_from_jobid
2074 my ($dbh, @jobids)=@_;
2075 my $inclause = join(',',@jobids);
2077 SELECT DISTINCT JobMedia.MediaId, Media.InChanger
2078 FROM JobMedia, Media
2079 WHERE JobMedia.MediaId=Media.MediaId
2080 AND JobId In ($inclause)
2082 my $result = $dbh->selectall_arrayref($query);
2086 # Returns the fileindex from dirname and jobid.
2087 # Input : dbh, dirname, jobid
2088 # Output : fileindex
2089 sub get_fileindex_from_dir_jobid
2091 my ($dbh, $dirname, $jobid)=@_;
2093 $query = "SELECT File.FileIndex
2094 FROM File, Filename, Path
2095 WHERE File.FilenameId = Filename.FilenameId
2096 AND File.PathId = Path.PathId
2097 AND Filename.Name = ''
2098 AND Path.Path = '$dirname'
2099 AND File.JobId = '$jobid'
2102 print $query,"\n" if $debug;
2103 my $result = $dbh->selectall_arrayref($query);
2104 return $result->[0]->[0];
2107 # Returns the fileindex from filename and jobid.
2108 # Input : dbh, filename, jobid
2109 # Output : fileindex
2110 sub get_fileindex_from_file_jobid
2112 my ($dbh, $filename, $jobid)=@_;
2114 my @dirs = File::Spec->splitdir ($filename);
2115 $filename=pop(@dirs);
2116 my $dirname = File::Spec->catdir(@dirs) . '/';
2121 "SELECT File.FileIndex
2122 FROM File, Filename, Path
2123 WHERE File.FilenameId = Filename.FilenameId
2124 AND File.PathId = Path.PathId
2125 AND Filename.Name = '$filename'
2126 AND Path.Path = '$dirname'
2127 AND File.JobId = '$jobid'";
2129 print $query,"\n" if $debug;
2130 my $result = $dbh->selectall_arrayref($query);
2131 return $result->[0]->[0];
2135 # Returns list of versions of a file that could be restored
2136 # returns an array of
2137 # ('FILE:',filename,jobid,fileindex,mtime,size,inchanger,md5,volname)
2138 # It's the same as entries of restore_list (hidden) + mtime and size and inchanger
2139 # and volname and md5
2140 # and of course, there will be only one jobid in the array of jobids...
2141 sub get_all_file_versions
2143 my ($dbh,$path,$file,$client,$see_all)=@_;
2145 defined $see_all or $see_all=0;
2150 "SELECT File.JobId, File.FileIndex, File.Lstat,
2151 File.Md5, Media.VolumeName, Media.InChanger
2152 FROM File, Filename, Path, Job, Client, JobMedia, Media
2153 WHERE File.FilenameId = Filename.FilenameId
2154 AND File.PathId=Path.PathId
2155 AND File.JobId = Job.JobId
2156 AND Job.ClientId = Client.ClientId
2157 AND Job.JobId = JobMedia.JobId
2158 AND File.FileIndex >= JobMedia.FirstIndex
2159 AND File.FileIndex <= JobMedia.LastIndex
2160 AND JobMedia.MediaId = Media.MediaId
2161 AND Path.Path = '$path'
2162 AND Filename.Name = '$file'
2163 AND Client.Name = '$client'";
2165 print $query if $debug;
2167 my $result = $dbh->selectall_arrayref($query);
2169 foreach my $refrow (@$result)
2171 my ($jobid, $fileindex, $lstat, $md5, $volname, $inchanger) = @$refrow;
2172 my @attribs = parse_lstat($lstat);
2173 my $mtime = array_attrib('st_mtime',\@attribs);
2174 my $size = array_attrib('st_size',\@attribs);
2176 my @list = ('FILE:', $path.$file, $jobid, $fileindex, $mtime, $size,
2177 $inchanger, $md5, $volname);
2178 push @versions, (\@list);
2181 # We have the list of all versions of this file.
2182 # We'll sort it by mtime desc, size, md5, inchanger desc
2183 # the rest of the algorithm will be simpler
2184 # ('FILE:',filename,jobid,fileindex,mtime,size,inchanger,md5,volname)
2185 @versions = sort { $b->[4] <=> $a->[4]
2186 || $a->[5] <=> $b->[5]
2187 || $a->[7] cmp $a->[7]
2188 || $b->[6] <=> $a->[6]} @versions;
2191 my %allready_seen_by_mtime;
2192 my %allready_seen_by_md5;
2193 # Now we should create a new array with only the interesting records
2194 foreach my $ref (@versions)
2198 # The file has a md5. We compare his md5 to other known md5...
2199 # We take size into account. It may happen that 2 files
2200 # have the same md5sum and are different. size is a supplementary
2203 # If we allready have a (better) version
2204 next if ( (not $see_all)
2205 and $allready_seen_by_md5{$ref->[7] .'-'. $ref->[5]});
2207 # we never met this one before...
2208 $allready_seen_by_md5{$ref->[7] .'-'. $ref->[5]}=1;
2210 # Even if it has a md5, we should also work with mtimes
2211 # We allready have a (better) version
2212 next if ( (not $see_all)
2213 and $allready_seen_by_mtime{$ref->[4] .'-'. $ref->[5]});
2214 $allready_seen_by_mtime{$ref->[4] .'-'. $ref->[5] . '-' . $ref->[7]}=1;
2216 # We reached there. The file hasn't been seen.
2217 push @good_versions,($ref);
2220 # To be nice with the user, we re-sort good_versions by
2221 # inchanger desc, mtime desc
2222 @good_versions = sort { $b->[4] <=> $a->[4]
2223 || $b->[2] <=> $a->[2]} @good_versions;
2225 return @good_versions;
2228 # TODO : bsr must use only good backup or not (see use_ok_bkp_only)
2229 # This sub creates a BSR from the information in the restore_list
2230 # Returns the BSR as a string
2234 my $dbh = $self->{dbh};
2236 # This query gets all jobid/jobmedia/media combination.
2238 SELECT Job.JobId, Job.VolsessionId, Job.VolsessionTime, JobMedia.StartFile,
2239 JobMedia.EndFile, JobMedia.FirstIndex, JobMedia.LastIndex,
2240 JobMedia.StartBlock, JobMedia.EndBlock, JobMedia.VolIndex,
2241 Media.Volumename, Media.MediaType
2242 FROM Job, JobMedia, Media
2243 WHERE Job.JobId = JobMedia.JobId
2244 AND JobMedia.MediaId = Media.MediaId
2245 ORDER BY JobMedia.FirstIndex, JobMedia.LastIndex";
2248 my $result = $dbh->selectall_arrayref($query);
2250 # We will store everything hashed by jobid.
2252 foreach my $refrow (@$result)
2254 my ($jobid, $volsessionid, $volsessiontime, $startfile, $endfile,
2255 $firstindex, $lastindex, $startblock, $endblock,
2256 $volindex, $volumename, $mediatype) = @{$refrow};
2258 # We just have to deal with the case where starfile != endfile
2259 # In this case, we concatenate both, for the bsr
2260 if ($startfile != $endfile) {
2261 $startfile = $startfile . '-' . $endfile;
2265 ($jobid, $volsessionid, $volsessiontime, $startfile,
2266 $firstindex, $lastindex, $startblock .'-'. $endblock,
2267 $volindex, $volumename, $mediatype);
2269 push @{$mediainfos{$refrow->[0]}},(\@tmparray);
2273 # reminder : restore_list looks like this :
2274 # ($name,$jobid,'file',$curjobids, undef, undef, undef, $dirfileindex);
2276 # Here, we retrieve every file/dir that could be in the restore
2277 # We do as simple as possible for the SQL engine (no crazy joins,
2278 # no pseudo join (>= FirstIndex ...), etc ...
2279 # We do a SQL union of all the files/dirs specified in the restore_list
2281 foreach my $entry (@{$self->{restore_list}->{data}})
2283 if ($entry->[2] eq 'dir')
2285 my $dir = unpack('u', $entry->[0]);
2286 my $inclause = $entry->[3]; #curjobids
2289 "(SELECT Path.Path, Filename.Name, File.FileIndex, File.JobId
2290 FROM File, Path, Filename
2291 WHERE Path.PathId = File.PathId
2292 AND File.FilenameId = Filename.FilenameId
2293 AND Path.Path LIKE '$dir%'
2294 AND File.JobId IN ($inclause) )";
2295 push @select_queries,($query);
2299 # It's a file. Great, we allready have most
2300 # of what is needed. Simple and efficient query
2301 my $file = unpack('u', $entry->[0]);
2302 my @file = split '/',$file;
2304 my $dir = join('/',@file);
2306 my $jobid = $entry->[1];
2307 my $fileindex = $entry->[7];
2308 my $inclause = $entry->[3]; # curjobids
2310 "(SELECT Path.Path, Filename.Name, File.FileIndex, File.JobId
2311 FROM File, Path, Filename
2312 WHERE Path.PathId = File.PathId
2313 AND File.FilenameId = Filename.FilenameId
2314 AND Path.Path = '$dir/'
2315 AND Filename.Name = '$file'
2316 AND File.JobId = $jobid)";
2317 push @select_queries,($query);
2320 $query = join("\nUNION ALL\n",@select_queries) . "\nORDER BY FileIndex\n";
2322 print $query,"\n" if $debug;
2324 #Now we run the query and parse the result...
2325 # there may be a lot of records, so we better be efficient
2326 # We use the bind column method, working with references...
2328 my $sth = $dbh->prepare($query);
2331 my ($path,$name,$fileindex,$jobid);
2332 $sth->bind_columns(\$path,\$name,\$fileindex,\$jobid);
2334 # The temp place we're going to save all file
2335 # list to before the real list
2339 while ($sth->fetchrow_arrayref())
2341 # This may look dumb, but we're going to do a join by ourselves,
2342 # to save memory and avoid sending a complex query to mysql
2343 my $complete_path = $path . $name;
2351 # Remove trailing slash (normalize file and dir name)
2352 $complete_path =~ s/\/$//;
2354 # Let's find the ref(s) for the %mediainfo element(s)
2355 # containing the data for this file
2356 # There can be several matches. It is the pseudo join.
2358 my $max_elt=@{$mediainfos{$jobid}}-1;
2360 while($med_idx <= $max_elt)
2362 my $ref = $mediainfos{$jobid}->[$med_idx];
2363 # First, can we get rid of the first elements of the
2364 # array ? (if they don't contain valuable records
2366 if ($fileindex > $ref->[5])
2368 # It seems we don't need anymore
2369 # this entry in %mediainfo (the input data
2372 shift @{$mediainfos{$jobid}};
2376 # We will do work on this elt. We can ++
2377 # $med_idx for next loop
2380 # %mediainfo row looks like :
2381 # (jobid,VolsessionId,VolsessionTime,File,FirstIndex,
2382 # LastIndex,StartBlock-EndBlock,VolIndex,Volumename,
2385 # We are in range. We store and continue looping
2387 if ($fileindex >= $ref->[4])
2389 my @data = ($complete_path,$is_dir,
2391 push @temp_list,(\@data);
2395 # We are not in range. No point in continuing looping
2396 # We go to next record.
2400 # Now we have the array.
2401 # We're going to sort it, by
2402 # path, volsessiontime DESC (get the most recent file...)
2403 # The array rows look like this :
2404 # complete_path,is_dir,fileindex,
2405 # ref->(jobid,VolsessionId,VolsessionTime,File,FirstIndex,
2406 # LastIndex,StartBlock-EndBlock,VolIndex,Volumename,MediaType)
2407 @temp_list = sort {$a->[0] cmp $b->[0]
2408 || $b->[3]->[2] <=> $a->[3]->[2]
2412 my $prev_complete_path='////'; # Sure not to match
2416 while (my $refrow = shift @temp_list)
2418 # For the sake of readability, we load $refrow
2419 # contents in real scalars
2420 my ($complete_path, $is_dir, $fileindex, $refother)=@{$refrow};
2421 my $jobid= $refother->[0]; # We don't need the rest...
2423 # We skip this entry.
2424 # We allready have a newer one and this
2425 # isn't a continuation of the same file
2426 next if ($complete_path eq $prev_complete_path
2427 and $jobid != $prev_jobid);
2431 and $complete_path =~ m|^\Q$prev_complete_path\E/|)
2433 # We would be recursing inside a file.
2434 # Just what we don't want (dir replaced by file
2435 # between two backups
2441 push @restore_list,($refrow);
2443 $prev_complete_path = $complete_path;
2444 $prev_jobid = $jobid;
2450 push @restore_list,($refrow);
2452 $prev_complete_path = $complete_path;
2453 $prev_jobid = $jobid;
2457 # We get rid of @temp_list... save memory
2460 # Ok everything is in the list. Let's sort it again in another way.
2461 # This time it will be in the bsr file order
2463 # we sort the results by
2464 # volsessiontime, volsessionid, volindex, fileindex
2465 # to get all files in right order...
2466 # Reminder : The array rows look like this :
2467 # complete_path,is_dir,fileindex,
2468 # ref->(jobid,VolsessionId,VolsessionTime,File,FirstIndex,LastIndex,
2469 # StartBlock-EndBlock,VolIndex,Volumename,MediaType)
2471 @restore_list= sort { $a->[3]->[2] <=> $b->[3]->[2]
2472 || $a->[3]->[1] <=> $b->[3]->[1]
2473 || $a->[3]->[7] <=> $b->[3]->[7]
2474 || $a->[2] <=> $b->[2] }
2477 # Now that everything is ready, we create the bsr
2478 my $prev_fileindex=-1;
2479 my $prev_volsessionid=-1;
2480 my $prev_volsessiontime=-1;
2481 my $prev_volumename=-1;
2482 my $prev_volfile=-1;
2486 my $first_of_current_range=0;
2487 my @fileindex_ranges;
2490 foreach my $refrow (@restore_list)
2492 my (undef,undef,$fileindex,$refother)=@{$refrow};
2493 my (undef,$volsessionid,$volsessiontime,$volfile,undef,undef,
2494 $volblocks,undef,$volumename,$mediatype)=@{$refother};
2496 # We can specifiy the number of files in each section of the
2497 # bsr to speedup restore (bacula can then jump over the
2498 # end of tape files.
2502 if ($prev_volumename eq '-1')
2504 # We only have to start the new range...
2505 $first_of_current_range=$fileindex;
2507 elsif ($prev_volsessionid != $volsessionid
2508 or $prev_volsessiontime != $volsessiontime
2509 or $prev_volumename ne $volumename
2510 or $prev_volfile != $volfile)
2512 # We have to create a new section in the bsr...
2513 # We print the previous one ...
2514 # (before that, save the current range ...)
2515 if ($first_of_current_range != $prev_fileindex)
2518 push @fileindex_ranges,
2519 ("$first_of_current_range-$prev_fileindex");
2523 # We are out of a range,
2524 # but there is only one element in the range
2525 push @fileindex_ranges,
2526 ("$first_of_current_range");
2529 $bsr.=print_bsr_section(\@fileindex_ranges,
2531 $prev_volsessiontime,
2538 # Reset for next loop
2539 @fileindex_ranges=();
2540 $first_of_current_range=$fileindex;
2542 elsif ($fileindex-1 != $prev_fileindex)
2544 # End of a range of fileindexes
2545 if ($first_of_current_range != $prev_fileindex)
2548 push @fileindex_ranges,
2549 ("$first_of_current_range-$prev_fileindex");
2553 # We are out of a range,
2554 # but there is only one element in the range
2555 push @fileindex_ranges,
2556 ("$first_of_current_range");
2558 $first_of_current_range=$fileindex;
2560 $prev_fileindex=$fileindex;
2561 $prev_volsessionid = $volsessionid;
2562 $prev_volsessiontime = $volsessiontime;
2563 $prev_volumename = $volumename;
2564 $prev_volfile=$volfile;
2565 $prev_mediatype=$mediatype;
2566 $prev_volblocks=$volblocks;
2570 # Ok, we're out of the loop. Alas, there's still the last record ...
2571 if ($first_of_current_range != $prev_fileindex)
2574 push @fileindex_ranges,("$first_of_current_range-$prev_fileindex");
2579 # We are out of a range,
2580 # but there is only one element in the range
2581 push @fileindex_ranges,("$first_of_current_range");
2584 $bsr.=print_bsr_section(\@fileindex_ranges,
2586 $prev_volsessiontime,
2596 sub print_bsr_section
2598 my ($ref_fileindex_ranges,$volsessionid,
2599 $volsessiontime,$volumename,$volfile,
2600 $mediatype,$volblocks,$count)=@_;
2603 $bsr .= "Volume=\"$volumename\"\n";
2604 $bsr .= "MediaType=\"$mediatype\"\n";
2605 $bsr .= "VolSessionId=$volsessionid\n";
2606 $bsr .= "VolSessionTime=$volsessiontime\n";
2607 $bsr .= "VolFile=$volfile\n";
2608 $bsr .= "VolBlock=$volblocks\n";
2610 foreach my $range (@{$ref_fileindex_ranges})
2612 $bsr .= "FileIndex=$range\n";
2615 $bsr .= "Count=$count\n";
2621 my %attrib_name_id = ( 'st_dev' => 0,'st_ino' => 1,'st_mode' => 2,
2622 'st_nlink' => 3,'st_uid' => 4,'st_gid' => 5,
2623 'st_rdev' => 6,'st_size' => 7,'st_blksize' => 8,
2624 'st_blocks' => 9,'st_atime' => 10,'st_mtime' => 11,
2625 'st_ctime' => 12,'LinkFI' => 13,'st_flags' => 14,
2626 'data_stream' => 15);;
2629 my ($attrib,$ref_attrib)=@_;
2630 return $ref_attrib->[$attrib_name_id{$attrib}];
2634 { # $file = [listfiles.id, listfiles.Name, File.LStat, File.JobId]
2636 my ($file, $attrib)=@_;
2638 if (defined $attrib_name_id{$attrib}) {
2640 my @d = split(' ', $file->[2]) ; # TODO : cache this
2642 return from_base64($d[$attrib_name_id{$attrib}]);
2644 } elsif ($attrib eq 'jobid') {
2648 } elsif ($attrib eq 'name') {
2653 die "Attribute not known : $attrib.\n";
2657 # Return the jobid or attribute asked for a dir
2660 my ($self,$dir,$attrib)=@_;
2662 my @dir = split('/',$dir,-1);
2663 my $refdir=$self->{dirtree}->{$self->current_client};
2665 if (not defined $attrib_name_id{$attrib} and $attrib ne 'jobid')
2667 die "Attribute not known : $attrib.\n";
2670 foreach my $subdir (@dir)
2672 $refdir = $refdir->[0]->{$subdir};
2675 # $refdir is now the reference to the dir's array
2676 # Is the a jobid in @CurrentJobIds where the lstat is
2677 # defined (we'll search in reverse order)
2678 foreach my $jobid (reverse(sort {$a <=> $b } @{$self->{CurrentJobIds}}))
2680 if (defined $refdir->[1]->{$jobid} and $refdir->[1]->{$jobid} ne '1')
2682 if ($attrib eq 'jobid')
2688 my @attribs = parse_lstat($refdir->[1]->{$jobid});
2689 return $attribs[$attrib_name_id{$attrib}+1];
2694 return 0; # We cannot get a good attribute.
2695 # This directory is here for the sake of visibility
2700 # Base 64 functions, directly from recover.pl.
2702 # Karl Hakimian <hakimian@aha.com>
2703 # This section is also under GPL v2 or later.
2710 'A', 'B', 'C', 'D', 'E', 'F', 'G', 'H', 'I', 'J', 'K', 'L', 'M',
2711 'N', 'O', 'P', 'Q', 'R', 'S', 'T', 'U', 'V', 'W', 'X', 'Y', 'Z',
2712 'a', 'b', 'c', 'd', 'e', 'f', 'g', 'h', 'i', 'j', 'k', 'l', 'm',
2713 'n', 'o', 'p', 'q', 'r', 's', 't', 'u', 'v', 'w', 'x', 'y', 'z',
2714 '0', '1', '2', '3', '4', '5', '6', '7', '8', '9', '+', '/'
2716 @base64_map = (0) x 128;
2718 for (my $i=0; $i<64; $i++) {
2719 $base64_map[ord($base64_digits[$i])] = $i;
2734 if (substr($where, 0, 1) eq '-') {
2736 $where = substr($where, 1);
2739 while ($where ne '') {
2741 my $d = substr($where, 0, 1);
2742 $val += $base64_map[ord(substr($where, 0, 1))];
2743 $where = substr($where, 1);
2751 my @attribs = split(' ',$lstat);
2752 foreach my $element (@attribs)
2754 $element = from_base64($element);
2761 ################################################################
2765 my $conf = "$ENV{HOME}/.brestore.conf" ;
2766 my $p = new Pref($conf);
2772 $glade_file = $p->{glade_file};
2774 foreach my $path ('','.','/usr/share/brestore','/usr/local/share/brestore') {
2775 if (-f "$path/$glade_file") {
2776 $glade_file = "$path/$glade_file" ;
2781 if ( -f $glade_file) {
2782 my $w = new DlgResto($p);
2785 my $widget = Gtk2::MessageDialog->new(undef, 'modal', 'error', 'close',
2786 "Can't find your brestore.glade (glade_file => '$glade_file')
2787 Please, edit your $conf to setup it." );
2789 $widget->signal_connect('destroy', sub { Gtk2->main_quit() ; });
2794 Gtk2->main; # Start Gtk2 main loop
2806 # Code pour trier les colonnes
2807 my $mod = $fileview->get_model();
2808 $mod->set_default_sort_func(sub {
2809 my ($model, $item1, $item2) = @_;
2810 my $a = $model->get($item1, 1); # récupération de la valeur de la 2ème
2811 my $b = $model->get($item2, 1); # colonne (indice 1)
2816 $fileview->set_headers_clickable(1);
2817 my $col = $fileview->get_column(1); # la colonne NOM, colonne numéro 2
2818 $col->signal_connect('clicked', sub {
2819 my ($colonne, $model) = @_;
2820 $model->set_sort_column_id (1, 'ascending');