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
  37 # Export all functions needed to be used by a simple
  38 # perl -Mscripts::functions -e '' script
  39 use Exporter;
  40 our @ISA = qw(Exporter);
  41 our @EXPORT =  qw(update_some_files create_many_files check_multiple_copies);
  42
  43 # open a directory and update all files
  44 sub update_some_files
  45 {
  46     my ($dest)=@_;
  47     my $t=rand();
  48     my $f;
  49     my $nb=0;
  50     print "Update files in $dest\n";
  51     opendir(DIR, $dest) || die "$!";
  52     map {
  53         $f = "$dest/$_";
  54         if (-f $f) {
  55             open(FP, ">$f") or die "$f $!";
  56             print FP "$t update $f\n";
  57             close(FP);
  58             $nb++;
  59         }
  60     } readdir(DIR);
  61     closedir DIR;
  62     print "$nb files updated\n";
  63 }
  64
  65 # create big number of files in a given directory
  66 # Inputs: dest  destination directory
  67 #         nb    number of file to create
  68 # Example:
  69 # perl -Mscripts::functions -e 'create_many_files("$cwd/files", 100000)'
  70 sub create_many_files
  71 {
  72     my ($dest, $nb) = @_;
  73     my $base;
  74     my $dir=$dest;
  75     $nb = $nb || 750000;
  76     mkdir $dest;
  77     $base = chr($nb % 26 + 65); # We use a base directory A-Z
  78
  79     # already done
  80     if (-f "$dest/$base/a${base}a750000aaa$base") {
  81         print "Files already created\n";
  82         return;
  83     }
  84
  85     # auto flush stdout for dots
  86     $| = 1;
  87     print "Create $nb files into $dest\n";
  88     for(my $i=0; $i < 26; $i++) {
  89         $base = chr($i + 65);
  90         mkdir("$dest/$base");
  91     }
  92     for(my $i=0; $i<=$nb; $i++) {
  93         $base = chr($i % 26 + 65);
  94         open(FP, ">$dest/$base/a${base}a${i}aaa$base") or die "$dest/$base $!";
  95         print FP "$i\n";
  96         close(FP);
  97
  98         open(FP, ">$dir/b${base}a${i}csq$base") or die "$dir $!";
  99         print FP "$base $i\n";
 100         close(FP);
 101
 102         if (!($i % 100)) {
 103             $dir = "$dest/$base/$base$i$base";
 104             mkdir $dir;
 105         }
 106         print "." if (!($i % 10000));
 107     }
 108     print "\n";
 109 }
 110
 111 # This test ensure that 'list copies' displays only each copy one time
 112 #
 113 # Input: read stream from stdin or with file list argument
 114 #        check the number of copies with the ARGV[1]
 115 # Output: exit(1) if something goes wrong and print error
 116 sub check_multiple_copies
 117 {
 118     my ($nb_to_found) = @_;
 119
 120     my $in_list_copies=0;       # are we or not in a list copies block
 121     my $nb_found=0;             # count the number of copies found
 122     my $ret = 0;
 123     my %seen;
 124
 125     while (my $l = <>)          # read all files to check
 126     {
 127         if ($l =~ /list copies/) {
 128             $in_list_copies=1;
 129             %seen = ();
 130             next;
 131         }
 132
 133         # not in a list copies anymore
 134         if ($in_list_copies && $l =~ /^ /) {
 135             $in_list_copies=0;
 136             next;
 137         }
 138
 139         # list copies ouput:
 140         # |     3 | Backup.2009-09-28 |  9 | DiskChangerMedia |
 141         if ($in_list_copies && $l =~ /^\|\s+\d+/) {
 142             my (undef, $jobid, undef, $copyid, undef) = split(/\s*\|\s*/, $l);
 143             if (exists $seen{$jobid}) {
 144                 print "ERROR: $jobid/$copyid already known as $seen{$jobid}\n";
 145                 $ret = 1;
 146             } else {
 147                 $seen{$jobid}=$copyid;
 148                 $nb_found++;
 149             }
 150         }
 151     }
 152
 153     # test the number of copies against the given arg
 154     if ($nb_to_found && ($nb_to_found != $nb_found)) {
 155         print "ERROR: Found wrong number of copies ",
 156               "($nb_to_found != $nb_found)\n";
 157         exit 1;
 158     }
 159
 160     exit $ret;
 161 }
 162
 163 1;