]> git.sur5r.net Git - bacula/bacula/blobdiff - regress/scripts/functions.pm
regress: add a start message in regress-win32.pl
[bacula/bacula] / regress / scripts / functions.pm
index 337074791d4d2e50ea410de3cb4546a31c6a12d4..9fb4416cde66a1314292254bcbf22ad8e8b5d525 100644 (file)
@@ -37,11 +37,14 @@ package scripts::functions;
 # perl -Mscripts::functions -e '' script
 use Exporter;
 our @ISA = qw(Exporter);
-our @EXPORT =  qw(update_some_files create_many_files check_multiple_copies
-                  update_client $HOST $BASEPORT add_to_backup_list check_volume_size
-                  create_many_dirs cleanup start_bacula stop_bacula
-                  check_min_volume_size check_max_volume_size $estat $bstat $rstat $zstat
-                  $cwd $bin $scripts $conf $rscripts $tmp $working extract_resource
+
+our @EXPORT = qw(update_some_files create_many_files check_multiple_copies
+                  update_client $HOST $BASEPORT add_to_backup_list
+                  check_volume_size create_many_dirs cleanup start_bacula
+                  stop_bacula get_resource set_maximum_concurrent_jobs get_time
+                  add_attribute check_prune_list check_min_volume_size
+                  check_max_volume_size $estat $bstat $rstat $zstat $cwd $bin
+                  $scripts $conf $rscripts $tmp $working extract_resource
                   $db_name $db_user $db_password $src $tmpsrc);
 
 
@@ -100,9 +103,15 @@ sub cleanup
 
 sub start_bacula
 {
+    my $ret;
     $ENV{LANG}='C';
     system("$bin/bacula start");
-    return $? == 0;
+    $ret = $? == 0;
+    open(FP, ">$tmp/bcmd");
+    print FP "sql\ntruncate client_group;\ntruncate client_group_member;\nupdate Media set LocationId=0;\ntruncate location;\n\n";
+    close(FP);
+    system("cat $tmp/bcmd | $bin/bconsole >/dev/null");
+    return $ret;
 }
 
 sub stop_bacula
@@ -112,18 +121,27 @@ sub stop_bacula
     return $? == 0;
 }
 
-sub extract_resource
+sub get_resource
 {
     my ($file, $type, $name) = @_;
-
+    my $ret;
     open(FP, $file) or die "Can't open $file";
     my $content = join("", <FP>);
     
     if ($content =~ m/(^$type {[^}]+?Name\s*=\s*"?$name"?[^}]+?^})/ms) {
-        print $1, "\n";
+        $ret = $1;
     }
 
     close(FP);
+    return $ret;
+}
+
+sub extract_resource
+{
+    my $ret = get_resource(@_);
+    if ($ret) {
+        print $ret, "\n";
+    }
 }
 
 sub check_min_volume_size
@@ -331,6 +349,146 @@ sub check_encoding
     }
 }
 
