From: Eric Bollengier <eric@eb.homelinux.org>
Date: Tue, 22 Sep 2009 14:15:35 +0000 (+0200)
Subject: regress: Add small perl lib for speed testing
X-Git-Tag: Release-5.0.0~299^2~25
X-Git-Url: https://git.sur5r.net/?a=commitdiff_plain;h=66ad6c6aa0a048f26983ff8e2b9cee5ebe40a959;p=bacula%2Fbacula

regress: Add small perl lib for speed testing
---

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;