git.sur5r.net Git - bacula/bacula/blob - regress/scripts/functions.pm

   1 ################################################################
   2 use strict;
   3
   4 =head1 LICENSE
   5
   6    Bacula® - The Network Backup Solution
   7
   8    Copyright (C) 2000-2009 Free Software Foundation Europe e.V.
   9
  10    The main author of Bacula is Kern Sibbald, with contributions from
  11    many others, a complete list can be found in the file AUTHORS.
  12
  13    This program is Free Software; you can redistribute it and/or
  14    modify it under the terms of version two of the GNU General Public
  15    License as published by the Free Software Foundation plus additions
  16    that are listed in the file LICENSE.
  17
  18    This program is distributed in the hope that it will be useful, but
  19    WITHOUT ANY WARRANTY; without even the implied warranty of
  20    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
  21    General Public License for more details.
  22
  23    You should have received a copy of the GNU General Public License
  24    along with this program; if not, write to the Free Software
  25    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
  26    02110-1301, USA.
  27
  28    Bacula® is a registered trademark of Kern Sibbald.
  29    The licensor of Bacula is the Free Software Foundation Europe
  30    (FSFE), Fiduciary Program, Sumatrastrasse 25, 8006 Zurich,
  31    Switzerland, email:ftf@fsfeurope.org.
  32
  33 =cut
  34
  35 package scripts::functions;
  36 # Export all functions needed to be used by a simple
  37 # perl -Mscripts::functions -e '' script
  38 use Exporter;
  39 our @ISA = qw(Exporter);
  40 our @EXPORT =  qw(update_some_files create_many_files check_multiple_copies
  41                   $cwd $bin $scripts $conf $rscripts $tmp $working
  42                   $db_name $db_user $db_password $src $tmpsrc);
  43
  44
  45 our ($cwd, $bin, $scripts, $conf, $rscripts, $tmp, $working,
  46      $db_name, $db_user, $db_password, $src, $tmpsrc);
  47
  48 BEGIN {
  49     # start by loading the ./config file
  50     my ($envar, $enval);
  51     if (! -f "./config") {
  52         die "Could not find ./config file\n";
  53     }
  54     # load the ./config file in a subshell doesn't allow to use "env" to display all variable
  55     open(IN, ". ./config; env |") or die "Could not run shell: $!\n";
  56     while ( my $l = <IN> ) {
  57         chomp ($l);
  58         ($envar,$enval) = split (/=/,$l,2);
  59         $ENV{$envar} = $enval;
  60     }
  61     close(IN);
  62     $cwd = `pwd`;
  63     chomp($cwd);
  64
  65     # set internal variable name and update environment variable
  66     $ENV{db_name} = $db_name = $ENV{db_name} || 'regress';
  67     $ENV{db_user} = $db_user = $ENV{db_user} || 'regress';
  68     $ENV{db_password} = $db_password = $ENV{db_password} || '';
  69
  70     $ENV{bin}      = $bin      =  $ENV{bin}      || "$cwd/bin";
  71     $ENV{tmp}      = $tmp      =  $ENV{tmp}      || "$cwd/tmp";
  72     $ENV{src}      = $src      =  $ENV{src}      || "$cwd/src";
  73     $ENV{conf}     = $conf     =  $ENV{conf}     || $bin;
  74     $ENV{scripts}  = $scripts  =  $ENV{scripts}  || $bin;
  75     $ENV{tmpsrc}   = $tmpsrc   =  $ENV{tmpsrc}   || "$cwd/tmp/build";
  76     $ENV{working}  = $working  =  $ENV{working}  || "$cwd/working";
  77     $ENV{rscripts} = $rscripts =  $ENV{rscripts} || "$cwd/scripts";
  78 }
  79
  80 # open a directory and update all files
  81 sub update_some_files
  82 {
  83     my ($dest)=@_;
  84     my $t=rand();
  85     my $f;
  86     my $nb=0;
  87     print "Update files in $dest\n";
  88     opendir(DIR, $dest) || die "$!";
  89     map {
  90         $f = "$dest/$_";
  91         if (-f $f) {
  92             open(FP, ">$f") or die "$f $!";
  93             print FP "$t update $f\n";
  94             close(FP);
  95             $nb++;
  96         }
  97     } readdir(DIR);
  98     closedir DIR;
  99     print "$nb files updated\n";
 100 }
 101
 102 # create big number of files in a given directory
 103 # Inputs: dest  destination directory
 104 #         nb    number of file to create
 105 # Example:
 106 # perl -Mscripts::functions -e 'create_many_files("$cwd/files", 100000)'
 107 sub create_many_files
 108 {
 109     my ($dest, $nb) = @_;
 110     my $base;
 111     my $dir=$dest;
 112     $nb = $nb || 750000;
 113     mkdir $dest;
 114     $base = chr($nb % 26 + 65); # We use a base directory A-Z
 115
 116     # already done
 117     if (-f "$dest/$base/a${base}a${nb}aaa${base}") {
 118         print "Files already created\n";
 119         return;
 120     }
 121
 122     # auto flush stdout for dots
 123     $| = 1;
 124     print "Create $nb files into $dest\n";
 125     for(my $i=0; $i < 26; $i++) {
 126         $base = chr($i + 65);
 127         mkdir("$dest/$base") if (! -d "$dest/$base");
 128     }
 129     for(my $i=0; $i<=$nb; $i++) {
 130         $base = chr($i % 26 + 65);
 131         open(FP, ">$dest/$base/a${base}a${i}aaa$base") or die "$dest/$base $!";
 132         print FP "$i\n";
 133         close(FP);
 134
 135         open(FP, ">$dir/b${base}a${i}csq$base") or die "$dir $!";
 136         print FP "$base $i\n";
 137         close(FP);
 138
 139         if (!($i % 100)) {
 140             $dir = "$dest/$base/$base$i$base";
 141             mkdir $dir;
 142         }
 143         print "." if (!($i % 10000));
 144     }
 145     print "\n";
 146 }
 147
 148 sub check_encoding
 149 {
 150     if (grep {/Wanted SQL_ASCII, got UTF8/}
 151         `${bin}/bacula-dir -d50 -t -c ${conf}/bacula-dir.conf 2>&1`)
 152     {
 153         print "Found database encoding problem, please modify the ",
 154               "database encoding (SQL_ASCII)\n";
 155         exit 1;
 156     }
 157 }
 158
 159 # This test ensure that 'list copies' displays only each copy one time
 160 #
 161 # Input: read stream from stdin or with file list argument
 162 #        check the number of copies with the ARGV[1]
 163 # Output: exit(1) if something goes wrong and print error
 164 sub check_multiple_copies
 165 {
 166     my ($nb_to_found) = @_;
 167
 168     my $in_list_copies=0;       # are we or not in a list copies block
 169     my $nb_found=0;             # count the number of copies found
 170     my $ret = 0;
 171     my %seen;
 172
 173     while (my $l = <>)          # read all files to check
 174     {
 175         if ($l =~ /list copies/) {
 176             $in_list_copies=1;
 177             %seen = ();
 178             next;
 179         }
 180
 181         # not in a list copies anymore
 182         if ($in_list_copies && $l =~ /^ /) {
 183             $in_list_copies=0;
 184             next;
 185         }
 186
 187         # list copies ouput:
 188         # |     3 | Backup.2009-09-28 |  9 | DiskChangerMedia |
 189         if ($in_list_copies && $l =~ /^\|\s+\d+/) {
 190             my (undef, $jobid, undef, $copyid, undef) = split(/\s*\|\s*/, $l);
 191             if (exists $seen{$jobid}) {
 192                 print "ERROR: $jobid/$copyid already known as $seen{$jobid}\n";
 193                 $ret = 1;
 194             } else {
 195                 $seen{$jobid}=$copyid;
 196                 $nb_found++;
 197             }
 198         }
 199     }
 200
 201     # test the number of copies against the given arg
 202     if ($nb_to_found && ($nb_to_found != $nb_found)) {
 203         print "ERROR: Found wrong number of copies ",
 204               "($nb_to_found != $nb_found)\n";
 205         exit 1;
 206     }
 207
 208     exit $ret;
 209 }
 210
 211 1;