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, 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 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 sub on_estimate_clicked
1006 # TODO : If we get here, things could get lenghty ... draw a popup window .
1007 my $widget = Gtk2::MessageDialog->new($self->{mainwin},
1008 'destroy-with-parent',
1010 'Computing size...');
1014 my $title = "Computing size...\n";
1016 foreach my $entry (@{$self->{restore_list}->{data}})
1018 my ($size, $nb) = $self->estimate_restore_size($entry);
1019 my $name = unpack('u', $entry->[0]);
1021 $txt .= "\n<i>$name</i> : $nb file(s)/" . human($size) ;
1022 $widget->set_markup($title . $txt);
1029 $txt .= "\n\n<b>Total</b> : $nb_total file(s)/" . human($size_total);
1030 $widget->set_markup("Size estimation :\n" . $txt);
1031 $widget->signal_connect ("response", sub { my $w=shift; $w->destroy();});
1036 use File::Temp qw/tempfile/;
1038 sub on_go_button_clicked
1041 my $bsr = $self->create_filelist();
1042 my ($fh, $filename) = tempfile();
1045 chmod(0644, $filename);
1047 print "Dumping BSR info to $filename\n"
1050 # we get Volume list
1051 my %a = map { $_ => 1 } ($bsr =~ /Volume="(.+)"/g);
1052 my $vol = [ keys %a ] ; # need only one occurrence of each volume
1054 new DlgLaunch(pref => $self->{pref},
1056 bsr_file => $filename,
1061 our $client_list_empty = 'Clients list';
1062 our %type_markup = ('F' => '<b>$label F</b>',
1065 'B' => '<b>$label B</b>',
1067 'A' => '<span foreground=\"red\">$label</span>',
1069 'E' => '<span foreground=\"red\">$label</span>',
1072 sub on_list_client_changed
1074 my ($self, $widget) = @_;
1075 return 0 unless defined $self->{fileview};
1076 my $dbh = $self->{dbh};
1078 $self->{list_backup}->clear();
1080 if ($self->current_client eq $client_list_empty) {
1084 my @endtimes=get_all_endtimes_for_job($dbh,
1085 $self->current_client,
1086 $self->{pref}->{use_ok_bkp_only});
1087 foreach my $endtime (@endtimes)
1089 my $i = $self->{list_backup}->append();
1091 my $label = $endtime->[1] . " (" . $endtime->[4] . ")";
1092 eval "\$label = \"$type_markup{$endtime->[2]}\""; # job type
1093 eval "\$label = \"$type_markup{$endtime->[3]}\""; # job status
1095 $self->{list_backup}->set($i,
1100 $self->{restore_backup_combobox}->set_active(0);
1102 $self->{CurrentJobIds} = [
1103 set_job_ids_for_date($dbh,
1104 $self->current_client,
1105 $self->current_date,
1106 $self->{pref}->{use_ok_bkp_only})
1111 # undef $self->{dirtree};
1112 $self->refresh_fileview();
1116 sub fill_server_list
1118 my ($dbh, $combo, $list) = @_;
1120 my @clients=get_all_clients($dbh);
1124 my $i = $list->append();
1125 $list->set($i, 0, $client_list_empty);
1127 foreach my $client (@clients)
1129 $i = $list->append();
1130 $list->set($i, 0, $client);
1132 $combo->set_active(0);
1135 sub init_server_backup_combobox
1138 fill_server_list($self->{dbh},
1139 $self->{client_combobox},
1140 $self->{list_client}) ;
1143 #----------------------------------------------------------------------
1144 #Refreshes the file-view Redraws everything. The dir data is cached, the file
1145 #data isn't. There is additionnal complexity for dirs (visibility problems),
1146 #so the @CurrentJobIds is not sufficient.
1147 sub refresh_fileview
1150 my $fileview = $self->{fileview};
1151 my $client_combobox = $self->{client_combobox};
1152 my $cwd = $self->{cwd};
1154 @{$fileview->{data}} = ();
1156 $self->clear_infoview();
1158 my $client_name = $self->current_client;
1160 if (!$client_name or ($client_name eq $client_list_empty)) {
1161 $self->set_status("Client list empty");
1165 my @dirs = $self->list_dirs($cwd,$client_name);
1166 # [ [listfiles.id, listfiles.Name, File.LStat, File.JobId]..]
1167 my $files = $self->list_files($cwd);
1168 print "CWD : $cwd\n" if ($debug);
1170 my $file_count = 0 ;
1171 my $total_bytes = 0;
1173 # Add directories to view
1174 foreach my $dir (@dirs) {
1175 my $time = localtime($self->dir_attrib("$cwd/$dir",'st_mtime'));
1176 $total_bytes += 4096;
1179 listview_push($fileview,
1181 $self->dir_attrib("$cwd/$dir",'jobid'),
1191 foreach my $file (@$files)
1193 my $size = file_attrib($file,'st_size');
1194 my $time = localtime(file_attrib($file,'st_mtime'));
1195 $total_bytes += $size;
1197 # $file = [listfiles.id, listfiles.Name, File.LStat, File.JobId]
1199 listview_push($fileview,
1206 human($size), $time);
1209 $self->set_status("$file_count files/" . human($total_bytes));
1211 # set a decent default selection (makes keyboard nav easy)
1212 $fileview->select(0);
1216 sub on_about_activate
1218 DlgAbout::display();
1223 my ($tree, $path, $data) = @_;
1225 my @items = listview_get_all($tree) ;
1227 foreach my $i (@items)
1229 my @file_info = @{$i};
1232 # Ok, we have a corner case :
1237 $file = pack("u", $file_info[0]);
1241 $file = pack("u", $path . '/' . $file_info[0]);
1243 push @ret, join(" ; ", $file,
1244 $file_info[1], # $jobid
1245 $file_info[2], # $type
1249 my $data_get = join(" :: ", @ret);
1251 $data->set_text($data_get,-1);
1254 sub fileview_data_get
1256 my ($self, $widget, $context, $data, $info, $time,$string) = @_;
1257 drag_set_info($widget, $self->{cwd}, $data);
1260 sub fileinfo_data_get
1262 my ($self, $widget, $context, $data, $info, $time,$string) = @_;
1263 drag_set_info($widget, $self->{cwd}, $data);
1266 sub restore_list_data_received
1268 my ($self, $widget, $context, $x, $y, $data, $info, $time) = @_;
1271 if ($info eq 40 || $info eq 0) # patch for display!=:0
1273 foreach my $elt (split(/ :: /, $data->data()))
1276 my ($file, $jobid, $type) =
1278 $file = unpack("u", $file);
1280 $self->add_selected_file_to_list($file, $jobid, $type);
1285 sub on_back_button_clicked {
1289 sub on_location_go_button_clicked
1292 $self->ch_dir($self->{location}->get_text());
1294 sub on_quit_activate {Gtk2->main_quit;}
1295 sub on_preferences_activate
1298 $self->{dlg_pref}->display($self) ;
1300 sub on_main_delete_event {Gtk2->main_quit;}
1301 sub on_bweb_activate
1304 $self->set_status("Open bweb on your browser");
1305 $self->{pref}->go_bweb('', "go on bweb");
1308 # Change to parent directory
1312 if ($self->{cwd} eq '/')
1316 my @dirs = File::Spec->splitdir ($self->{cwd});
1318 $self->ch_dir(File::Spec->catdir(@dirs));
1321 # Change the current working directory
1322 # * Updates fileview, location, and selection
1327 $self->{cwd} = shift;
1329 $self->refresh_fileview();
1330 $self->{location}->set_text($self->{cwd});
1335 # Handle dialog 'close' (window-decoration induced close)
1336 # * Just hide the dialog, and tell Gtk not to do anything else
1340 my ($self, $w) = @_;
1343 1; # consume this event!
1346 # Handle key presses in location text edit control
1347 # * Translate a Return/Enter key into a 'Go' command
1348 # * All other key presses left for GTK
1350 sub on_location_entry_key_release_event
1356 my $keypress = $event->keyval;
1357 if ($keypress == $Gtk2::Gdk::Keysyms{KP_Enter} ||
1358 $keypress == $Gtk2::Gdk::Keysyms{Return})
1360 $self->ch_dir($widget->get_text());
1362 return 1; # consume keypress
1365 return 0; # let gtk have the keypress
1368 sub on_fileview_key_press_event
1370 my ($self, $widget, $event) = @_;
1374 sub listview_get_first
1377 my @selected = $list->get_selected_indices();
1378 if (@selected > 0) {
1379 my ($name, @other) = @{$list->{data}->[$selected[0]]};
1380 return (unpack('u', $name), @other);
1386 sub listview_get_all
1390 my @selected = $list->get_selected_indices();
1392 for my $i (@selected) {
1393 my ($name, @other) = @{$list->{data}->[$i]};
1394 push @ret, [unpack('u', $name), @other];
1402 my ($list, $name, @other) = @_;
1403 push @{$list->{data}}, [pack('u', $name), @other];
1406 #----------------------------------------------------------------------
1407 # Handle keypress in file-view
1408 # * Translates backspace into a 'cd ..' command
1409 # * All other key presses left for GTK
1411 sub on_fileview_key_release_event
1413 my ($self, $widget, $event) = @_;
1414 if (not $event->keyval)
1418 if ($event->keyval == $Gtk2::Gdk::Keysyms{BackSpace}) {
1420 return 1; # eat keypress
1423 return 0; # let gtk have keypress
1426 sub on_forward_keypress
1431 #----------------------------------------------------------------------
1432 # Handle double-click (or enter) on file-view
1433 # * Translates into a 'cd <dir>' command
1435 sub on_fileview_row_activated
1437 my ($self, $widget) = @_;
1439 my ($name, undef, $type, undef) = listview_get_first($widget);
1443 if ($self->{cwd} eq '')
1445 $self->ch_dir($name);
1447 elsif ($self->{cwd} eq '/')
1449 $self->ch_dir('/' . $name);
1453 $self->ch_dir($self->{cwd} . '/' . $name);
1457 $self->fill_infoview($self->{cwd}, $name);
1460 return 1; # consume event
1465 my ($self, $path, $file) = @_;
1466 $self->clear_infoview();
1467 my @v = get_all_file_versions($self->{dbh},
1470 $self->current_client,
1471 $self->{pref}->{see_all_versions});
1473 my (undef,$fn,$jobid,$fileindex,$mtime,$size,$inchanger,$md5,$volname)
1475 my $icon = ($inchanger)?$yesicon:$noicon;
1477 $mtime = localtime($mtime) ;
1479 listview_push($self->{fileinfo},
1480 $file, $jobid, 'file',
1481 $icon, $volname, $jobid, human($size), $mtime, $md5);
1488 return $self->{restore_backup_combobox}->get_active_text;
1494 return $self->{client_combobox}->get_active_text;
1497 sub on_list_backups_changed
1499 my ($self, $widget) = @_;
1500 return 0 unless defined $self->{fileview};
1502 $self->{CurrentJobIds} = [
1503 set_job_ids_for_date($self->{dbh},
1504 $self->current_client,
1505 $self->current_date,
1506 $self->{pref}->{use_ok_bkp_only})
1509 $self->refresh_fileview();
1513 sub on_restore_list_keypress
1515 my ($self, $widget, $event) = @_;
1516 if ($event->keyval == $Gtk2::Gdk::Keysyms{Delete})
1518 my @sel = $widget->get_selected_indices;
1519 foreach my $elt (reverse(sort {$a <=> $b} @sel))
1521 splice @{$self->{restore_list}->{data}},$elt,1;
1526 sub on_fileview_button_press_event
1528 my ($self,$widget,$event) = @_;
1529 if ($event->button == 3)
1531 $self->on_right_click_filelist($widget,$event);
1535 if ($event->button == 2)
1537 $self->on_see_all_version();
1544 sub on_see_all_version
1548 my @lst = listview_get_all($self->{fileview});
1551 my ($name, undef) = @{$i};
1553 new DlgFileVersion($self->{dbh},
1554 $self->current_client,
1555 $self->{cwd}, $name);
1559 sub on_right_click_filelist
1561 my ($self,$widget,$event) = @_;
1562 # I need to know what's selected
1563 my @sel = listview_get_all($self->{fileview});
1568 $type = $sel[0]->[2]; # $type
1573 if (@sel >=2 or $type eq 'dir')
1575 # We have selected more than one or it is a directories
1576 $w = $self->{filelist_dir_menu};
1580 $w = $self->{filelist_file_menu};
1586 $event->button, $event->time);
1589 sub context_add_to_filelist
1593 my @sel = listview_get_all($self->{fileview});
1595 foreach my $i (@sel)
1597 my ($file, $jobid, $type, undef) = @{$i};
1598 $file = $self->{cwd} . '/' . $file;
1599 $self->add_selected_file_to_list($file, $jobid, $type);
1603 # Adds a file to the filelist
1604 sub add_selected_file_to_list
1606 my ($self, $name, $jobid, $type)=@_;
1608 my $dbh = $self->{dbh};
1609 my $restore_list = $self->{restore_list};
1611 my $curjobids=join(',', @{$self->{CurrentJobIds}});
1618 if ($name and substr $name,-1 ne '/')
1620 $name .= '/'; # For bacula
1622 my $dirfileindex = get_fileindex_from_dir_jobid($dbh,$name,$jobid);
1623 listview_push($restore_list,
1624 $name, $jobid, 'dir', $curjobids,
1625 $diricon, $name,$jobid,$dirfileindex);
1627 elsif ($type eq 'file')
1629 my $fileindex = get_fileindex_from_file_jobid($dbh,$name,$jobid);
1631 listview_push($restore_list,
1632 $name, $jobid, 'file', $curjobids,
1633 $fileicon, $name, $jobid, $fileindex );
1637 # TODO : we want be able to restore files from a bad ended backup
1638 # we have JobStatus IN ('T', 'A', 'E') and we must
1640 # Data acces subs from here. Interaction with SGBD and caching
1642 # This sub retrieves the list of jobs corresponding to the jobs selected in the
1643 # GUI and stores them in @CurrentJobIds
1644 sub set_job_ids_for_date
1646 my ($dbh, $client, $date, $only_ok)=@_;
1648 if (!$client or !$date) {
1652 my $status = get_wanted_job_status($only_ok);
1654 # The algorithm : for a client, we get all the backups for each
1655 # fileset, in reverse order Then, for each fileset, we store the 'good'
1656 # incrementals and differentials until we have found a full so it goes
1657 # like this : store all incrementals until we have found a differential
1658 # or a full, then find the full #
1660 my $query = "SELECT JobId, FileSet, Level, JobStatus
1661 FROM Job, Client, FileSet
1662 WHERE Job.ClientId = Client.ClientId
1663 AND FileSet.FileSetId = Job.FileSetId
1664 AND EndTime <= '$date'
1665 AND Client.Name = '$client'
1667 AND JobStatus IN ($status)
1668 ORDER BY FileSet, JobTDate DESC";
1670 print $query,"\n" if $debug;
1672 my $result = $dbh->selectall_arrayref($query);
1674 foreach my $refrow (@$result)
1676 my $jobid = $refrow->[0];
1677 my $fileset = $refrow->[1];
1678 my $level = $refrow->[2];
1680 defined $progress{$fileset} or $progress{$fileset}='U'; # U for unknown
1682 next if $progress{$fileset} eq 'F'; # It's over for this fileset...
1686 next unless ($progress{$fileset} eq 'U' or $progress{$fileset} eq 'I');
1687 push @CurrentJobIds,($jobid);
1689 elsif ($level eq 'D')
1691 next if $progress{$fileset} eq 'D'; # We allready have a differential
1692 push @CurrentJobIds,($jobid);
1694 elsif ($level eq 'F')
1696 push @CurrentJobIds,($jobid);
1699 my $status = $refrow->[3] ;
1700 if ($status eq 'T') { # good end of job
1701 $progress{$fileset} = $level;
1704 print Data::Dumper::Dumper(\@CurrentJobIds) if $debug;
1706 return @CurrentJobIds;
1709 # Lists all directories contained inside a directory.
1710 # Uses the current dir, the client name, and CurrentJobIds for visibility.
1711 # Returns an array of dirs
1714 my ($self,$dir,$client)=@_;
1715 print "list_dirs($dir, $client)\n";
1717 # Is data allready cached ?
1718 if (not $self->{dirtree}->{$client})
1720 $self->cache_dirs($client);
1723 if ($dir ne '' and substr $dir,-1 ne '/')
1725 $dir .= '/'; # In the db, there is a / at the end of the dirs ...
1727 # Here, the tree is cached in ram
1728 my @dir = split('/',$dir,-1);
1729 pop @dir; # We don't need the empty trailing element
1731 # We have to get the reference of the hash containing $dir contents
1733 my $refdir=$self->{dirtree}->{$client};
1736 foreach my $subdir (@dir)
1742 $refdir = $refdir->[0]->{$subdir};
1745 # We reached the directory
1748 foreach my $dir (sort(keys %{$refdir->[0]}))
1750 # We return the directory's content : only visible directories
1751 foreach my $jobid (reverse(sort(@{$self->{CurrentJobIds}})))
1753 if (defined $refdir->[0]->{$dir}->[1]->{$jobid})
1755 my $dirname = $refdir->[0]->{$dir}->[2]; # The real dirname...
1756 push @return_list,($dirname);
1757 next DIRLOOP; # No need to waste more CPU cycles...
1761 print "LIST DIR : ", Data::Dumper::Dumper(\@return_list),"\n";
1762 return @return_list;
1766 # List all files in a directory. dir as parameter, CurrentJobIds for visibility
1767 # Returns an array of dirs
1770 my ($self, $dir)=@_;
1771 my $dbh = $self->{dbh};
1775 print "list_files($dir)\n";
1777 if ($dir ne '' and substr $dir,-1 ne '/')
1779 $dir .= '/'; # In the db, there is a / at the end of the dirs ...
1782 my $query = "SELECT Path.PathId FROM Path WHERE Path.Path = '$dir'";
1783 print $query,"\n" if $debug;
1785 my $result = $dbh->selectall_arrayref($query);
1786 foreach my $refrow (@$result)
1788 push @list_pathid,($refrow->[0]);
1791 if (@list_pathid == 0)
1793 print "No pathid found for $dir\n" if $debug;
1797 my $inlistpath = join (',', @list_pathid);
1798 my $inclause = join (',', @{$self->{CurrentJobIds}});
1799 if ($inclause eq '')
1805 "SELECT listfiles.id, listfiles.Name, File.LStat, File.JobId
1807 (SELECT Filename.Name, max(File.FileId) as id
1809 WHERE File.FilenameId = Filename.FilenameId
1810 AND Filename.Name != ''
1811 AND File.PathId IN ($inlistpath)
1812 AND File.JobId IN ($inclause)
1813 GROUP BY Filename.Name
1814 ORDER BY Filename.Name) AS listfiles,
1816 WHERE File.FileId = listfiles.id";
1818 print $query,"\n" if $debug;
1819 $result = $dbh->selectall_arrayref($query);
1826 Gtk2->main_iteration while (Gtk2->events_pending);
1829 # For the dirs, because of the db schema, it's inefficient to get the
1830 # directories contained inside other directories (regexp match or tossing
1831 # lots of records...). So we load all the tree and cache it. The data is
1832 # stored in a structure of this form :
1833 # Each directory is an array.
1834 # - In this array, the first element is a ref to next dir (hash)
1835 # - The second element is a hash containing all jobids pointing
1836 # on an array containing their lstat (or 1 if this jobid is there because
1838 # - The third is the filename itself (it could get mangled because of
1841 # So it looks like this :
1842 # $reftree->[ { 'dir1' => $refdir1
1843 # 'dir2' => $refdir2
1846 # { 'jobid1' => 'lstat1',
1847 # 'jobid2' => 'lstat2',
1848 # 'jobid3' => 1 # This one is here for "visibility"
1853 # Client as a parameter
1854 # Returns an array of dirs
1857 my ($self, $client) = @_;
1858 print "cache_dirs()\n";
1860 $self->{dirtree}->{$client} = []; # reset cache
1861 my $dbh = $self->{dbh};
1863 # TODO : If we get here, things could get lenghty ... draw a popup window .
1864 my $widget = Gtk2::MessageDialog->new($self->{mainwin},
1865 'destroy-with-parent',
1867 'Populating cache');
1870 # We have to build the tree, as it's the first time it is asked...
1873 # First, we only need the jobids of the selected server.
1874 # It's not the same as @CurrentJobIds (we need ALL the jobs)
1875 # We get the JobIds first in order to have the best execution
1876 # plan possible for the big query, with an in clause.
1878 my $status = get_wanted_job_status($self->{pref}->{use_ok_bkp_only});
1882 WHERE Job.ClientId = Client.ClientId
1883 AND Client.Name = '$client'
1884 AND Job.JobStatus IN ($status)
1885 AND Job.Type = 'B'";
1887 print $query,"\n" if $debug;
1888 my $result = $dbh->selectall_arrayref($query);
1892 foreach my $record (@{$result})
1894 push @jobids,($record->[0]);
1896 my $inclause = join(',',@jobids);
1897 if ($inclause eq '')
1900 $self->set_status("No previous backup found for $client");
1904 # Then, still to help dear mysql, we'll retrieve the PathId from empty Path (directory entries...)
1907 "SELECT Filename.FilenameId FROM Filename WHERE Filename.Name=''";
1909 print $query,"\n" if $debug;
1910 $result = $dbh->selectall_arrayref($query);
1913 foreach my $record (@{$result})
1915 push @dirids,$record->[0];
1917 my $dirinclause = join(',',@dirids);
1919 # This query is a bit complicated :
1920 # whe need to find all dir entries that should be displayed, even
1921 # if the directory itself has no entry in File table (it means a file
1922 # is explicitely chosen in the backup configuration)
1923 # Here's what I wanted to do :
1926 # SELECT T1.Path, T2.Lstat, T2.JobId
1927 # FROM ( SELECT DISTINCT Path.PathId, Path.Path FROM File, Path
1928 # WHERE File.PathId = Path.PathId
1929 # AND File.JobId IN ($inclause)) AS T1
1931 # ( SELECT File.Lstat, File.JobId, File.PathId FROM File
1932 # WHERE File.FilenameId IN ($dirinclause)
1933 # AND File.JobId IN ($inclause)) AS T2
1934 # ON (T1.PathId = T2.PathId)
1936 # It works perfectly with postgresql, but mysql doesn't seem to be able
1937 # to do the hash join correcty, so the performance sucks.
1938 # So it will be done in 4 steps :
1939 # o create T1 and T2 as temp tables
1940 # o create an index on T2.PathId
1942 # o remove the temp tables
1944 CREATE TEMPORARY TABLE T1 AS
1945 SELECT DISTINCT Path.PathId, Path.Path FROM File, Path
1946 WHERE File.PathId = Path.PathId
1947 AND File.JobId IN ($inclause)
1949 print $query,"\n" if $debug;
1954 CREATE TEMPORARY TABLE T2 AS
1955 SELECT File.Lstat, File.JobId, File.PathId FROM File
1956 WHERE File.FilenameId IN ($dirinclause)
1957 AND File.JobId IN ($inclause)
1959 print $query,"\n" if $debug;
1964 CREATE INDEX tmp2 ON T2(PathId)
1966 print $query,"\n" if $debug;
1971 SELECT T1.Path, T2.Lstat, T2.JobId
1972 FROM T1 LEFT JOIN T2
1973 ON (T1.PathId = T2.PathId)
1975 print $query,"\n" if $debug;
1976 $result = $dbh->selectall_arrayref($query);
1980 foreach my $record (@{$result})
1982 if ($rcount > 15000) {
1988 # Dirty hack to force the string encoding on perl... we don't
1989 # want implicit conversions
1990 my $path = pack "U0C*", unpack "C*",$record->[0];
1992 my @path = split('/',$path,-1);
1993 pop @path; # we don't need the trailing empty element
1994 my $lstat = $record->[1];
1995 my $jobid = $record->[2];
1997 # We're going to store all the data on the cache tree.
1998 # We find the leaf, then store data there
1999 my $reftree=$self->{dirtree}->{$client};
2000 foreach my $dir(@path)
2006 if (not defined($reftree->[0]->{$dir}))
2009 $reftree->[0]->{$dir}=\@tmparray;
2011 $reftree=$reftree->[0]->{$dir};
2014 # We can now add the metadata for this dir ...
2016 # $result = $dbh->selectall_arrayref($query);
2019 # contains something
2020 $reftree->[1]->{$jobid}=$lstat;
2024 # We have a very special case here...
2025 # lstat is not defined.
2026 # it means the directory is there because a file has been
2027 # backuped. so the dir has no entry in File table.
2028 # That's a rare case, so we can afford to determine it's
2029 # visibility with a query
2030 my $select_path=$record->[0];
2031 $select_path=$dbh->quote($select_path); # gotta be careful
2035 WHERE File.PathId = Path.PathId
2036 AND Path.Path = $select_path
2038 print $query,"\n" if $debug;
2039 my $result2 = $dbh->selectall_arrayref($query);
2040 foreach my $record (@{$result2})
2042 my $jobid=$record->[0];
2043 $reftree->[1]->{$jobid}=1;
2051 print $query,"\n" if $debug;
2056 print $query,"\n" if $debug;
2060 list_visible($self->{dirtree}->{$client});
2063 # print Data::Dumper::Dumper($self->{dirtree});
2066 # Recursive function to calculate the visibility of each directory in the cache
2067 # tree Working with references to save time and memory
2068 # For each directory, we want to propagate it's visible jobids onto it's
2069 # parents directory.
2070 # A tree is visible if
2071 # - it's been in a backup pointed by the CurrentJobIds
2072 # - one of it's subdirs is in a backup pointed by the CurrentJobIds
2073 # In the second case, the directory is visible but has no metadata.
2074 # We symbolize this with lstat = 1 for this jobid in the cache.
2076 # Input : reference directory
2077 # Output : visibility of this dir. Has to know visibility of all subdirs
2078 # to know it's visibility, hence the recursing.
2084 # Get the subdirs array references list
2085 my @list_ref_subdirs;
2086 while( my (undef,$ref_subdir) = each (%{$refdir->[0]}))
2088 push @list_ref_subdirs,($ref_subdir);
2091 # Now lets recurse over these subdirs and retrieve the reference of a hash
2092 # containing the jobs where they are visible
2093 foreach my $ref_subdir (@list_ref_subdirs)
2095 my $ref_list_jobs = list_visible($ref_subdir);
2096 foreach my $jobid (keys %$ref_list_jobs)
2098 $visibility{$jobid}=1;
2102 # Ok. Now, we've got the list of those jobs. We are going to update our
2103 # hash (element 1 of the dir array) containing our jobs Do NOT overwrite
2104 # the lstat for the known jobids. Put 1 in the new elements... But first,
2105 # let's store the current jobids
2107 foreach my $jobid (keys %{$refdir->[1]})
2109 push @known_jobids,($jobid);
2113 foreach my $jobid (keys %visibility)
2115 next if ($refdir->[1]->{$jobid});
2116 $refdir->[1]->{$jobid} = 1;
2118 # Add the known_jobids to %visibility
2119 foreach my $jobid (@known_jobids)
2121 $visibility{$jobid}=1;
2123 return \%visibility;
2126 # Returns the list of media required for a list of jobids.
2127 # Input : dbh, jobid1, jobid2...
2128 # Output : reference to array of (joibd, inchanger)
2129 sub get_required_media_from_jobid
2131 my ($dbh, @jobids)=@_;
2132 my $inclause = join(',',@jobids);
2134 SELECT DISTINCT JobMedia.MediaId, Media.InChanger
2135 FROM JobMedia, Media
2136 WHERE JobMedia.MediaId=Media.MediaId
2137 AND JobId In ($inclause)
2139 my $result = $dbh->selectall_arrayref($query);
2143 # Returns the fileindex from dirname and jobid.
2144 # Input : dbh, dirname, jobid
2145 # Output : fileindex
2146 sub get_fileindex_from_dir_jobid
2148 my ($dbh, $dirname, $jobid)=@_;
2150 $query = "SELECT File.FileIndex
2151 FROM File, Filename, Path
2152 WHERE File.FilenameId = Filename.FilenameId
2153 AND File.PathId = Path.PathId
2154 AND Filename.Name = ''
2155 AND Path.Path = '$dirname'
2156 AND File.JobId = '$jobid'
2159 print $query,"\n" if $debug;
2160 my $result = $dbh->selectall_arrayref($query);
2161 return $result->[0]->[0];
2164 # Returns the fileindex from filename and jobid.
2165 # Input : dbh, filename, jobid
2166 # Output : fileindex
2167 sub get_fileindex_from_file_jobid
2169 my ($dbh, $filename, $jobid)=@_;
2171 my @dirs = File::Spec->splitdir ($filename);
2172 $filename=pop(@dirs);
2173 my $dirname = File::Spec->catdir(@dirs) . '/';
2178 "SELECT File.FileIndex
2179 FROM File, Filename, Path
2180 WHERE File.FilenameId = Filename.FilenameId
2181 AND File.PathId = Path.PathId
2182 AND Filename.Name = '$filename'
2183 AND Path.Path = '$dirname'
2184 AND File.JobId = '$jobid'";
2186 print $query,"\n" if $debug;
2187 my $result = $dbh->selectall_arrayref($query);
2188 return $result->[0]->[0];
2192 # Returns list of versions of a file that could be restored
2193 # returns an array of
2194 # ('FILE:',filename,jobid,fileindex,mtime,size,inchanger,md5,volname)
2195 # It's the same as entries of restore_list (hidden) + mtime and size and inchanger
2196 # and volname and md5
2197 # and of course, there will be only one jobid in the array of jobids...
2198 sub get_all_file_versions
2200 my ($dbh,$path,$file,$client,$see_all)=@_;
2202 defined $see_all or $see_all=0;
2207 "SELECT File.JobId, File.FileIndex, File.Lstat,
2208 File.Md5, Media.VolumeName, Media.InChanger
2209 FROM File, Filename, Path, Job, Client, JobMedia, Media
2210 WHERE File.FilenameId = Filename.FilenameId
2211 AND File.PathId=Path.PathId
2212 AND File.JobId = Job.JobId
2213 AND Job.ClientId = Client.ClientId
2214 AND Job.JobId = JobMedia.JobId
2215 AND File.FileIndex >= JobMedia.FirstIndex
2216 AND File.FileIndex <= JobMedia.LastIndex
2217 AND JobMedia.MediaId = Media.MediaId
2218 AND Path.Path = '$path'
2219 AND Filename.Name = '$file'
2220 AND Client.Name = '$client'";
2222 print $query if $debug;
2224 my $result = $dbh->selectall_arrayref($query);
2226 foreach my $refrow (@$result)
2228 my ($jobid, $fileindex, $lstat, $md5, $volname, $inchanger) = @$refrow;
2229 my @attribs = parse_lstat($lstat);
2230 my $mtime = array_attrib('st_mtime',\@attribs);
2231 my $size = array_attrib('st_size',\@attribs);
2233 my @list = ('FILE:', $path.$file, $jobid, $fileindex, $mtime, $size,
2234 $inchanger, $md5, $volname);
2235 push @versions, (\@list);
2238 # We have the list of all versions of this file.
2239 # We'll sort it by mtime desc, size, md5, inchanger desc
2240 # the rest of the algorithm will be simpler
2241 # ('FILE:',filename,jobid,fileindex,mtime,size,inchanger,md5,volname)
2242 @versions = sort { $b->[4] <=> $a->[4]
2243 || $a->[5] <=> $b->[5]
2244 || $a->[7] cmp $a->[7]
2245 || $b->[6] <=> $a->[6]} @versions;
2248 my %allready_seen_by_mtime;
2249 my %allready_seen_by_md5;
2250 # Now we should create a new array with only the interesting records
2251 foreach my $ref (@versions)
2255 # The file has a md5. We compare his md5 to other known md5...
2256 # We take size into account. It may happen that 2 files
2257 # have the same md5sum and are different. size is a supplementary
2260 # If we allready have a (better) version
2261 next if ( (not $see_all)
2262 and $allready_seen_by_md5{$ref->[7] .'-'. $ref->[5]});
2264 # we never met this one before...
2265 $allready_seen_by_md5{$ref->[7] .'-'. $ref->[5]}=1;
2267 # Even if it has a md5, we should also work with mtimes
2268 # We allready have a (better) version
2269 next if ( (not $see_all)
2270 and $allready_seen_by_mtime{$ref->[4] .'-'. $ref->[5]});
2271 $allready_seen_by_mtime{$ref->[4] .'-'. $ref->[5] . '-' . $ref->[7]}=1;
2273 # We reached there. The file hasn't been seen.
2274 push @good_versions,($ref);
2277 # To be nice with the user, we re-sort good_versions by
2278 # inchanger desc, mtime desc
2279 @good_versions = sort { $b->[4] <=> $a->[4]
2280 || $b->[2] <=> $a->[2]} @good_versions;
2282 return @good_versions;
2285 # TODO : bsr must use only good backup or not (see use_ok_bkp_only)
2286 # This sub creates a BSR from the information in the restore_list
2287 # Returns the BSR as a string
2291 my $dbh = $self->{dbh};
2293 # This query gets all jobid/jobmedia/media combination.
2295 SELECT Job.JobId, Job.VolsessionId, Job.VolsessionTime, JobMedia.StartFile,
2296 JobMedia.EndFile, JobMedia.FirstIndex, JobMedia.LastIndex,
2297 JobMedia.StartBlock, JobMedia.EndBlock, JobMedia.VolIndex,
2298 Media.Volumename, Media.MediaType
2299 FROM Job, JobMedia, Media
2300 WHERE Job.JobId = JobMedia.JobId
2301 AND JobMedia.MediaId = Media.MediaId
2302 ORDER BY JobMedia.FirstIndex, JobMedia.LastIndex";
2305 my $result = $dbh->selectall_arrayref($query);
2307 # We will store everything hashed by jobid.
2309 foreach my $refrow (@$result)
2311 my ($jobid, $volsessionid, $volsessiontime, $startfile, $endfile,
2312 $firstindex, $lastindex, $startblock, $endblock,
2313 $volindex, $volumename, $mediatype) = @{$refrow};
2315 # We just have to deal with the case where starfile != endfile
2316 # In this case, we concatenate both, for the bsr
2317 if ($startfile != $endfile) {
2318 $startfile = $startfile . '-' . $endfile;
2322 ($jobid, $volsessionid, $volsessiontime, $startfile,
2323 $firstindex, $lastindex, $startblock .'-'. $endblock,
2324 $volindex, $volumename, $mediatype);
2326 push @{$mediainfos{$refrow->[0]}},(\@tmparray);
2330 # reminder : restore_list looks like this :
2331 # ($name,$jobid,'file',$curjobids, undef, undef, undef, $dirfileindex);
2333 # Here, we retrieve every file/dir that could be in the restore
2334 # We do as simple as possible for the SQL engine (no crazy joins,
2335 # no pseudo join (>= FirstIndex ...), etc ...
2336 # We do a SQL union of all the files/dirs specified in the restore_list
2338 foreach my $entry (@{$self->{restore_list}->{data}})
2340 if ($entry->[2] eq 'dir')
2342 my $dir = unpack('u', $entry->[0]);
2343 my $inclause = $entry->[3]; #curjobids
2346 "(SELECT Path.Path, Filename.Name, File.FileIndex, File.JobId
2347 FROM File, Path, Filename
2348 WHERE Path.PathId = File.PathId
2349 AND File.FilenameId = Filename.FilenameId
2350 AND Path.Path LIKE '$dir%'
2351 AND File.JobId IN ($inclause) )";
2352 push @select_queries,($query);
2356 # It's a file. Great, we allready have most
2357 # of what is needed. Simple and efficient query
2358 my $file = unpack('u', $entry->[0]);
2359 my @file = split '/',$file;
2361 my $dir = join('/',@file);
2363 my $jobid = $entry->[1];
2364 my $fileindex = $entry->[7];
2365 my $inclause = $entry->[3]; # curjobids
2367 "(SELECT Path.Path, Filename.Name, File.FileIndex, File.JobId
2368 FROM File, Path, Filename
2369 WHERE Path.PathId = File.PathId
2370 AND File.FilenameId = Filename.FilenameId
2371 AND Path.Path = '$dir/'
2372 AND Filename.Name = '$file'
2373 AND File.JobId = $jobid)";
2374 push @select_queries,($query);
2377 $query = join("\nUNION ALL\n",@select_queries) . "\nORDER BY FileIndex\n";
2379 print $query,"\n" if $debug;
2381 #Now we run the query and parse the result...
2382 # there may be a lot of records, so we better be efficient
2383 # We use the bind column method, working with references...
2385 my $sth = $dbh->prepare($query);
2388 my ($path,$name,$fileindex,$jobid);
2389 $sth->bind_columns(\$path,\$name,\$fileindex,\$jobid);
2391 # The temp place we're going to save all file
2392 # list to before the real list
2396 while ($sth->fetchrow_arrayref())
2398 # This may look dumb, but we're going to do a join by ourselves,
2399 # to save memory and avoid sending a complex query to mysql
2400 my $complete_path = $path . $name;
2408 # Remove trailing slash (normalize file and dir name)
2409 $complete_path =~ s/\/$//;
2411 # Let's find the ref(s) for the %mediainfo element(s)
2412 # containing the data for this file
2413 # There can be several matches. It is the pseudo join.
2415 my $max_elt=@{$mediainfos{$jobid}}-1;
2417 while($med_idx <= $max_elt)
2419 my $ref = $mediainfos{$jobid}->[$med_idx];
2420 # First, can we get rid of the first elements of the
2421 # array ? (if they don't contain valuable records
2423 if ($fileindex > $ref->[5])
2425 # It seems we don't need anymore
2426 # this entry in %mediainfo (the input data
2429 shift @{$mediainfos{$jobid}};
2433 # We will do work on this elt. We can ++
2434 # $med_idx for next loop
2437 # %mediainfo row looks like :
2438 # (jobid,VolsessionId,VolsessionTime,File,FirstIndex,
2439 # LastIndex,StartBlock-EndBlock,VolIndex,Volumename,
2442 # We are in range. We store and continue looping
2444 if ($fileindex >= $ref->[4])
2446 my @data = ($complete_path,$is_dir,
2448 push @temp_list,(\@data);
2452 # We are not in range. No point in continuing looping
2453 # We go to next record.
2457 # Now we have the array.
2458 # We're going to sort it, by
2459 # path, volsessiontime DESC (get the most recent file...)
2460 # The array rows look like this :
2461 # complete_path,is_dir,fileindex,
2462 # ref->(jobid,VolsessionId,VolsessionTime,File,FirstIndex,
2463 # LastIndex,StartBlock-EndBlock,VolIndex,Volumename,MediaType)
2464 @temp_list = sort {$a->[0] cmp $b->[0]
2465 || $b->[3]->[2] <=> $a->[3]->[2]
2469 my $prev_complete_path='////'; # Sure not to match
2473 while (my $refrow = shift @temp_list)
2475 # For the sake of readability, we load $refrow
2476 # contents in real scalars
2477 my ($complete_path, $is_dir, $fileindex, $refother)=@{$refrow};
2478 my $jobid= $refother->[0]; # We don't need the rest...
2480 # We skip this entry.
2481 # We allready have a newer one and this
2482 # isn't a continuation of the same file
2483 next if ($complete_path eq $prev_complete_path
2484 and $jobid != $prev_jobid);
2488 and $complete_path =~ m|^\Q$prev_complete_path\E/|)
2490 # We would be recursing inside a file.
2491 # Just what we don't want (dir replaced by file
2492 # between two backups
2498 push @restore_list,($refrow);
2500 $prev_complete_path = $complete_path;
2501 $prev_jobid = $jobid;
2507 push @restore_list,($refrow);
2509 $prev_complete_path = $complete_path;
2510 $prev_jobid = $jobid;
2514 # We get rid of @temp_list... save memory
2517 # Ok everything is in the list. Let's sort it again in another way.
2518 # This time it will be in the bsr file order
2520 # we sort the results by
2521 # volsessiontime, volsessionid, volindex, fileindex
2522 # to get all files in right order...
2523 # Reminder : The array rows look like this :
2524 # complete_path,is_dir,fileindex,
2525 # ref->(jobid,VolsessionId,VolsessionTime,File,FirstIndex,LastIndex,
2526 # StartBlock-EndBlock,VolIndex,Volumename,MediaType)
2528 @restore_list= sort { $a->[3]->[2] <=> $b->[3]->[2]
2529 || $a->[3]->[1] <=> $b->[3]->[1]
2530 || $a->[3]->[7] <=> $b->[3]->[7]
2531 || $a->[2] <=> $b->[2] }
2534 # Now that everything is ready, we create the bsr
2535 my $prev_fileindex=-1;
2536 my $prev_volsessionid=-1;
2537 my $prev_volsessiontime=-1;
2538 my $prev_volumename=-1;
2539 my $prev_volfile=-1;
2543 my $first_of_current_range=0;
2544 my @fileindex_ranges;
2547 foreach my $refrow (@restore_list)
2549 my (undef,undef,$fileindex,$refother)=@{$refrow};
2550 my (undef,$volsessionid,$volsessiontime,$volfile,undef,undef,
2551 $volblocks,undef,$volumename,$mediatype)=@{$refother};
2553 # We can specifiy the number of files in each section of the
2554 # bsr to speedup restore (bacula can then jump over the
2555 # end of tape files.
2559 if ($prev_volumename eq '-1')
2561 # We only have to start the new range...
2562 $first_of_current_range=$fileindex;
2564 elsif ($prev_volsessionid != $volsessionid
2565 or $prev_volsessiontime != $volsessiontime
2566 or $prev_volumename ne $volumename
2567 or $prev_volfile ne $volfile)
2569 # We have to create a new section in the bsr...
2570 # We print the previous one ...
2571 # (before that, save the current range ...)
2572 if ($first_of_current_range != $prev_fileindex)
2575 push @fileindex_ranges,
2576 ("$first_of_current_range-$prev_fileindex");
2580 # We are out of a range,
2581 # but there is only one element in the range
2582 push @fileindex_ranges,
2583 ("$first_of_current_range");
2586 $bsr.=print_bsr_section(\@fileindex_ranges,
2588 $prev_volsessiontime,
2595 # Reset for next loop
2596 @fileindex_ranges=();
2597 $first_of_current_range=$fileindex;
2599 elsif ($fileindex-1 != $prev_fileindex)
2601 # End of a range of fileindexes
2602 if ($first_of_current_range != $prev_fileindex)
2605 push @fileindex_ranges,
2606 ("$first_of_current_range-$prev_fileindex");
2610 # We are out of a range,
2611 # but there is only one element in the range
2612 push @fileindex_ranges,
2613 ("$first_of_current_range");
2615 $first_of_current_range=$fileindex;
2617 $prev_fileindex=$fileindex;
2618 $prev_volsessionid = $volsessionid;
2619 $prev_volsessiontime = $volsessiontime;
2620 $prev_volumename = $volumename;
2621 $prev_volfile=$volfile;
2622 $prev_mediatype=$mediatype;
2623 $prev_volblocks=$volblocks;
2627 # Ok, we're out of the loop. Alas, there's still the last record ...
2628 if ($first_of_current_range != $prev_fileindex)
2631 push @fileindex_ranges,("$first_of_current_range-$prev_fileindex");
2636 # We are out of a range,
2637 # but there is only one element in the range
2638 push @fileindex_ranges,("$first_of_current_range");
2641 $bsr.=print_bsr_section(\@fileindex_ranges,
2643 $prev_volsessiontime,
2653 sub print_bsr_section
2655 my ($ref_fileindex_ranges,$volsessionid,
2656 $volsessiontime,$volumename,$volfile,
2657 $mediatype,$volblocks,$count)=@_;
2660 $bsr .= "Volume=\"$volumename\"\n";
2661 $bsr .= "MediaType=\"$mediatype\"\n";
2662 $bsr .= "VolSessionId=$volsessionid\n";
2663 $bsr .= "VolSessionTime=$volsessiontime\n";
2664 $bsr .= "VolFile=$volfile\n";
2665 $bsr .= "VolBlock=$volblocks\n";
2667 foreach my $range (@{$ref_fileindex_ranges})
2669 $bsr .= "FileIndex=$range\n";
2672 $bsr .= "Count=$count\n";
2676 # This function estimates the size to be restored for an entry of the restore
2678 # In : self,reference to the entry
2679 # Out : size in bytes, number of files
2680 sub estimate_restore_size
2682 # reminder : restore_list looks like this :
2683 # ($name,$jobid,'file',$curjobids, undef, undef, undef, $dirfileindex);
2687 my $dbh = $self->{dbh};
2688 if ($entry->[2] eq 'dir')
2690 my $dir = unpack('u', $entry->[0]);
2691 my $inclause = $entry->[3]; #curjobids
2693 "SELECT Path.Path, File.FilenameId, File.LStat
2694 FROM File, Path, Job
2695 WHERE Path.PathId = File.PathId
2696 AND File.JobId = Job.JobId
2697 AND Path.Path LIKE '$dir%'
2698 AND File.JobId IN ($inclause)
2699 ORDER BY Path.Path, File.FilenameId, Job.StartTime DESC";
2703 # It's a file. Great, we allready have most
2704 # of what is needed. Simple and efficient query
2705 my $file = unpack('u', $entry->[0]);
2706 my @file = split '/',$file;
2708 my $dir = join('/',@file);
2710 my $jobid = $entry->[1];
2711 my $fileindex = $entry->[7];
2712 my $inclause = $entry->[3]; # curjobids
2714 "SELECT Path.Path, File.FilenameId, File.Lstat
2715 FROM File, Path, Filename
2716 WHERE Path.PathId = File.PathId
2717 AND Path.Path = '$dir/'
2718 AND Filename.Name = '$file'
2719 AND File.JobId = $jobid
2720 AND Filename.FilenameId = File.FilenameId";
2723 print $query,"\n" if $debug;
2724 my ($path,$nameid,$lstat);
2725 my $sth = $dbh->prepare($query);
2727 $sth->bind_columns(\$path,\$nameid,\$lstat);
2737 while ($sth->fetchrow_arrayref())
2739 # Only the latest version of a file
2740 next if ($nameid eq $old_nameid and $path eq $old_path);
2742 if ($rcount > 15000) {
2749 # We get the size of this file
2750 my $size=lstat_attrib($lstat,'st_size');
2751 $total_size += $size;
2754 $old_nameid=$nameid;
2756 return ($total_size,$total_files);
2762 my %attrib_name_id = ( 'st_dev' => 0,'st_ino' => 1,'st_mode' => 2,
2763 'st_nlink' => 3,'st_uid' => 4,'st_gid' => 5,
2764 'st_rdev' => 6,'st_size' => 7,'st_blksize' => 8,
2765 'st_blocks' => 9,'st_atime' => 10,'st_mtime' => 11,
2766 'st_ctime' => 12,'LinkFI' => 13,'st_flags' => 14,
2767 'data_stream' => 15);;
2770 my ($attrib,$ref_attrib)=@_;
2771 return $ref_attrib->[$attrib_name_id{$attrib}];
2775 { # $file = [listfiles.id, listfiles.Name, File.LStat, File.JobId]
2777 my ($file, $attrib)=@_;
2779 if (defined $attrib_name_id{$attrib}) {
2781 my @d = split(' ', $file->[2]) ; # TODO : cache this
2783 return from_base64($d[$attrib_name_id{$attrib}]);
2785 } elsif ($attrib eq 'jobid') {
2789 } elsif ($attrib eq 'name') {
2794 die "Attribute not known : $attrib.\n";
2798 # Return the jobid or attribute asked for a dir
2801 my ($self,$dir,$attrib)=@_;
2803 my @dir = split('/',$dir,-1);
2804 my $refdir=$self->{dirtree}->{$self->current_client};
2806 if (not defined $attrib_name_id{$attrib} and $attrib ne 'jobid')
2808 die "Attribute not known : $attrib.\n";
2811 foreach my $subdir (@dir)
2813 $refdir = $refdir->[0]->{$subdir};
2816 # $refdir is now the reference to the dir's array
2817 # Is the a jobid in @CurrentJobIds where the lstat is
2818 # defined (we'll search in reverse order)
2819 foreach my $jobid (reverse(sort {$a <=> $b } @{$self->{CurrentJobIds}}))
2821 if (defined $refdir->[1]->{$jobid} and $refdir->[1]->{$jobid} ne '1')
2823 if ($attrib eq 'jobid')
2829 my @attribs = parse_lstat($refdir->[1]->{$jobid});
2830 return $attribs[$attrib_name_id{$attrib}+1];
2835 return 0; # We cannot get a good attribute.
2836 # This directory is here for the sake of visibility
2841 my ($lstat,$attrib)=@_;
2842 if (defined $attrib_name_id{$attrib})
2844 my @d = split(' ', $lstat) ; # TODO : cache this
2845 return from_base64($d[$attrib_name_id{$attrib}]);
2851 # Base 64 functions, directly from recover.pl.
2853 # Karl Hakimian <hakimian@aha.com>
2854 # This section is also under GPL v2 or later.
2861 'A', 'B', 'C', 'D', 'E', 'F', 'G', 'H', 'I', 'J', 'K', 'L', 'M',
2862 'N', 'O', 'P', 'Q', 'R', 'S', 'T', 'U', 'V', 'W', 'X', 'Y', 'Z',
2863 'a', 'b', 'c', 'd', 'e', 'f', 'g', 'h', 'i', 'j', 'k', 'l', 'm',
2864 'n', 'o', 'p', 'q', 'r', 's', 't', 'u', 'v', 'w', 'x', 'y', 'z',
2865 '0', '1', '2', '3', '4', '5', '6', '7', '8', '9', '+', '/'
2867 @base64_map = (0) x 128;
2869 for (my $i=0; $i<64; $i++) {
2870 $base64_map[ord($base64_digits[$i])] = $i;
2885 if (substr($where, 0, 1) eq '-') {
2887 $where = substr($where, 1);
2890 while ($where ne '') {
2892 my $d = substr($where, 0, 1);
2893 $val += $base64_map[ord(substr($where, 0, 1))];
2894 $where = substr($where, 1);
2902 my @attribs = split(' ',$lstat);
2903 foreach my $element (@attribs)
2905 $element = from_base64($element);
2912 ################################################################
2916 my $conf = "$ENV{HOME}/.brestore.conf" ;
2917 my $p = new Pref($conf);
2923 $glade_file = $p->{glade_file};
2925 foreach my $path ('','.','/usr/share/brestore','/usr/local/share/brestore') {
2926 if (-f "$path/$glade_file") {
2927 $glade_file = "$path/$glade_file" ;
2932 if ( -f $glade_file) {
2933 my $w = new DlgResto($p);
2936 my $widget = Gtk2::MessageDialog->new(undef, 'modal', 'error', 'close',
2937 "Can't find your brestore.glade (glade_file => '$glade_file')
2938 Please, edit your $conf to setup it." );
2940 $widget->signal_connect('destroy', sub { Gtk2->main_quit() ; });
2945 Gtk2->main; # Start Gtk2 main loop
2957 # Code pour trier les colonnes
2958 my $mod = $fileview->get_model();
2959 $mod->set_default_sort_func(sub {
2960 my ($model, $item1, $item2) = @_;
2961 my $a = $model->get($item1, 1); # récupération de la valeur de la 2ème
2962 my $b = $model->get($item2, 1); # colonne (indice 1)
2967 $fileview->set_headers_clickable(1);
2968 my $col = $fileview->get_column(1); # la colonne NOM, colonne numéro 2
2969 $col->signal_connect('clicked', sub {
2970 my ($colonne, $model) = @_;
2971 $model->set_sort_column_id (1, 'ascending');