+# You can change the maximum concurrent jobs for any config file
+# If specified, you can change only one Resource or one type of
+# resource at the time (optional)
+#  set_maximum_concurrent_jobs('$conf/bacula-dir.conf', 100);
+#  set_maximum_concurrent_jobs('$conf/bacula-dir.conf', 100, 'Director');
+#  set_maximum_concurrent_jobs('$conf/bacula-dir.conf', 100, 'Device', 'Drive-0');
+sub set_maximum_concurrent_jobs
+{
+    my ($file, $nb, $obj, $name) = @_;
+
+    die "Can't get new maximumconcurrentjobs" 
+        unless ($nb);
+
+    add_attribute($file, "Maximum Concurrent Jobs", $nb, $obj, $name);
+}
+
+
+# You can add option to a resource
+#  add_attribute('$conf/bacula-dir.conf', 'FDTimeout', 1600, 'Director');
+#  add_attribute('$conf/bacula-dir.conf', 'FDTimeout', 1600, 'Storage', 'FileStorage');
+sub add_attribute
+{
+    my ($file, $attr, $value, $obj, $name) = @_;
+    my ($cur_obj, $cur_name, $done);
+
+    open(FP, ">$tmp/1.$$") or die "Can't write to $tmp/1.$$";
+    open(SRC, $file) or die "Can't open $file";
+    while (my $l = <SRC>)
+    {
+        if ($l =~ /^#/) {
+            print FP $l;
+            next;
+        }
+
+        if ($l =~ /^(\w+) {/) {
+            $cur_obj = $1;
+            $done=0;
+        }
+
+        if ($l =~ /\Q$attr\E/i) {
+            if (!$obj || $cur_obj eq $obj) {
+                if (!$name || $cur_name eq $name) {
+                    $l =~ s/\Q$attr\E\s*=\s*.+/$attr = $value/ig;
+                    $done=1
+                }
+            }
+        }
+
+        if ($l =~ /Name\s*=\s*"?([\w\d\.-]+)"?/i) {
+            $cur_name = $1;
+        }
+
+        if ($l =~ /^}/) {
+            if (!$done) {
+                if ($cur_obj eq $obj) {
+                    if (!$name || $cur_name eq $name) {
+                        $l = "  $attr = $value\n$l";
+                    }
+                }
+            }
+            $cur_name = $cur_obj = undef;
+        }
+        print FP $l;
+    }
+    close(SRC);
+    close(FP);
+    copy("$tmp/1.$$", $file) or die "Can't copy $tmp/1.$$ to $file";
+}
+
+# This test the list jobs output to check differences
+# Input: read file argument
+#        check if all jobids in argument are present in the first
+#        'list jobs' and not present in the second
+# Output: exit(1) if something goes wrong and print error
+sub check_prune_list
+{
+    my $f = shift;
+    my %to_check = map { $_ => 1} @_;
+    my %seen;
+    my $in_list_jobs=0;
+    my $nb_list_job=0;
+    my $nb = scalar(@_);
+    open(FP, $f) or die "Can't open $f $!";
+    while (my $l = <FP>)          # read all files to check
+    {
+        if ($l =~ /list jobs/) {
+            $in_list_jobs=1;
+            $nb_list_job++;
+            
+            if ($nb_list_job == 2) {
+                foreach my $jobid (keys %to_check) {
+                    if (!$seen{$jobid}) {
+                        print "ERROR: in $f, can't find $jobid in first 'list jobs'\n";
+                        exit 1;
+                    }
+                }
+            }
+            next;
+        }
+        if ($nb_list_job == 0) {
+            next;
+        }
+        if ($l =~ /Pruned (\d+) Job for client/) {
+            if ($1 != $nb) {
+                print "ERROR: in $f, Prune command returns $1 jobs, want $nb\n";
+                exit 1;
+            }
+        }
+
+        if ($l =~ /No Jobs found to prune/) {
+           if ($nb != 0) {
+                print "ERROR: in $f, Prune command returns 0 job, want $nb\n";
+                exit 1;
+            }            
+        }
+
+        # list jobs ouput:
+        # | 1 | NightlySave | 2010-06-16 22:43:05 | B | F | 27 | 4173577 | T |
+        if ($l =~ /^\|\s+(\d+)/) {
+            if ($nb_list_job == 1) {
+                $seen{$1}=1;
+            } else {
+                delete $seen{$1};
+            }
+        }
+    }
+    close(FP);
+    foreach my $jobid (keys %to_check) {
+        if (!$seen{$jobid}) {
+            print "ERROR: in $f, $jobid in still present in the 2nd 'list jobs'\n";
+            exit 1;
+        }
+    }
+    if ($nb_list_job != 2) {
+        print "ERROR: in $f, not enough 'list jobs'\n";
+        exit 1;
+    }
+    exit 0;
+}
+
 # This test ensure that 'list copies' displays only each copy one time
 #
 # Input: read stream from stdin or with file list argument
@@ -383,4 +541,11 @@ sub check_multiple_copies
     exit $ret;
 }
 
+use POSIX qw/strftime/;
+sub get_time
+{
+    my ($sec) = @_;
+    print strftime('%F %T', localtime(time+$sec)), "\n";
+}
+
 1;