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,
125 my (undef,$fn,$jobid,$fileindex,$mtime,$size,$inchanger,$md5,$volname)
127 my $icon = ($inchanger)?$DlgResto::yesicon:$DlgResto::noicon;
129 DlgResto::listview_push($fileview,
130 $file, $jobid, 'file',
131 $icon, $volname, $jobid, $size,
132 scalar(localtime($mtime)), $md5);
135 $self->{version} = $glade_box->get_widget('dlg_version');
136 $self->{version}->show();
141 ################################################################
146 my ($package, $text) = @_;
150 my $glade = Gtk2::GladeXML->new($glade_file, "dlg_warn");
152 # Connect signals magically
153 $glade->signal_autoconnect_from_package($self);
154 $glade->get_widget('label_warn')->set_text($text);
158 $self->{window} = $glade->get_widget('dlg_warn');
159 $self->{window}->show_all();
166 $self->{window}->destroy();
170 ################################################################
176 # %arg = (bsr_file => '/path/to/bsr', # on director
177 # volumes => [ '00001', '00004']
183 my ($class, %arg) = @_;
186 bsr_file => $arg{bsr_file}, # /path/to/bsr on director
187 pref => $arg{pref}, # Pref ref
188 glade => undef, # GladeXML ref
189 bconsole => undef, # Bconsole ref
192 # we load launch widget of $glade_file
193 my $glade = $self->{glade} = Gtk2::GladeXML->new($glade_file,
196 # Connect signals magically
197 $glade->signal_autoconnect_from_package($self);
199 my $widget = $glade->get_widget('volumeview');
200 my $volview = Gtk2::SimpleList->new_from_treeview(
202 'InChanger' => 'pixbuf',
206 my $infos = get_volume_inchanger($arg{pref}->{dbh}, $arg{volumes}) ;
208 # we replace 0 and 1 by $noicon and $yesicon
209 for my $i (@{$infos}) {
211 $i->[0] = $DlgResto::noicon;
213 $i->[0] = $DlgResto::yesicon;
218 push @{ $volview->{data} }, @{$infos} ;
220 my $console = $self->{bconsole} = new Bconsole(pref => $arg{pref});
222 # fill client combobox (with director defined clients
223 my @clients = $console->list_client() ; # get from bconsole
224 if ($console->{error}) {
225 new DlgWarn("Can't use bconsole:\n$arg{pref}->{bconsole}: $console->{error}") ;
227 my $w = $self->{combo_client} = $glade->get_widget('combo_launch_client') ;
228 $self->{list_client} = DlgResto::init_combo($w, 'text');
229 DlgResto::fill_combo($self->{list_client},
230 $DlgResto::client_list_empty,
234 # fill fileset combobox
235 my @fileset = $console->list_fileset() ;
236 $w = $self->{combo_fileset} = $glade->get_widget('combo_launch_fileset') ;
237 $self->{list_fileset} = DlgResto::init_combo($w, 'text');
238 DlgResto::fill_combo($self->{list_fileset}, '', @fileset);
241 my @job = $console->list_job() ;
242 $w = $self->{combo_job} = $glade->get_widget('combo_launch_job') ;
243 $self->{list_job} = DlgResto::init_combo($w, 'text');
244 DlgResto::fill_combo($self->{list_job}, '', @job);
246 # find default_restore_job in jobs list
247 my $default_restore_job = $arg{pref}->{default_restore_job} ;
251 if ($j =~ /$default_restore_job/io) {
257 $w->set_active($index);
259 # fill storage combobox
260 my @storage = $console->list_storage() ;
261 $w = $self->{combo_storage} = $glade->get_widget('combo_launch_storage') ;
262 $self->{list_storage} = DlgResto::init_combo($w, 'text');
263 DlgResto::fill_combo($self->{list_storage}, '', @storage);
265 $glade->get_widget('dlg_launch')->show_all();
272 my ($self, $client, $jobid) = @_;
274 $self->{pref}->go_bweb("?action=dsp_cur_job;jobid=$jobid;client=$client", "view job status");
275 $self->on_cancel_resto_clicked();
278 sub on_cancel_resto_clicked
281 $self->{glade}->get_widget('dlg_launch')->destroy();
284 sub on_submit_resto_clicked
287 my $glade = $self->{glade};
289 my $r = $self->copy_bsr($self->{bsr_file}, $self->{pref}->{bsr_dest}) ;
292 new DlgWarn("Can't copy bsr file to director ($self->{error})");
296 my $fileset = $glade->get_widget('combo_launch_fileset')
299 my $storage = $glade->get_widget('combo_launch_storage')
302 my $where = $glade->get_widget('entry_launch_where')->get_text();
304 my $job = $glade->get_widget('combo_launch_job')
308 new DlgWarn("Can't use this job");
312 my $client = $glade->get_widget('combo_launch_client')
315 if (! $client or $client eq $DlgResto::client_list_empty) {
316 new DlgWarn("Can't use this client ($client)");
320 my $prio = $glade->get_widget('spin_launch_priority')->get_value();
322 my $replace = $glade->get_widget('chkbp_launch_replace')->get_active();
323 $replace=($replace)?'always':'never';
325 my $jobid = $self->{bconsole}->run(job => $job,
334 $self->show_job($client, $jobid);
337 sub on_combo_storage_button_press_event
340 print "on_combo_storage_button_press_event()\n";
343 sub on_combo_fileset_button_press_event
346 print "on_combo_fileset_button_press_event()\n";
350 sub on_combo_job_button_press_event
353 print "on_combo_job_button_press_event()\n";
356 sub get_volume_inchanger
358 my ($dbh, $vols) = @_;
360 my $lst = join(',', map { $dbh->quote($_) } @{ $vols } ) ;
362 my $rq = "SELECT InChanger, VolumeName
364 WHERE VolumeName IN ($lst)
367 my $res = $dbh->selectall_arrayref($rq);
368 return $res; # [ [ 1, VolName].. ]
372 use File::Copy qw/copy/;
373 use File::Basename qw/basename/;
375 # We must kown the path+filename destination
376 # $self->{error} contains error message
377 # it return 0/1 if fail/success
380 my ($self, $src, $dst) = @_ ;
381 print "$src => $dst\n"
388 if ($dst =~ m!file:/(/.+)!) {
389 $ret = copy($src, $1);
391 $dstfile = "$1/" . basename($src) ;
393 } elsif ($dst =~ m!scp://([^:]+:(.+))!) {
394 $err = `scp $src $1 2>&1` ;
396 $dstfile = "$2/" . basename($src) ;
400 $err = "$dst not implemented yet";
401 File::Copy::copy($src, \*STDOUT);
404 $self->{error} = $err;
407 $self->{error} = $err;
416 ################################################################
424 unless ($about_widget) {
425 my $glade_box = Gtk2::GladeXML->new($glade_file, "dlg_about") ;
426 $about_widget = $glade_box->get_widget("dlg_about") ;
427 $glade_box->signal_autoconnect_from_package('DlgAbout');
429 $about_widget->show() ;
432 sub on_about_okbutton_clicked
434 $about_widget->hide() ;
439 ################################################################
445 my ($class, $config_file) = @_;
448 config_file => $config_file,
449 password => '', # db passwd
450 username => '', # db username
451 connection_string => '',# db connection string
452 bconsole => 'bconsole', # path and arg to bconsole
453 bsr_dest => '', # destination url for bsr files
454 debug => 0, # debug level 0|1
455 use_ok_bkp_only => 1, # dont use bad backup
456 bweb => 'http://localhost/cgi-bin/bweb/bweb.pl', # bweb url
457 glade_file => $glade_file,
458 mozilla => 'mozilla', # mozilla bin
459 default_restore_job => 'restore', # regular expression to select default
462 # keywords that are used to fill DlgPref
463 chk_keyword => [ qw/use_ok_bkp_only debug/ ],
464 entry_keyword => [ qw/username password bweb mozilla
465 connection_string default_restore_job
466 bconsole bsr_dest glade_file/],
469 $self->read_config();
478 # We read the parameters. They come from the configuration files
479 my $cfgfile ; my $tmpbuffer;
480 if (open FICCFG, $self->{config_file})
482 while(read FICCFG,$tmpbuffer,4096)
484 $cfgfile .= $tmpbuffer;
488 no strict; # I have no idea of the contents of the file
489 eval '$refparams' . " = $cfgfile";
492 for my $p (keys %{$refparams}) {
493 $self->{$p} = $refparams->{$p};
496 if (defined $self->{debug}) {
497 $debug = $self->{debug} ;
500 # TODO : Force dumb default values and display a message
510 for my $k (@{ $self->{entry_keyword} }) {
511 $parameters{$k} = $self->{$k};
514 for my $k (@{ $self->{chk_keyword} }) {
515 $parameters{$k} = $self->{$k};
518 if (open FICCFG,">$self->{config_file}")
520 print FICCFG Data::Dumper->Dump([\%parameters], [qw($parameters)]);
525 # TODO : Display a message
534 $self->{dbh}->disconnect() ;
538 delete $self->{error};
540 if (not $self->{connection_string})
542 # The parameters have not been set. Maybe the conf
543 # file is empty for now
544 $self->{error} = "No configuration found for database connection. " .
545 "Please set this up.";
550 $self->{dbh} = DBI->connect($self->{connection_string},
555 $self->{error} = "Can't open bacula database. " .
556 "Database connect string '" .
557 $self->{connection_string} ."' $!";
560 $self->{dbh}->{RowCacheSize}=100;
566 my ($self, $url, $msg) = @_;
568 unless ($self->{mozilla} and $self->{bweb}) {
569 new DlgWarn("You must install Bweb and set your mozilla bin to $msg");
573 system("$self->{mozilla} -remote 'Ping()'");
575 new DlgWarn("Warning, you must have a running $self->{mozilla} to $msg");
579 my $cmd = "$self->{mozilla} -remote 'OpenURL($self->{bweb}$url,new-tab)'" ;
587 ################################################################
591 # my $pref = new Pref(config_file => 'brestore.conf');
592 # my $dlg = new DlgPref($pref);
593 # my $dlg_resto = new DlgResto($pref);
594 # $dlg->display($dlg_resto);
597 my ($class, $pref) = @_;
600 pref => $pref, # Pref ref
601 dlgresto => undef, # DlgResto ref
609 my ($self, $dlgresto) = @_ ;
611 unless ($self->{glade}) {
612 $self->{glade} = Gtk2::GladeXML->new($glade_file, "dlg_pref") ;
613 $self->{glade}->signal_autoconnect_from_package($self);
616 $self->{dlgresto} = $dlgresto;
618 my $g = $self->{glade};
619 my $p = $self->{pref};
621 for my $k (@{ $p->{entry_keyword} }) {
622 $g->get_widget("entry_$k")->set_text($p->{$k}) ;
625 for my $k (@{ $p->{chk_keyword} }) {
626 $g->get_widget("chkbp_$k")->set_active($p->{$k}) ;
629 $g->get_widget("dlg_pref")->show_all() ;
632 sub on_applybutton_clicked
635 my $glade = $self->{glade};
636 my $pref = $self->{pref};
638 for my $k (@{ $pref->{entry_keyword} }) {
639 my $w = $glade->get_widget("entry_$k") ;
640 $pref->{$k} = $w->get_text();
643 for my $k (@{ $pref->{chk_keyword} }) {
644 my $w = $glade->get_widget("chkbp_$k") ;
645 $pref->{$k} = $w->get_active();
648 $pref->write_config();
649 if ($pref->connect_db()) {
650 $self->{dlgresto}->set_dbh($pref->{dbh});
651 $self->{dlgresto}->set_status('Preferences updated');
652 $self->{dlgresto}->init_server_backup_combobox();
654 $self->{dlgresto}->set_status($pref->{error});
658 # Handle prefs ok click (apply/dismiss dialog)
659 sub on_okbutton_clicked
662 $self->on_applybutton_clicked();
664 unless ($self->{pref}->{error}) {
665 $self->on_cancelbutton_clicked();
668 sub on_dialog_delete_event
671 $self->on_cancelbutton_clicked();
675 sub on_cancelbutton_clicked
678 $self->{glade}->get_widget('dlg_pref')->hide();
679 delete $self->{dlgresto};
683 ################################################################
693 # Kept as is from the perl-gtk example. Draws the pretty icons
699 $diricon = $self->{mainwin}->render_icon('gtk-open', $size);
700 $fileicon = $self->{mainwin}->render_icon('gtk-new', $size);
701 $yesicon = $self->{mainwin}->render_icon('gtk-yes', $size);
702 $noicon = $self->{mainwin}->render_icon('gtk-no', $size);
706 # init combo (and create ListStore object)
709 my ($widget, @type) = @_ ;
710 my %type_info = ('text' => 'Glib::String',
711 'markup' => 'Glib::String',
714 my $lst = new Gtk2::ListStore ( map { $type_info{$_} } @type );
716 $widget->set_model($lst);
720 if ($t eq 'text' or $t eq 'markup') {
721 $cell = new Gtk2::CellRendererText();
723 $widget->pack_start($cell, 1);
724 $widget->add_attribute($cell, $t, $i++);
729 # fill simple combo (one element per row)
732 my ($list, @what) = @_;
736 foreach my $w (@what)
739 my $i = $list->append();
740 $list->set($i, 0, $w);
747 my @unit = qw(b Kb Mb Gb Tb);
750 my $format = '%i %s';
751 while ($val / 1024 > 1) {
755 $format = ($i>0)?'%0.1f %s':'%i %s';
756 return sprintf($format, $val, $unit[$i]);
761 my ($self, $dbh) = @_;
767 my ($fileview) = shift;
768 my $fileview_target_entry = {target => 'STRING',
769 flags => ['GTK_TARGET_SAME_APP'],
772 $fileview->enable_model_drag_source(['button1_mask', 'button3_mask'],
773 ['copy'],$fileview_target_entry);
774 $fileview->get_selection->set_mode('multiple');
776 # set some useful SimpleList properties
777 $fileview->set_headers_clickable(0);
778 foreach ($fileview->get_columns())
780 $_->set_resizable(1);
781 $_->set_sizing('grow-only');
787 my ($class, $pref) = @_;
792 location => undef, # location entry widget
793 mainwin => undef, # mainwin widget
794 filelist_file_menu => undef, # file menu widget
795 filelist_dir_menu => undef, # dir menu widget
796 glade => undef, # glade object
797 status => undef, # status bar widget
798 dlg_pref => undef, # DlgPref object
799 fileattrib => {}, # cache file
800 fileview => undef, # fileview widget SimpleList
801 fileinfo => undef, # fileinfo widget SimpleList
803 client_combobox => undef, # client_combobox widget
804 restore_backup_combobox => undef, # date combobox widget
805 list_client => undef, # Gtk2::ListStore
806 list_backup => undef, # Gtk2::ListStore
809 # load menu (to use handler with self reference)
810 my $glade = Gtk2::GladeXML->new($glade_file, "filelist_file_menu");
811 $glade->signal_autoconnect_from_package($self);
812 $self->{filelist_file_menu} = $glade->get_widget("filelist_file_menu");
814 $glade = Gtk2::GladeXML->new($glade_file, "filelist_dir_menu");
815 $glade->signal_autoconnect_from_package($self);
816 $self->{filelist_dir_menu} = $glade->get_widget("filelist_dir_menu");
818 $glade = $self->{glade} = Gtk2::GladeXML->new($glade_file, "dlg_resto");
819 $glade->signal_autoconnect_from_package($self);
821 $self->{status} = $glade->get_widget('statusbar');
822 $self->{mainwin} = $glade->get_widget('dlg_resto');
823 $self->{location} = $glade->get_widget('entry_location');
824 $self->render_icons();
826 $self->{dlg_pref} = new DlgPref($pref);
828 my $c = $self->{client_combobox} = $glade->get_widget('combo_client');
829 $self->{list_client} = init_combo($c, 'text');
831 $c = $self->{restore_backup_combobox} = $glade->get_widget('combo_list_backups');
832 $self->{list_backup} = init_combo($c, 'text', 'markup');
834 # Connect glade-fileview to Gtk2::SimpleList
835 # and set up drag n drop between $fileview and $restore_list
837 # WARNING : we have big dirty thinks with gtk/perl and utf8/iso strings
838 # we use an hidden field uuencoded to bypass theses bugs (h_name)
840 my $widget = $glade->get_widget('fileview');
841 my $fileview = $self->{fileview} = Gtk2::SimpleList->new_from_treeview(
843 'h_name' => 'hidden',
844 'h_jobid' => 'hidden',
845 'h_type' => 'hidden',
848 'File Name' => 'text',
851 init_drag_drop($fileview);
852 $fileview->set_search_column(4); # search on File Name
854 # Connect glade-restore_list to Gtk2::SimpleList
855 $widget = $glade->get_widget('restorelist');
856 my $restore_list = $self->{restore_list} = Gtk2::SimpleList->new_from_treeview(
858 'h_name' => 'hidden',
859 'h_jobid' => 'hidden',
860 'h_type' => 'hidden',
861 'h_curjobid' => 'hidden',
864 'File Name' => 'text',
866 'FileIndex' => 'text');
868 my @restore_list_target_table = ({'target' => 'STRING',
872 $restore_list->enable_model_drag_dest(['copy'],@restore_list_target_table);
873 $restore_list->get_selection->set_mode('multiple');
875 $widget = $glade->get_widget('infoview');
876 my $infoview = $self->{fileinfo} = Gtk2::SimpleList->new_from_treeview(
878 'h_name' => 'hidden',
879 'h_jobid' => 'hidden',
880 'h_type' => 'hidden',
882 'InChanger' => 'pixbuf',
889 init_drag_drop($infoview);
891 $pref->connect_db() || $self->{dlg_pref}->display($self);
894 $self->{dbh} = $pref->{dbh};
895 $self->init_server_backup_combobox();
899 # set status bar informations
902 my ($self, $string) = @_;
903 my $context = $self->{status}->get_context_id('Main');
904 $self->{status}->push($context, $string);
907 sub on_time_select_changed
915 my $c = $self->{glade}->get_widget('combo_time');
916 return $c->get_active_text;
919 # This sub returns all clients declared in DB
923 my $query = "SELECT Name FROM Client ORDER BY Name";
924 print $query,"\n" if $debug;
925 my $result = $dbh->selectall_arrayref($query);
927 foreach my $refrow (@$result)
929 push @return_array,($refrow->[0]);
931 return @return_array;
934 sub get_wanted_job_status
941 return "'T', 'A', 'E'";
945 # This sub gives a full list of the EndTimes for a ClientId
946 # ( [ 'Date', 'FileSet', 'Type', 'Status', 'JobId'],
947 # ['Date', 'FileSet', 'Type', 'Status', 'JobId']..)
948 sub get_all_endtimes_for_job
950 my ($dbh, $client, $ok_only)=@_;
951 my $status = get_wanted_job_status($ok_only);
953 SELECT Job.EndTime, FileSet.FileSet, Job.Level, Job.JobStatus, Job.JobId
954 FROM Job,Client,FileSet
955 WHERE Job.ClientId=Client.ClientId
956 AND Client.Name = '$client'
958 AND JobStatus IN ($status)
959 AND Job.FileSetId = FileSet.FileSetId
960 ORDER BY EndTime desc";
961 print $query,"\n" if $debug;
962 my $result = $dbh->selectall_arrayref($query);
968 # init infoview widget
972 @{$self->{fileinfo}->{data}} = ();
979 @{$self->{restore_list}->{data}} = ();
982 use File::Temp qw/tempfile/;
984 sub on_go_button_clicked
987 my $bsr = $self->create_filelist();
988 my ($fh, $filename) = tempfile();
991 chmod(0644, $filename);
993 print "Dumping BSR info to $filename\n"
997 my %a = map { $_ => 1 } ($bsr =~ /Volume="(.+)"/g);
998 my $vol = [ keys %a ] ; # need only one occurrence of each volume
1000 new DlgLaunch(pref => $self->{pref},
1002 bsr_file => $filename,
1007 our $client_list_empty = 'Clients list';
1008 our %type_markup = ('F' => '<b>$label F</b>',
1011 'B' => '<b>$label B</b>',
1013 'A' => '<span foreground=\"red\">$label</span>',
1015 'E' => '<span foreground=\"red\">$label</span>',
1018 sub on_list_client_changed
1020 my ($self, $widget) = @_;
1021 return 0 unless defined $self->{fileview};
1022 my $dbh = $self->{dbh};
1024 $self->{list_backup}->clear();
1026 if ($self->current_client eq $client_list_empty) {
1030 my @endtimes=get_all_endtimes_for_job($dbh,
1031 $self->current_client,
1032 $self->{pref}->{use_ok_bkp_only});
1033 foreach my $endtime (@endtimes)
1035 my $i = $self->{list_backup}->append();
1037 my $label = $endtime->[1] . " (" . $endtime->[4] . ")";
1038 eval "\$label = \"$type_markup{$endtime->[2]}\""; # job type
1039 eval "\$label = \"$type_markup{$endtime->[3]}\""; # job status
1041 $self->{list_backup}->set($i,
1046 $self->{restore_backup_combobox}->set_active(0);
1048 $self->{CurrentJobIds} = [
1049 set_job_ids_for_date($dbh,
1050 $self->current_client,
1051 $self->current_date,
1052 $self->{pref}->{use_ok_bkp_only})
1057 # undef $self->{dirtree};
1058 $self->refresh_fileview();
1062 sub fill_server_list
1064 my ($dbh, $combo, $list) = @_;
1066 my @clients=get_all_clients($dbh);
1070 my $i = $list->append();
1071 $list->set($i, 0, $client_list_empty);
1073 foreach my $client (@clients)
1075 $i = $list->append();
1076 $list->set($i, 0, $client);
1078 $combo->set_active(0);
1081 sub init_server_backup_combobox
1084 fill_server_list($self->{dbh},
1085 $self->{client_combobox},
1086 $self->{list_client}) ;
1089 #----------------------------------------------------------------------
1090 #Refreshes the file-view Redraws everything. The dir data is cached, the file
1091 #data isn't. There is additionnal complexity for dirs (visibility problems),
1092 #so the @CurrentJobIds is not sufficient.
1093 sub refresh_fileview
1096 my $fileview = $self->{fileview};
1097 my $client_combobox = $self->{client_combobox};
1098 my $cwd = $self->{cwd};
1100 @{$fileview->{data}} = ();
1102 $self->clear_infoview();
1104 my $client_name = $self->current_client;
1106 if (!$client_name or ($client_name eq $client_list_empty)) {
1107 $self->set_status("Client list empty");
1111 my @dirs = $self->list_dirs($cwd,$client_name);
1112 # [ [listfiles.id, listfiles.Name, File.LStat, File.JobId]..]
1113 my $files = $self->list_files($cwd);
1114 print "CWD : $cwd\n" if ($debug);
1116 my $file_count = 0 ;
1117 my $total_bytes = 0;
1119 # Add directories to view
1120 foreach my $dir (@dirs) {
1121 my $time = localtime($self->dir_attrib("$cwd/$dir",'st_mtime'));
1122 $total_bytes += 4096;
1125 listview_push($fileview,
1127 $self->dir_attrib("$cwd/$dir",'jobid'),
1137 foreach my $file (@$files)
1139 my $size = file_attrib($file,'st_size');
1140 my $time = localtime(file_attrib($file,'st_mtime'));
1141 $total_bytes += $size;
1143 # $file = [listfiles.id, listfiles.Name, File.LStat, File.JobId]
1145 listview_push($fileview,
1152 human($size), $time);
1155 $self->set_status("$file_count files/" . human($total_bytes));
1157 # set a decent default selection (makes keyboard nav easy)
1158 $fileview->select(0);
1162 sub on_about_activate
1164 DlgAbout::display();
1169 my ($tree, $path, $data) = @_;
1171 my @items = listview_get_all($tree) ;
1173 foreach my $i (@items)
1175 my @file_info = @{$i};
1178 # Ok, we have a corner case :
1183 $file = pack("u", $file_info[0]);
1187 $file = pack("u", $path . '/' . $file_info[0]);
1189 push @ret, join(" ; ", $file,
1190 $file_info[1], # $jobid
1191 $file_info[2], # $type
1195 my $data_get = join(" :: ", @ret);
1197 $data->set_text($data_get,-1);
1200 sub fileview_data_get
1202 my ($self, $widget, $context, $data, $info, $time,$string) = @_;
1203 drag_set_info($widget, $self->{cwd}, $data);
1206 sub fileinfo_data_get
1208 my ($self, $widget, $context, $data, $info, $time,$string) = @_;
1209 drag_set_info($widget, $self->{cwd}, $data);
1212 sub restore_list_data_received
1214 my ($self, $widget, $context, $x, $y, $data, $info, $time) = @_;
1217 if ($info eq 40 || $info eq 0) # patch for display!=:0
1219 foreach my $elt (split(/ :: /, $data->data()))
1222 my ($file, $jobid, $type) =
1224 $file = unpack("u", $file);
1226 $self->add_selected_file_to_list($file, $jobid, $type);
1231 sub on_back_button_clicked {
1235 sub on_location_go_button_clicked
1238 $self->ch_dir($self->{location}->get_text());
1240 sub on_quit_activate {Gtk2->main_quit;}
1241 sub on_preferences_activate
1244 $self->{dlg_pref}->display($self) ;
1246 sub on_main_delete_event {Gtk2->main_quit;}
1247 sub on_bweb_activate
1250 $self->set_status("Open bweb on your browser");
1251 $self->{pref}->go_bweb('', "go on bweb");
1254 # Change to parent directory
1258 if ($self->{cwd} eq '/')
1262 my @dirs = File::Spec->splitdir ($self->{cwd});
1264 $self->ch_dir(File::Spec->catdir(@dirs));
1267 # Change the current working directory
1268 # * Updates fileview, location, and selection
1273 $self->{cwd} = shift;
1275 $self->refresh_fileview();
1276 $self->{location}->set_text($self->{cwd});
1281 # Handle dialog 'close' (window-decoration induced close)
1282 # * Just hide the dialog, and tell Gtk not to do anything else
1286 my ($self, $w) = @_;
1289 1; # consume this event!
1292 # Handle key presses in location text edit control
1293 # * Translate a Return/Enter key into a 'Go' command
1294 # * All other key presses left for GTK
1296 sub on_location_entry_key_release_event
1302 my $keypress = $event->keyval;
1303 if ($keypress == $Gtk2::Gdk::Keysyms{KP_Enter} ||
1304 $keypress == $Gtk2::Gdk::Keysyms{Return})
1306 $self->ch_dir($widget->get_text());
1308 return 1; # consume keypress
1311 return 0; # let gtk have the keypress
1314 sub on_fileview_key_press_event
1316 my ($self, $widget, $event) = @_;
1320 sub listview_get_first
1323 my @selected = $list->get_selected_indices();
1324 if (@selected > 0) {
1325 my ($name, @other) = @{$list->{data}->[$selected[0]]};
1326 return (unpack('u', $name), @other);
1332 sub listview_get_all
1336 my @selected = $list->get_selected_indices();
1338 for my $i (@selected) {
1339 my ($name, @other) = @{$list->{data}->[$i]};
1340 push @ret, [unpack('u', $name), @other];
1348 my ($list, $name, @other) = @_;
1349 push @{$list->{data}}, [pack('u', $name), @other];
1352 #----------------------------------------------------------------------
1353 # Handle keypress in file-view
1354 # * Translates backspace into a 'cd ..' command
1355 # * All other key presses left for GTK
1357 sub on_fileview_key_release_event
1359 my ($self, $widget, $event) = @_;
1360 if (not $event->keyval)
1364 if ($event->keyval == $Gtk2::Gdk::Keysyms{BackSpace}) {
1366 return 1; # eat keypress
1369 return 0; # let gtk have keypress
1372 sub on_forward_keypress
1377 #----------------------------------------------------------------------
1378 # Handle double-click (or enter) on file-view
1379 # * Translates into a 'cd <dir>' command
1381 sub on_fileview_row_activated
1383 my ($self, $widget) = @_;
1385 my ($name, undef, $type, undef) = listview_get_first($widget);
1389 if ($self->{cwd} eq '')
1391 $self->ch_dir($name);
1393 elsif ($self->{cwd} eq '/')
1395 $self->ch_dir('/' . $name);
1399 $self->ch_dir($self->{cwd} . '/' . $name);
1403 $self->fill_infoview($self->{cwd}, $name);
1406 return 1; # consume event
1411 my ($self, $path, $file) = @_;
1412 $self->clear_infoview();
1413 my @v = get_all_file_versions($self->{dbh},
1416 $self->current_client);
1418 my (undef,$fn,$jobid,$fileindex,$mtime,$size,$inchanger,$md5,$volname)
1420 my $icon = ($inchanger)?$yesicon:$noicon;
1422 $mtime = localtime($mtime) ;
1424 listview_push($self->{fileinfo},
1425 $file, $jobid, 'file',
1426 $icon, $volname, $jobid, human($size), $mtime, $md5);
1433 return $self->{restore_backup_combobox}->get_active_text;
1439 return $self->{client_combobox}->get_active_text;
1442 sub on_list_backups_changed
1444 my ($self, $widget) = @_;
1445 return 0 unless defined $self->{fileview};
1447 $self->{CurrentJobIds} = [
1448 set_job_ids_for_date($self->{dbh},
1449 $self->current_client,
1450 $self->current_date,
1451 $self->{pref}->{use_ok_bkp_only})
1454 $self->refresh_fileview();
1458 sub on_restore_list_keypress
1460 my ($self, $widget, $event) = @_;
1461 if ($event->keyval == $Gtk2::Gdk::Keysyms{Delete})
1463 my @sel = $widget->get_selected_indices;
1464 foreach my $elt (reverse(sort {$a <=> $b} @sel))
1466 splice @{$self->{restore_list}->{data}},$elt,1;
1471 sub on_fileview_button_press_event
1473 my ($self,$widget,$event) = @_;
1474 if ($event->button == 3)
1476 $self->on_right_click_filelist($widget,$event);
1480 if ($event->button == 2)
1482 $self->on_see_all_version();
1489 sub on_see_all_version
1493 my @lst = listview_get_all($self->{fileview});
1496 my ($name, undef) = @{$i};
1498 new DlgFileVersion($self->{dbh},
1499 $self->current_client,
1500 $self->{cwd}, $name);
1504 sub on_right_click_filelist
1506 my ($self,$widget,$event) = @_;
1507 # I need to know what's selected
1508 my @sel = listview_get_all($self->{fileview});
1513 $type = $sel[0]->[2]; # $type
1518 if (@sel >=2 or $type eq 'dir')
1520 # We have selected more than one or it is a directories
1521 $w = $self->{filelist_dir_menu};
1525 $w = $self->{filelist_file_menu};
1531 $event->button, $event->time);
1534 sub context_add_to_filelist
1538 my @sel = listview_get_all($self->{fileview});
1540 foreach my $i (@sel)
1542 my ($file, $jobid, $type, undef) = @{$i};
1543 $file = $self->{cwd} . '/' . $file;
1544 $self->add_selected_file_to_list($file, $jobid, $type);
1548 # Adds a file to the filelist
1549 sub add_selected_file_to_list
1551 my ($self, $name, $jobid, $type)=@_;
1553 my $dbh = $self->{dbh};
1554 my $restore_list = $self->{restore_list};
1556 my $curjobids=join(',', @{$self->{CurrentJobIds}});
1563 if ($name and substr $name,-1 ne '/')
1565 $name .= '/'; # For bacula
1567 my $dirfileindex = get_fileindex_from_dir_jobid($dbh,$name,$jobid);
1568 listview_push($restore_list,
1569 $name, $jobid, 'dir', $curjobids,
1570 $diricon, $name,$jobid,$dirfileindex);
1572 elsif ($type eq 'file')
1574 my $fileindex = get_fileindex_from_file_jobid($dbh,$name,$jobid);
1576 listview_push($restore_list,
1577 $name, $jobid, 'file', $curjobids,
1578 $fileicon, $name, $jobid, $fileindex );
1582 # TODO : we want be able to restore files from a bad ended backup
1583 # we have JobStatus IN ('T', 'A', 'E') and we must
1585 # Data acces subs from here. Interaction with SGBD and caching
1587 # This sub retrieves the list of jobs corresponding to the jobs selected in the
1588 # GUI and stores them in @CurrentJobIds
1589 sub set_job_ids_for_date
1591 my ($dbh, $client, $date, $only_ok)=@_;
1593 if (!$client or !$date) {
1597 my $status = get_wanted_job_status($only_ok);
1599 # The algorithm : for a client, we get all the backups for each
1600 # fileset, in reverse order Then, for each fileset, we store the 'good'
1601 # incrementals and differentials until we have found a full so it goes
1602 # like this : store all incrementals until we have found a differential
1603 # or a full, then find the full #
1605 my $query = "SELECT JobId, FileSet, Level, JobStatus
1606 FROM Job, Client, FileSet
1607 WHERE Job.ClientId = Client.ClientId
1608 AND FileSet.FileSetId = Job.FileSetId
1609 AND EndTime <= '$date'
1610 AND Client.Name = '$client'
1612 AND JobStatus IN ($status)
1613 ORDER BY FileSet, JobTDate DESC";
1615 print $query,"\n" if $debug;
1617 my $result = $dbh->selectall_arrayref($query);
1619 foreach my $refrow (@$result)
1621 my $jobid = $refrow->[0];
1622 my $fileset = $refrow->[1];
1623 my $level = $refrow->[2];
1625 defined $progress{$fileset} or $progress{$fileset}='U'; # U for unknown
1627 next if $progress{$fileset} eq 'F'; # It's over for this fileset...
1631 next unless ($progress{$fileset} eq 'U' or $progress{$fileset} eq 'I');
1632 push @CurrentJobIds,($jobid);
1634 elsif ($level eq 'D')
1636 next if $progress{$fileset} eq 'D'; # We allready have a differential
1637 push @CurrentJobIds,($jobid);
1639 elsif ($level eq 'F')
1641 push @CurrentJobIds,($jobid);
1644 my $status = $refrow->[3] ;
1645 if ($status eq 'T') { # good end of job
1646 $progress{$fileset} = $level;
1649 print Data::Dumper::Dumper(\@CurrentJobIds) if $debug;
1651 return @CurrentJobIds;
1654 # Lists all directories contained inside a directory.
1655 # Uses the current dir, the client name, and CurrentJobIds for visibility.
1656 # Returns an array of dirs
1659 my ($self,$dir,$client)=@_;
1660 print "list_dirs($dir, $client)\n";
1662 # Is data allready cached ?
1663 if (not $self->{dirtree}->{$client})
1665 $self->cache_dirs($client);
1668 if ($dir ne '' and substr $dir,-1 ne '/')
1670 $dir .= '/'; # In the db, there is a / at the end of the dirs ...
1672 # Here, the tree is cached in ram
1673 my @dir = split('/',$dir,-1);
1674 pop @dir; # We don't need the empty trailing element
1676 # We have to get the reference of the hash containing $dir contents
1678 my $refdir=$self->{dirtree}->{$client};
1681 foreach my $subdir (@dir)
1687 $refdir = $refdir->[0]->{$subdir};
1690 # We reached the directory
1693 foreach my $dir (sort(keys %{$refdir->[0]}))
1695 # We return the directory's content : only visible directories
1696 foreach my $jobid (reverse(sort(@{$self->{CurrentJobIds}})))
1698 if (defined $refdir->[0]->{$dir}->[1]->{$jobid})
1700 my $dirname = $refdir->[0]->{$dir}->[2]; # The real dirname...
1701 push @return_list,($dirname);
1702 next DIRLOOP; # No need to waste more CPU cycles...
1706 print "LIST DIR : ", Data::Dumper::Dumper(\@return_list),"\n";
1707 return @return_list;
1711 # List all files in a directory. dir as parameter, CurrentJobIds for visibility
1712 # Returns an array of dirs
1715 my ($self, $dir)=@_;
1716 my $dbh = $self->{dbh};
1720 print "list_files($dir)\n";
1722 if ($dir ne '' and substr $dir,-1 ne '/')
1724 $dir .= '/'; # In the db, there is a / at the end of the dirs ...
1727 my $query = "SELECT Path.PathId FROM Path WHERE Path.Path = '$dir'";
1728 print $query,"\n" if $debug;
1730 my $result = $dbh->selectall_arrayref($query);
1731 foreach my $refrow (@$result)
1733 push @list_pathid,($refrow->[0]);
1736 if (@list_pathid == 0)
1738 print "No pathid found for $dir\n" if $debug;
1742 my $inlistpath = join (',', @list_pathid);
1743 my $inclause = join (',', @{$self->{CurrentJobIds}});
1744 if ($inclause eq '')
1750 "SELECT listfiles.id, listfiles.Name, File.LStat, File.JobId
1752 (SELECT Filename.Name, max(File.FileId) as id
1754 WHERE File.FilenameId = Filename.FilenameId
1755 AND Filename.Name != ''
1756 AND File.PathId IN ($inlistpath)
1757 AND File.JobId IN ($inclause)
1758 GROUP BY Filename.Name
1759 ORDER BY Filename.Name) AS listfiles,
1761 WHERE File.FileId = listfiles.id";
1763 print $query,"\n" if $debug;
1764 $result = $dbh->selectall_arrayref($query);
1769 # For the dirs, because of the db schema, it's inefficient to get the
1770 # directories contained inside other directories (regexp match or tossing
1771 # lots of records...). So we load all the tree and cache it. The data is
1772 # stored in a structure of this form :
1773 # Each directory is an array.
1774 # - In this array, the first element is a ref to next dir (hash)
1775 # - The second element is a hash containing all jobids pointing
1776 # on an array containing their lstat (or 1 if this jobid is there because
1778 # - The third is the filename itself (it could get mangled because of
1781 # So it looks like this :
1782 # $reftree->[ { 'dir1' => $refdir1
1783 # 'dir2' => $refdir2
1786 # { 'jobid1' => 'lstat1',
1787 # 'jobid2' => 'lstat2',
1788 # 'jobid3' => 1 # This one is here for "visibility"
1793 # Client as a parameter
1794 # Returns an array of dirs
1797 my ($self, $client) = @_;
1798 print "cache_dirs()\n";
1800 $self->{dirtree}->{$client} = []; # reset cache
1801 my $dbh = $self->{dbh};
1803 # TODO : If we get here, things could get lenghty ... draw a popup window .
1804 my $widget = Gtk2::MessageDialog->new($self->{mainwin},
1805 'destroy-with-parent',
1807 'Populating cache');
1809 Gtk2->main_iteration while (Gtk2->events_pending);
1811 # We have to build the tree, as it's the first time it is asked...
1814 # First, we only need the jobids of the selected server.
1815 # It's not the same as @CurrentJobIds (we need ALL the jobs)
1816 # We get the JobIds first in order to have the best execution
1817 # plan possible for the big query, with an in clause.
1819 my $status = get_wanted_job_status($self->{pref}->{use_ok_bkp_only});
1823 WHERE Job.ClientId = Client.ClientId
1824 AND Client.Name = '$client'
1825 AND Job.JobStatus IN ($status)
1826 AND Job.Type = 'B'";
1828 print $query,"\n" if $debug;
1829 my $result = $dbh->selectall_arrayref($query);
1831 foreach my $record (@{$result})
1833 push @jobids,($record->[0]);
1835 my $inclause = join(',',@jobids);
1836 if ($inclause eq '')
1839 $self->set_status("No previous backup found for $client");
1843 # Then, still to help dear mysql, we'll retrieve the PathId from empty Path (directory entries...)
1846 "SELECT Filename.FilenameId FROM Filename WHERE Filename.Name=''";
1848 print $query,"\n" if $debug;
1849 $result = $dbh->selectall_arrayref($query);
1850 foreach my $record (@{$result})
1852 push @dirids,$record->[0];
1854 my $dirinclause = join(',',@dirids);
1856 # This query is a bit complicated :
1857 # whe need to find all dir entries that should be displayed, even
1858 # if the directory itself has no entry in File table (it means a file
1859 # is explicitely chosen in the backup configuration)
1860 # Here's what I wanted to do :
1863 # SELECT T1.Path, T2.Lstat, T2.JobId
1864 # FROM ( SELECT DISTINCT Path.PathId, Path.Path FROM File, Path
1865 # WHERE File.PathId = Path.PathId
1866 # AND File.JobId IN ($inclause)) AS T1
1868 # ( SELECT File.Lstat, File.JobId, File.PathId FROM File
1869 # WHERE File.FilenameId IN ($dirinclause)
1870 # AND File.JobId IN ($inclause)) AS T2
1871 # ON (T1.PathId = T2.PathId)
1873 # It works perfectly with postgresql, but mysql doesn't seem to be able
1874 # to do the hash join correcty, so the performance sucks.
1875 # So it will be done in 4 steps :
1876 # o create T1 and T2 as temp tables
1877 # o create an index on T2.PathId
1879 # o remove the temp tables
1881 CREATE TEMPORARY TABLE T1 AS
1882 SELECT DISTINCT Path.PathId, Path.Path FROM File, Path
1883 WHERE File.PathId = Path.PathId
1884 AND File.JobId IN ($inclause)
1886 print $query,"\n" if $debug;
1889 CREATE TEMPORARY TABLE T2 AS
1890 SELECT File.Lstat, File.JobId, File.PathId FROM File
1891 WHERE File.FilenameId IN ($dirinclause)
1892 AND File.JobId IN ($inclause)
1894 print $query,"\n" if $debug;
1897 CREATE INDEX tmp2 ON T2(PathId)
1899 print $query,"\n" if $debug;
1903 SELECT T1.Path, T2.Lstat, T2.JobId
1904 FROM T1 LEFT JOIN T2
1905 ON (T1.PathId = T2.PathId)
1908 print $query,"\n" if $debug;
1909 $result = $dbh->selectall_arrayref($query);
1911 foreach my $record (@{$result})
1913 # Dirty hack to force the string encoding on perl... we don't
1914 # want implicit conversions
1915 my $path = pack "U0C*", unpack "C*",$record->[0];
1917 my @path = split('/',$path,-1);
1918 pop @path; # we don't need the trailing empty element
1919 my $lstat = $record->[1];
1920 my $jobid = $record->[2];
1922 # We're going to store all the data on the cache tree.
1923 # We find the leaf, then store data there
1924 my $reftree=$self->{dirtree}->{$client};
1925 foreach my $dir(@path)
1931 if (not defined($reftree->[0]->{$dir}))
1934 $reftree->[0]->{$dir}=\@tmparray;
1936 $reftree=$reftree->[0]->{$dir};
1939 # We can now add the metadata for this dir ...
1941 # $result = $dbh->selectall_arrayref($query);
1944 # contains something
1945 $reftree->[1]->{$jobid}=$lstat;
1949 # We have a very special case here...
1950 # lstat is not defined.
1951 # it means the directory is there because a file has been
1952 # backuped. so the dir has no entry in File table.
1953 # That's a rare case, so we can afford to determine it's
1954 # visibility with a query
1955 my $select_path=$record->[0];
1956 $select_path=$dbh->quote($select_path); # gotta be careful
1960 WHERE File.PathId = Path.PathId
1961 AND Path.Path = $select_path
1963 print $query,"\n" if $debug;
1964 my $result2 = $dbh->selectall_arrayref($query);
1965 foreach my $record (@{$result2})
1967 my $jobid=$record->[0];
1968 $reftree->[1]->{$jobid}=1;
1976 print $query,"\n" if $debug;
1981 print $query,"\n" if $debug;
1985 list_visible($self->{dirtree}->{$client});
1988 # print Data::Dumper::Dumper($self->{dirtree});
1991 # Recursive function to calculate the visibility of each directory in the cache
1992 # tree Working with references to save time and memory
1993 # For each directory, we want to propagate it's visible jobids onto it's
1994 # parents directory.
1995 # A tree is visible if
1996 # - it's been in a backup pointed by the CurrentJobIds
1997 # - one of it's subdirs is in a backup pointed by the CurrentJobIds
1998 # In the second case, the directory is visible but has no metadata.
1999 # We symbolize this with lstat = 1 for this jobid in the cache.
2001 # Input : reference directory
2002 # Output : visibility of this dir. Has to know visibility of all subdirs
2003 # to know it's visibility, hence the recursing.
2009 # Get the subdirs array references list
2010 my @list_ref_subdirs;
2011 while( my (undef,$ref_subdir) = each (%{$refdir->[0]}))
2013 push @list_ref_subdirs,($ref_subdir);
2016 # Now lets recurse over these subdirs and retrieve the reference of a hash
2017 # containing the jobs where they are visible
2018 foreach my $ref_subdir (@list_ref_subdirs)
2020 my $ref_list_jobs = list_visible($ref_subdir);
2021 foreach my $jobid (keys %$ref_list_jobs)
2023 $visibility{$jobid}=1;
2027 # Ok. Now, we've got the list of those jobs. We are going to update our
2028 # hash (element 1 of the dir array) containing our jobs Do NOT overwrite
2029 # the lstat for the known jobids. Put 1 in the new elements... But first,
2030 # let's store the current jobids
2032 foreach my $jobid (keys %{$refdir->[1]})
2034 push @known_jobids,($jobid);
2038 foreach my $jobid (keys %visibility)
2040 next if ($refdir->[1]->{$jobid});
2041 $refdir->[1]->{$jobid} = 1;
2043 # Add the known_jobids to %visibility
2044 foreach my $jobid (@known_jobids)
2046 $visibility{$jobid}=1;
2048 return \%visibility;
2051 # Returns the list of media required for a list of jobids.
2052 # Input : dbh, jobid1, jobid2...
2053 # Output : reference to array of (joibd, inchanger)
2054 sub get_required_media_from_jobid
2056 my ($dbh, @jobids)=@_;
2057 my $inclause = join(',',@jobids);
2059 SELECT DISTINCT JobMedia.MediaId, Media.InChanger
2060 FROM JobMedia, Media
2061 WHERE JobMedia.MediaId=Media.MediaId
2062 AND JobId In ($inclause)
2064 my $result = $dbh->selectall_arrayref($query);
2068 # Returns the fileindex from dirname and jobid.
2069 # Input : dbh, dirname, jobid
2070 # Output : fileindex
2071 sub get_fileindex_from_dir_jobid
2073 my ($dbh, $dirname, $jobid)=@_;
2075 $query = "SELECT File.FileIndex
2076 FROM File, Filename, Path
2077 WHERE File.FilenameId = Filename.FilenameId
2078 AND File.PathId = Path.PathId
2079 AND Filename.Name = ''
2080 AND Path.Path = '$dirname'
2081 AND File.JobId = '$jobid'
2084 print $query,"\n" if $debug;
2085 my $result = $dbh->selectall_arrayref($query);
2086 return $result->[0]->[0];
2089 # Returns the fileindex from filename and jobid.
2090 # Input : dbh, filename, jobid
2091 # Output : fileindex
2092 sub get_fileindex_from_file_jobid
2094 my ($dbh, $filename, $jobid)=@_;
2096 my @dirs = File::Spec->splitdir ($filename);
2097 $filename=pop(@dirs);
2098 my $dirname = File::Spec->catdir(@dirs) . '/';
2103 "SELECT File.FileIndex
2104 FROM File, Filename, Path
2105 WHERE File.FilenameId = Filename.FilenameId
2106 AND File.PathId = Path.PathId
2107 AND Filename.Name = '$filename'
2108 AND Path.Path = '$dirname'
2109 AND File.JobId = '$jobid'";
2111 print $query,"\n" if $debug;
2112 my $result = $dbh->selectall_arrayref($query);
2113 return $result->[0]->[0];
2117 # Returns list of versions of a file that could be restored
2118 # returns an array of
2119 # ('FILE:',filename,jobid,fileindex,mtime,size,inchanger,md5,volname)
2120 # It's the same as entries of restore_list (hidden) + mtime and size and inchanger
2121 # and volname and md5
2122 # and of course, there will be only one jobid in the array of jobids...
2123 sub get_all_file_versions
2125 my ($dbh,$path,$file,$client,$see_all)=@_;
2127 defined $see_all or $see_all=0;
2132 "SELECT File.JobId, File.FileIndex, File.Lstat,
2133 File.Md5, Media.VolumeName, Media.InChanger
2134 FROM File, Filename, Path, Job, Client, JobMedia, Media
2135 WHERE File.FilenameId = Filename.FilenameId
2136 AND File.PathId=Path.PathId
2137 AND File.JobId = Job.JobId
2138 AND Job.ClientId = Client.ClientId
2139 AND Job.JobId = JobMedia.JobId
2140 AND File.FileIndex >= JobMedia.FirstIndex
2141 AND File.FileIndex <= JobMedia.LastIndex
2142 AND JobMedia.MediaId = Media.MediaId
2143 AND Path.Path = '$path'
2144 AND Filename.Name = '$file'
2145 AND Client.Name = '$client'";
2147 print $query if $debug;
2149 my $result = $dbh->selectall_arrayref($query);
2151 foreach my $refrow (@$result)
2153 my ($jobid, $fileindex, $lstat, $md5, $volname, $inchanger) = @$refrow;
2154 my @attribs = parse_lstat($lstat);
2155 my $mtime = array_attrib('st_mtime',\@attribs);
2156 my $size = array_attrib('st_size',\@attribs);
2158 my @list = ('FILE:', $path.$file, $jobid, $fileindex, $mtime, $size,
2159 $inchanger, $md5, $volname);
2160 push @versions, (\@list);
2163 # We have the list of all versions of this file.
2164 # We'll sort it by mtime desc, size, md5, inchanger desc
2165 # the rest of the algorithm will be simpler
2166 # ('FILE:',filename,jobid,fileindex,mtime,size,inchanger,md5,volname)
2167 @versions = sort { $b->[4] <=> $a->[4]
2168 || $a->[5] <=> $b->[5]
2169 || $a->[7] cmp $a->[7]
2170 || $b->[6] <=> $a->[6]} @versions;
2173 my %allready_seen_by_mtime;
2174 my %allready_seen_by_md5;
2175 # Now we should create a new array with only the interesting records
2176 foreach my $ref (@versions)
2180 # The file has a md5. We compare his md5 to other known md5...
2181 # We take size into account. It may happen that 2 files
2182 # have the same md5sum and are different. size is a supplementary
2185 # If we allready have a (better) version
2186 next if ( (not $see_all)
2187 and $allready_seen_by_md5{$ref->[7] .'-'. $ref->[5]});
2189 # we never met this one before...
2190 $allready_seen_by_md5{$ref->[7] .'-'. $ref->[5]}=1;
2192 # Even if it has a md5, we should also work with mtimes
2193 # We allready have a (better) version
2194 next if ( (not $see_all)
2195 and $allready_seen_by_mtime{$ref->[4] .'-'. $ref->[5]});
2196 $allready_seen_by_mtime{$ref->[4] .'-'. $ref->[5] . '-' . $ref->[7]}=1;
2198 # We reached there. The file hasn't been seen.
2199 push @good_versions,($ref);
2202 # To be nice with the user, we re-sort good_versions by
2203 # inchanger desc, mtime desc
2204 @good_versions = sort { $b->[4] <=> $a->[4]
2205 || $b->[2] <=> $a->[2]} @good_versions;
2207 return @good_versions;
2210 # TODO : bsr must use only good backup or not (see use_ok_bkp_only)
2211 # This sub creates a BSR from the information in the restore_list
2212 # Returns the BSR as a string
2216 my $dbh = $self->{dbh};
2218 # This query gets all jobid/jobmedia/media combination.
2220 "SELECT Job.JobId, Job.VolsessionId, Job.VolsessionTime, JobMedia.StartFile,
2221 JobMedia.FirstIndex, JobMedia.LastIndex, JobMedia.StartBlock,
2222 JobMedia.EndBlock, JobMedia.VolIndex, Media.Volumename, Media.MediaType
2223 FROM Job, JobMedia, Media
2224 WHERE Job.JobId = JobMedia.JobId
2225 AND JobMedia.MediaId = Media.MediaId
2226 AND JobMedia.StartFile = JobMedia.EndFile
2227 ORDER BY JobMedia.FirstIndex, JobMedia.LastIndex";
2230 my $result = $dbh->selectall_arrayref($query);
2232 # We will store everything hashed by jobid.
2234 foreach my $refrow (@$result)
2236 my ($jobid, $volsessionid, $volsessiontime, $startfile,
2237 $firstindex, $lastindex, $startblock, $endblock,
2238 $volindex, $volumename, $mediatype) = @{$refrow};
2241 ($jobid, $volsessionid, $volsessiontime, $startfile,
2242 $firstindex, $lastindex, $startblock .'-'. $endblock,
2243 $volindex, $volumename, $mediatype);
2245 push @{$mediainfos{$refrow->[0]}},(\@tmparray);
2249 # reminder : restore_list looks like this :
2250 # ($name,$jobid,'file',$curjobids, undef, undef, undef, $dirfileindex);
2252 # Here, we retrieve every file/dir that could be in the restore
2253 # We do as simple as possible for the SQL engine (no crazy joins,
2254 # no pseudo join (>= FirstIndex ...), etc ...
2255 # We do a SQL union of all the files/dirs specified in the restore_list
2257 foreach my $entry (@{$self->{restore_list}->{data}})
2259 if ($entry->[2] eq 'dir')
2261 my $dir = unpack('u', $entry->[0]);
2262 my $inclause = $entry->[3]; #curjobids
2265 "(SELECT Path.Path, Filename.Name, File.FileIndex, File.JobId
2266 FROM File, Path, Filename
2267 WHERE Path.PathId = File.PathId
2268 AND File.FilenameId = Filename.FilenameId
2269 AND Path.Path LIKE '$dir%'
2270 AND File.JobId IN ($inclause) )";
2271 push @select_queries,($query);
2275 # It's a file. Great, we allready have most
2276 # of what is needed. Simple and efficient query
2277 my $file = unpack('u', $entry->[0]);
2278 my @file = split '/',$file;
2280 my $dir = join('/',@file);
2282 my $jobid = $entry->[1];
2283 my $fileindex = $entry->[7];
2284 my $inclause = $entry->[3]; # curjobids
2286 "(SELECT Path.Path, Filename.Name, File.FileIndex, File.JobId
2287 FROM File, Path, Filename
2288 WHERE Path.PathId = File.PathId
2289 AND File.FilenameId = Filename.FilenameId
2290 AND Path.Path = '$dir/'
2291 AND Filename.Name = '$file'
2292 AND File.JobId = $jobid)";
2293 push @select_queries,($query);
2296 $query = join("\nUNION ALL\n",@select_queries) . "\nORDER BY FileIndex\n";
2298 print $query,"\n" if $debug;
2300 #Now we run the query and parse the result...
2301 # there may be a lot of records, so we better be efficient
2302 # We use the bind column method, working with references...
2304 my $sth = $dbh->prepare($query);
2307 my ($path,$name,$fileindex,$jobid);
2308 $sth->bind_columns(\$path,\$name,\$fileindex,\$jobid);
2310 # The temp place we're going to save all file
2311 # list to before the real list
2315 while ($sth->fetchrow_arrayref())
2317 # This may look dumb, but we're going to do a join by ourselves,
2318 # to save memory and avoid sending a complex query to mysql
2319 my $complete_path = $path . $name;
2327 # Remove trailing slash (normalize file and dir name)
2328 $complete_path =~ s/\/$//;
2330 # Let's find the ref(s) for the %mediainfo element(s)
2331 # containing the data for this file
2332 # There can be several matches. It is the pseudo join.
2334 my $max_elt=@{$mediainfos{$jobid}}-1;
2336 while($med_idx <= $max_elt)
2338 my $ref = $mediainfos{$jobid}->[$med_idx];
2339 # First, can we get rid of the first elements of the
2340 # array ? (if they don't contain valuable records
2342 if ($fileindex > $ref->[5])
2344 # It seems we don't need anymore
2345 # this entry in %mediainfo (the input data
2348 shift @{$mediainfos{$jobid}};
2352 # We will do work on this elt. We can ++
2353 # $med_idx for next loop
2356 # %mediainfo row looks like :
2357 # (jobid,VolsessionId,VolsessionTime,File,FirstIndex,
2358 # LastIndex,StartBlock-EndBlock,VolIndex,Volumename,
2361 # We are in range. We store and continue looping
2363 if ($fileindex >= $ref->[4])
2365 my @data = ($complete_path,$is_dir,
2367 push @temp_list,(\@data);
2371 # We are not in range. No point in continuing looping
2372 # We go to next record.
2376 # Now we have the array.
2377 # We're going to sort it, by
2378 # path, volsessiontime DESC (get the most recent file...)
2379 # The array rows look like this :
2380 # complete_path,is_dir,fileindex,
2381 # ref->(jobid,VolsessionId,VolsessionTime,File,FirstIndex,
2382 # LastIndex,StartBlock-EndBlock,VolIndex,Volumename,MediaType)
2383 @temp_list = sort {$a->[0] cmp $b->[0]
2384 || $b->[3]->[2] <=> $a->[3]->[2]
2388 my $prev_complete_path='////'; # Sure not to match
2392 while (my $refrow = shift @temp_list)
2394 # For the sake of readability, we load $refrow
2395 # contents in real scalars
2396 my ($complete_path, $is_dir, $fileindex, $refother)=@{$refrow};
2397 my $jobid= $refother->[0]; # We don't need the rest...
2399 # We skip this entry.
2400 # We allready have a newer one and this
2401 # isn't a continuation of the same file
2402 next if ($complete_path eq $prev_complete_path
2403 and $jobid != $prev_jobid);
2407 and $complete_path =~ m|^\Q$prev_complete_path\E/|)
2409 # We would be recursing inside a file.
2410 # Just what we don't want (dir replaced by file
2411 # between two backups
2417 push @restore_list,($refrow);
2419 $prev_complete_path = $complete_path;
2420 $prev_jobid = $jobid;
2426 push @restore_list,($refrow);
2428 $prev_complete_path = $complete_path;
2429 $prev_jobid = $jobid;
2433 # We get rid of @temp_list... save memory
2436 # Ok everything is in the list. Let's sort it again in another way.
2437 # This time it will be in the bsr file order
2439 # we sort the results by
2440 # volsessiontime, volsessionid, volindex, fileindex
2441 # to get all files in right order...
2442 # Reminder : The array rows look like this :
2443 # complete_path,is_dir,fileindex,
2444 # ref->(jobid,VolsessionId,VolsessionTime,File,FirstIndex,LastIndex,
2445 # StartBlock-EndBlock,VolIndex,Volumename,MediaType)
2447 @restore_list= sort { $a->[3]->[2] <=> $b->[3]->[2]
2448 || $a->[3]->[1] <=> $b->[3]->[1]
2449 || $a->[3]->[7] <=> $b->[3]->[7]
2450 || $a->[2] <=> $b->[2] }
2453 # Now that everything is ready, we create the bsr
2454 my $prev_fileindex=-1;
2455 my $prev_volsessionid=-1;
2456 my $prev_volsessiontime=-1;
2457 my $prev_volumename=-1;
2458 my $prev_volfile=-1;
2462 my $first_of_current_range=0;
2463 my @fileindex_ranges;
2466 foreach my $refrow (@restore_list)
2468 my (undef,undef,$fileindex,$refother)=@{$refrow};
2469 my (undef,$volsessionid,$volsessiontime,$volfile,undef,undef,
2470 $volblocks,undef,$volumename,$mediatype)=@{$refother};
2472 # We can specifiy the number of files in each section of the
2473 # bsr to speedup restore (bacula can then jump over the
2474 # end of tape files.
2478 if ($prev_volumename eq '-1')
2480 # We only have to start the new range...
2481 $first_of_current_range=$fileindex;
2483 elsif ($prev_volsessionid != $volsessionid
2484 or $prev_volsessiontime != $volsessiontime
2485 or $prev_volumename ne $volumename
2486 or $prev_volfile != $volfile)
2488 # We have to create a new section in the bsr...
2489 # We print the previous one ...
2490 # (before that, save the current range ...)
2491 if ($first_of_current_range != $prev_fileindex)
2494 push @fileindex_ranges,
2495 ("$first_of_current_range-$prev_fileindex");
2499 # We are out of a range,
2500 # but there is only one element in the range
2501 push @fileindex_ranges,
2502 ("$first_of_current_range");
2505 $bsr.=print_bsr_section(\@fileindex_ranges,
2507 $prev_volsessiontime,
2514 # Reset for next loop
2515 @fileindex_ranges=();
2516 $first_of_current_range=$fileindex;
2518 elsif ($fileindex-1 != $prev_fileindex)
2520 # End of a range of fileindexes
2521 if ($first_of_current_range != $prev_fileindex)
2524 push @fileindex_ranges,
2525 ("$first_of_current_range-$prev_fileindex");
2529 # We are out of a range,
2530 # but there is only one element in the range
2531 push @fileindex_ranges,
2532 ("$first_of_current_range");
2534 $first_of_current_range=$fileindex;
2536 $prev_fileindex=$fileindex;
2537 $prev_volsessionid = $volsessionid;
2538 $prev_volsessiontime = $volsessiontime;
2539 $prev_volumename = $volumename;
2540 $prev_volfile=$volfile;
2541 $prev_mediatype=$mediatype;
2542 $prev_volblocks=$volblocks;
2546 # Ok, we're out of the loop. Alas, there's still the last record ...
2547 if ($first_of_current_range != $prev_fileindex)
2550 push @fileindex_ranges,("$first_of_current_range-$prev_fileindex");
2555 # We are out of a range,
2556 # but there is only one element in the range
2557 push @fileindex_ranges,("$first_of_current_range");
2560 $bsr.=print_bsr_section(\@fileindex_ranges,
2562 $prev_volsessiontime,
2572 sub print_bsr_section
2574 my ($ref_fileindex_ranges,$volsessionid,
2575 $volsessiontime,$volumename,$volfile,
2576 $mediatype,$volblocks,$count)=@_;
2579 $bsr .= "Volume=\"$volumename\"\n";
2580 $bsr .= "MediaType=\"$mediatype\"\n";
2581 $bsr .= "VolSessionId=$volsessionid\n";
2582 $bsr .= "VolSessionTime=$volsessiontime\n";
2583 $bsr .= "VolFile=$volfile\n";
2584 $bsr .= "VolBlock=$volblocks\n";
2586 foreach my $range (@{$ref_fileindex_ranges})
2588 $bsr .= "FileIndex=$range\n";
2591 $bsr .= "Count=$count\n";
2597 my %attrib_name_id = ( 'st_dev' => 0,'st_ino' => 1,'st_mode' => 2,
2598 'st_nlink' => 3,'st_uid' => 4,'st_gid' => 5,
2599 'st_rdev' => 6,'st_size' => 7,'st_blksize' => 8,
2600 'st_blocks' => 9,'st_atime' => 10,'st_mtime' => 11,
2601 'st_ctime' => 12,'LinkFI' => 13,'st_flags' => 14,
2602 'data_stream' => 15);;
2605 my ($attrib,$ref_attrib)=@_;
2606 return $ref_attrib->[$attrib_name_id{$attrib}];
2610 { # $file = [listfiles.id, listfiles.Name, File.LStat, File.JobId]
2612 my ($file, $attrib)=@_;
2614 if (defined $attrib_name_id{$attrib}) {
2616 my @d = split(' ', $file->[2]) ; # TODO : cache this
2618 return from_base64($d[$attrib_name_id{$attrib}]);
2620 } elsif ($attrib eq 'jobid') {
2624 } elsif ($attrib eq 'name') {
2629 die "Attribute not known : $attrib.\n";
2633 # Return the jobid or attribute asked for a dir
2636 my ($self,$dir,$attrib)=@_;
2638 my @dir = split('/',$dir,-1);
2639 my $refdir=$self->{dirtree}->{$self->current_client};
2641 if (not defined $attrib_name_id{$attrib} and $attrib ne 'jobid')
2643 die "Attribute not known : $attrib.\n";
2646 foreach my $subdir (@dir)
2648 $refdir = $refdir->[0]->{$subdir};
2651 # $refdir is now the reference to the dir's array
2652 # Is the a jobid in @CurrentJobIds where the lstat is
2653 # defined (we'll search in reverse order)
2654 foreach my $jobid (reverse(sort {$a <=> $b } @{$self->{CurrentJobIds}}))
2656 if (defined $refdir->[1]->{$jobid} and $refdir->[1]->{$jobid} ne '1')
2658 if ($attrib eq 'jobid')
2664 my @attribs = parse_lstat($refdir->[1]->{$jobid});
2665 return $attribs[$attrib_name_id{$attrib}+1];
2670 return 0; # We cannot get a good attribute.
2671 # This directory is here for the sake of visibility
2676 # Base 64 functions, directly from recover.pl.
2678 # Karl Hakimian <hakimian@aha.com>
2679 # This section is also under GPL v2 or later.
2686 'A', 'B', 'C', 'D', 'E', 'F', 'G', 'H', 'I', 'J', 'K', 'L', 'M',
2687 'N', 'O', 'P', 'Q', 'R', 'S', 'T', 'U', 'V', 'W', 'X', 'Y', 'Z',
2688 'a', 'b', 'c', 'd', 'e', 'f', 'g', 'h', 'i', 'j', 'k', 'l', 'm',
2689 'n', 'o', 'p', 'q', 'r', 's', 't', 'u', 'v', 'w', 'x', 'y', 'z',
2690 '0', '1', '2', '3', '4', '5', '6', '7', '8', '9', '+', '/'
2692 @base64_map = (0) x 128;
2694 for (my $i=0; $i<64; $i++) {
2695 $base64_map[ord($base64_digits[$i])] = $i;
2710 if (substr($where, 0, 1) eq '-') {
2712 $where = substr($where, 1);
2715 while ($where ne '') {
2717 my $d = substr($where, 0, 1);
2718 $val += $base64_map[ord(substr($where, 0, 1))];
2719 $where = substr($where, 1);
2727 my @attribs = split(' ',$lstat);
2728 foreach my $element (@attribs)
2730 $element = from_base64($element);
2737 ################################################################
2741 my $conf = "$ENV{HOME}/.brestore.conf" ;
2742 my $p = new Pref($conf);
2748 $glade_file = $p->{glade_file};
2750 foreach my $path ('','.','/usr/share/brestore','/usr/local/share/brestore') {
2751 if (-f "$path/$glade_file") {
2752 $glade_file = "$path/$glade_file" ;
2757 if ( -f $glade_file) {
2758 my $w = new DlgResto($p);
2761 my $widget = Gtk2::MessageDialog->new(undef, 'modal', 'error', 'close',
2762 "Can't find your brestore.glade (glade_file => '$glade_file')
2763 Please, edit your $conf to setup it." );
2765 $widget->signal_connect('destroy', sub { Gtk2->main_quit() ; });
2770 Gtk2->main; # Start Gtk2 main loop
2782 # Code pour trier les colonnes
2783 my $mod = $fileview->get_model();
2784 $mod->set_default_sort_func(sub {
2785 my ($model, $item1, $item2) = @_;
2786 my $a = $model->get($item1, 1); # récupération de la valeur de la 2ème
2787 my $b = $model->get($item2, 1); # colonne (indice 1)
2792 $fileview->set_headers_clickable(1);
2793 my $col = $fileview->get_column(1); # la colonne NOM, colonne numéro 2
2794 $col->signal_connect('clicked', sub {
2795 my ($colonne, $model) = @_;
2796 $model->set_sort_column_id (1, 'ascending');