Neu dazu

diff --git a/LogRotate/Common.pm b/LogRotate/Common.pm
new file mode 100644 (file)
index 0000000..1e760f0
--- /dev/null
+++ b/LogRotate/Common.pm
@@ -0,0 +1,304 @@
+package LogRotate::Common;
+
+# $Id$
+# $URL$
+
+=head1 NAME
+
+BsAgent::Common
+
+=head1 DESCRIPTION
+
+Modul für allgemeine Aufgaben, zum Beispiel Verbose-Level usw.
+
+Dieses Modul sollte von allen Scripten und Modulen verwendet werden.
+
+=cut
+
+#---------------------------------------------------------------------------
+
+use strict;
+use warnings;
+use Exporter;
+use Data::Dumper;
+
+our @ISA = qw(Exporter);
+our @EXPORT = qw(
+  &human2byte
+  &parts
+  &verbose
+  &message_string
+  &to_bool
+  &to_float
+  &to_int
+);
+
+sub human2byte($);
+sub parts($);
+sub verbose(;$);
+sub to_bool($);
+sub to_float($);
+sub to_int($;$);
+
+our $LOGROTATE_VERSION = "2.0";
+
+my $Revis = <<'ENDE';
+ $Revision$
+ENDE
+$Revis =~ s/^.*:\s*(\S+)\s*\$.*/$1/s;
+our $VERSION = $LOGROTATE_VERSION . "." . $Revis;
+
+if( $ENV{"LANG"} and $ENV{"LANG"} =~ /utf-8/i and $] <= 5.008 and $] > 5.006 ) {
+  print warn "WARNING: your system is set to UTF-8 and your perl version might not support this - this might result in malfunction\n";
+}
+
+my $verbose = 0;
+
+#----------------------------------------------------------------------------------------
+
+END {
+  my $p = __PACKAGE__ . "::END(): ";
+  print $p . " endet.\n" if $verbose;
+}
+
+##########################################################################################
+
+=head1 Funktionen
+
+=cut
+
+#------------------------------------------------------------------------------------------
+
+=head2 human2byte( $wert )
+
+Wandelt eine Bytzahl, die fuer den Menschen lesbar ist, in einen Integer-Wert von Bytes um.
+
+Z.Bsp.:
+
+  '10 KByte' => 10240
+
+=cut
+
+sub human2byte($) {
+
+  my $val = shift;
+  my $p = $verbose ? __PACKAGE__ . "::human2byte(): " : "";
+
+  return undef unless defined $val;
+  print $p . "aufgerufen mit '" . $val . "'.\n" if $verbose > 5;
+  return 0 if $val =~ /^\s*$/;
+
+  my ( $unit, $factor );
+
+  if ( $val =~ /^\s*(\d+(?:\.\d*)?)\s*(?:([kmg])(?:b|byte)?)?\s*$/i ) {
+    $factor = 1;
+    $val = $1 + 0;
+    $unit = lc( $2 || 'b' );
+    if ( $unit eq 'k' ) {
+      $factor = 1024;
+    } elsif ( $unit eq 'm' ) {
+      $factor = 1024 * 1024;
+    } elsif ( $unit eq 'g' ) {
+      $factor = 1024 * 1024 * 1024;
+    }
+    print $p . "Faktor fuer '$unit': " . $factor . "'.\n" if $verbose > 5;
+    $val = int( $val * $factor );
+  } else {
+    warn $p . "Ungueltige Byte-Angabe: '$val'.\n";
+    $val = undef;
+  }
+
+  return $val;
+
+}
+
+#------------------------------------------------------------------------------------
+
+=head2 parts( $string )
+
+Zerlegt einen String an Whitespaces in seine Bestandteile unter Beachtung
+von Quotierung und gibt diese als Array zurueck.
+
+=cut
+
+sub parts($) {
+
+  my $p = verbose() ? __PACKAGE__ . "::parts(): " : "";
+
+  my $term  = shift;
+  my @Parts = ();
+  my $part;
+
+  while ( $term =~ /"([^"\\]*(?:\\.[^"\\]*)*)"|(\S+)/g ) {
+    $part = $1 || $2;
+    $part =~ s/\\"/"/g;
+    push @Parts, $part;
+  }
+
+  return @Parts;
+
+}
+
+#------------------------------------------------------------------------------------------
+
+=head2 to_bool( $wert )
+
+Wandelt den uebergebenen Scalar sicher in einen Wahrheitswert (0 oder 1) um.
+
+=cut
+
+sub to_bool($) {
+
+  my $val = shift;
+  my $p = verbose() ? __PACKAGE__ . "::to_bool(): " : "";
+
+  return 0 unless defined $val;
+  print $p . "aufgerufen mit '" . $val . "'.\n" if verbose() > 5;
+  return 0 if $val =~ /^\s*$/;
+
+  if ( $val =~ /^\s*y(?:es?)?/i or
+       $val =~ /^\s*ja?/i or
+       $val =~ /^\s*[wt]\s*$/i or
+       $val =~ /^\s*on\s*$/i or
+       $val =~ /^\s*wahr|true/i ) {
+    return 1;
+  }
+
+  if ( $val =~ /^\s*no?/i or
+       $val =~ /^\s*ne(?:in?)?/i or
+       $val =~ /^\s*f\s*$/i or
+       $val =~ /^\s*off\s*$/i or
+       $val =~ /^\s*falsch|false/i ) {
+    return 0;
+  }
+
+  my $intval = to_int $val;
+  if ( defined $intval ) {
+    return $intval ? 1 : 0;
+  }
+
+  return $val ? 1 : 0;
+
+}
+
+#------------------------------------------------------------------------------------------
+
+=head2 to_float( $wert )
+
+Wandelt den uebergebenen Scalar sicher in eine Float-Zahl um.
+
+Falls der uebergebene Wert keine gueltige Zahl ist, wird undef zurückgegeben.
+
+=cut
+
+sub to_float($) {
+
+  my $val = shift;
+  my $p = verbose() ? __PACKAGE__ . "::to_float(): " : "";
+
+  return undef unless defined( $val ) and $val =~ /\d/;
+  print $p . "aufgerufen mit '" . $val . "'.\n" if verbose() > 5;
+
+  my $ts = ",";
+  my $ds = ".";
+
+  if ( ( $val =~ /\d,/ and $val !~ /\d\./ ) or
+       ( $val =~ /\d\.\d\d\d\./ ) or
+       ( $val =~ /\d\.\d\d\d,/ ) ) {
+    $ds = ",";
+    $ts = ".";
+  }
+
+  $val =~ s/\Q$ts\E//g;
+  $val =~ s/\Q$ds\E/\./g;
+
+  return ( $val + 0 );
+
+}
+
+#------------------------------------------------------------------------------------------
+
+=head2 to_int( $wert, $signed )
+
+Wandelt den übergebenen Wert sicher in eine Integer-Zahl um.
+
+Dabei legt der optionale logische Parameter $signed fest, ob auch
+vorzeichenbehaftete Werte zulässig sind.
+
+Wenn keine gültige Zahl übergeben wird, wird undef zurückgegeben.
+
+=cut
+
+sub to_int($;$) {
+
+  my $val = shift;
+  my $signed = shift;
+  my $p = verbose() ? __PACKAGE__ . "::to_int(): " : "";
+
+  return undef unless defined $val;
+  print $p . "aufgerufen mit '" . $val . "'.\n" if verbose() > 5;
+  unless ( $val =~ /\d/ ) {
+    return undef;
+  }
+
+  if ( $signed ) {
+    $val =~ s/.*((-\s*)?\d+).*/$1$2/;
+  } else {
+    $val =~ s/.*(\d+).*/$1/;
+  }
+  print $p . "Neuer Wert: '" . ( defined($val) ? $val : "<undef>" ) . "'.\n" if verbose() > 5;
+
+  return $val + 0;
+
+}
+
+#------------------------------------------------------------------------------------------
+
+=head2 verbose( $new_verbose_level )
+
+Setzt bzw. gibt den Verbose-Level des aktuellen Scripts zurueck.
+
+Typische Werte:
+
+=over 4
+
+=item I<0>:
+
+Keinerlei Ausgaben.
+
+=item I<1>:
+
+Ausgabe der wichtigsten Aktionen des aktuellen Scripts (sollte eigentlich Standard sein).
+
+.
+.
+.
+
+=item I<6>:
+
+Ausfuehrlichstes Geplapper bis zum Gehtnichtmehr.
+
+=back
+
+=cut
+
+sub verbose(;$) {
+
+  my $new_verbose_level = shift;
+
+  if ( defined $new_verbose_level and $new_verbose_level =~ /^\d+$/ ) {
+    $verbose = $new_verbose_level;
+  }
+
+  return $verbose;
+
+}
+
+#------------------------------------------------------------------------------------------
+
+1;
+
+#------------------------------------------------------------------------------------------
+
+__END__
+