From c1f8cca7bc220e7db77a0415846bfd39a5693d9f Mon Sep 17 00:00:00 2001 From: Eric Bollengier Date: Tue, 22 Sep 2009 16:15:35 +0200 Subject: [PATCH] regress: Add small perl lib for speed testing --- regress/scripts/functions.pm | 102 +++++++++++++++++++++++++++++++++++ 1 file changed, 102 insertions(+) create mode 100644 regress/scripts/functions.pm diff --git a/regress/scripts/functions.pm b/regress/scripts/functions.pm new file mode 100644 index 0000000000..57fb3629b5 --- /dev/null +++ b/regress/scripts/functions.pm @@ -0,0 +1,102 @@ +################################################################ +use strict; + +=head1 LICENSE + + Bacula® - The Network Backup Solution + + Copyright (C) 2000-2009 Free Software Foundation Europe e.V. + + The main author of Bacula is Kern Sibbald, with contributions from + many others, a complete list can be found in the file AUTHORS. + + This program is Free Software; you can redistribute it and/or + modify it under the terms of version two of the GNU General Public + License as published by the Free Software Foundation plus additions + that are listed in the file LICENSE. + + This program is distributed in the hope that it will be useful, but + WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program; if not, write to the Free Software + Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA + 02110-1301, USA. + + Bacula® is a registered trademark of Kern Sibbald. + The licensor of Bacula is the Free Software Foundation Europe + (FSFE), Fiduciary Program, Sumatrastrasse 25, 8006 Zurich, + Switzerland, email:ftf@fsfeurope.org. + +=cut + +package scripts::functions; +use Exporter; +our @ISA = qw(Exporter); +our @EXPORT = qw(update_some_files create_many_files); + +sub update_some_files +{ + my ($dest)=@_; + my $t=rand(); + my $f; + my $nb=0; + print "Update files in $dest\n"; + opendir(DIR, $dest) || die "$!"; + map { + $f = "$dest/$_"; + if (-f $f) { + open(FP, ">$f") or die "$f $!"; + print FP "$t update $f\n"; + close(FP); + $nb++; + } + } readdir(DIR); + closedir DIR; + print "$nb files updated\n"; +} + +sub create_many_files +{ + my ($dest, $nb) = @_; + my $base; + my $dir=$dest; + $nb = $nb || 750000; + mkdir $dest; + $base = chr($nb % 26 + 65); + + # already done + if (-f "$dest/$base/a${base}a750000aaa$base") { + print "Files already created\n"; + return; + } + + # auto flush stdout for dots + $| = 1; + print "Create $nb files into $dest\n"; + for(my $i=0; $i < 26; $i++) { + $base = chr($i + 65); + mkdir("$dest/$base"); + } + for(my $i=0; $i<=$nb; $i++) { + $base = chr($i % 26 + 65); + open(FP, ">$dest/$base/a${base}a${i}aaa$base") or die "$dest/$base $!"; + print FP "$i\n"; + close(FP); + + open(FP, ">$dir/b${base}a${i}csq$base") or die "$dir $!"; + print FP "$base $i\n"; + close(FP); + + if (!($i % 100)) { + $dir = "$dest/$base/$base$i$base"; + mkdir $dir; + } + print "." if (!($i % 10000)); + } + print "\n"; +} + +1; -- 2.39.5