Properties gesetzt, Unsinn gelöscht

git-svn-id: http://svn.brehm-online.com/svn/cookbook/trunk@4 191103c4-1d37-0410-b3e5-d8c2315c0aac

diff --git a/lib/CookBook/Common.pm.bak b/lib/CookBook/Common.pm.bak
deleted file mode 100644 (file)
index 27455fb..0000000
--- a/lib/CookBook/Common.pm.bak
+++ /dev/null
@@ -1,429 +0,0 @@
-package CookBook::Common;
-
-# $Id: Common.pm 69 2007-06-27 12:55:47Z fbrehm $
-# $URL: http://maria.technik.berlin.strato.de:8080/svn-cit/trunk/CIT/lib/CIT/Common.pm $
-
-=head1 NAME
-
-CookBook::Common
-
-=head1 DESCRIPTION
-
-Modul fuer 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;
-use Cwd;
-use File::Spec;
-
-use Carp qw(:DEFAULT cluck);
-
-our @ISA    = qw(Exporter);
-our @EXPORT = qw(
-  &verbose
-  &canon_filename
-  &common_debug
-  &common_error
-  &common_notice
-  &get_output_string
-  &escape_html
-  &home_dir
-  &to_bool
-  &to_float
-  &to_int
-);
-
-$Data::Dumper::Indent   = 1;
-$Data::Dumper::Sortkeys = 1;
-
-our $COOKBOOK_VERSION = "1.1";
-our $AUTHOR           = 'Frank Brehm <frank@brehm-online.com>';
-
-our $env_home_name = 'COOKBOOK_HOME';
-
-my $Revis = <<'ENDE';
-    $Revision: 69 $
-ENDE
-$Revis =~ s/^.*:\s*(\S+)\s*\$.*/$1/s;
-our $VERSION = $COOKBOOK_VERSION . "." . $Revis;
-
-my $verbose = 0;
-my $mark    = 'CookBook';
-
-#------------------------------------------------------------------------------------------
-
-=head1 Funktionen
-
-Alle hier definierten Funktionen werden exportiert.
-
-#------------------------------------------------------------------------------------------
-
-=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;
-
-} ## end sub verbose
-
-##------------------------------------------------------------------------------------------
-
-=head2 mark( [$new_mark] )
-
-Gibt den aktuellen Log-Marker zurueck bzw. setzt einen neuen, wenn er übergeben wurde.
-
-=cut
-
-sub mark {
-
-    my $new_mark = shift;
-
-    if ( $new_mark and $new_mark !~ /^\s*$/ ) {
-        $new_mark =~ s/^\s+//;
-        $new_mark =~ s/\s+$//s;
-        $mark = $new_mark;
-    }
-
-    return $mark;
-
-}
-
-#------------------------------------------------------------------------------------------
-
-=head2 home_dir()
-
-Gibt den Namen des Verzeichnisses der Software-Installation zurueck,
-die aus der Umgebungsvariablen C<COOKBOOK_HOME> entnommen wird.
-
-Wenn die Umgebungsvariable nicht gesetzt ist bzw. auf ein nicht vorhandenes Verzeichnis
-zeigt, wird undef zurueckgegeben.
-
-=cut
-
-sub home_dir {
-
-    my $K =  __PACKAGE__ . "::home_dir(): ";
-
-    unless ( $ENV{$env_home_name} ) {
-        common_notice( $K . "Umgebungsvariable '" . $env_home_name . "' nicht gesetzt." );
-        return undef;
-    }
-
-    unless ( File::Spec->file_name_is_absolute( $ENV{$env_home_name} ) ) {
-        common_notice( $K . "Umgebungsvariable '" . $env_home_name . "' (" . $ENV{$env_home_name} . ") ist keine absolute Pfadangabe." );
-        return undef;
-    }
-
-    unless ( -d $ENV{$env_home_name} ) {
-        common_notice( $K . "Umgebungsvariable '" . $env_home_name . "' zeigt auf nicht vorhandenes Verzeichnis '" . $ENV{$env_home_name} . "'." );
-        return undef;
-    }
-
-    return File::Spec->canonpath( $ENV{$env_home_name} );
-
-} ## end sub home_dir
-
-#------------------------------------------------------------------------------------------
-
-=head2 canon_filename( @directories, $filename )
-
-Kettet die uebergebenen Verzeichnisnamen und Dateinamen aneinander.
-Wenn der resultierende Pfad nicht absolut ist, wird home_dir() davorgehaengt.
-
-=cut
-
-sub canon_filename {
-
-    my @path = @_;
-    my $K    = __PACKAGE__ . "::canon_filename(): ";
-
-    unless ( scalar(@path) ) {
-        common_notice( $K . "Keine Argumente uebergeben." );
-        return undef;
-    }
-
-    my $file = File::Spec->catfile(@path);
-    unless ( File::Spec->file_name_is_absolute($file) ) {
-        my $home = home_dir();
-        return undef unless $home;
-        $file = File::Spec->catfile( $home, @path );
-    }
-
-    return $file;
-
-} ## end sub canon_filename
-
-#---------------------------------------------------------------------------
-
-=head2 common_debug( $debug_level, @messages )
-
-Allgemeine Debug-Funktion (wenn das Log-Objekt noch nicht existieren sollte)
-
-=cut
-
-sub common_debug {
-
-    my $debug_level = shift;
-
-    $debug_level = to_int($debug_level);
-    $debug_level = 1 unless defined $debug_level;
-
-    return if $debug_level > $verbose;
-
-    my $text = get_output_string(@_);
-    return if $text eq '';
-
-    print $mark . " (debug" . $debug_level . "): " . $text . "\n";
-
-    return;
-
-} ## end sub common_debug
-
-#---------------------------------------------------------------------------
-
-sub get_output_string {
-       
-    my $text = '';
-    for (@_) {
-        next unless defined $_;
-        my $t = ref($_) ? Dumper($_) : $_;
-        next if $t eq '';
-        $text .= $t;
-    }
-
-    $text =~ s/^\s+//;
-    $text =~ s/\s+$//s;
-    return $text;
-       
-}
-
-#---------------------------------------------------------------------------
-
-=head2 common_error( $error_level, @messages )
-
-Allgemeine Error-Warn-Funktion (wenn das Log-Objekt noch nicht existieren sollte)
-
-=cut
-
-sub common_error {
-
-    my $error_level = shift;
-
-    $error_level ||= 'error';
-
-    my $text = get_output_string(@_);
-
-    $text = "unbekannter Fehler" if $text eq '';
-
-    warn $mark . "(" . $error_level . "): " . $text . "\n";
-
-    return;
-
-} ## end sub common_error
-
-#---------------------------------------------------------------------------
-
-=head2 common_notice( @messages )
-
-Allgemeine Warnmeldung.
-
-=cut
-
-sub common_notice {
-
-    my $text = get_output_string(@_);
-    $text = "unbekannter Fehler" if $text eq '';
-
-    warn $mark . ": " . $text . "\n";
-
-    return;
-
-} ## end sub common_notice
-
-#------------------------------------------------------------------------------------------
-
-=head2 to_bool( $wert )
-
-Wandelt den uebergebenen Scalar sicher in einen Wahrheitswert (0 oder 1) um.
-
-=cut
-
-sub to_bool {
-
-    my $val = shift;
-
-    return 0 unless defined $val;
-    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;
-
-} ## end sub to_bool
-
-#------------------------------------------------------------------------------------------
-
-=head2 to_float( $wert )
-
-Wandelt den uebergebenen Scalar sicher in eine Float-Zahl um.
-
-Falls der uebergebene Wert keine gueltige Zahl ist, wird undef zurueckgegeben.
-
-=cut
-
-sub to_float {
-
-    my $val = shift;
-
-    return undef unless defined($val) and $val =~ /\d/;
-
-    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 );
-
-} ## end sub to_float
-
-#------------------------------------------------------------------------------------------
-
-=head2 to_int( $wert, $signed )
-
-Wandelt den uebergebenen Wert sicher in eine Integer-Zahl um.
-
-Dabei legt der optionale logische Parameter $signed fest, ob auch
-vorzeichenbehaftete Werte zulaessig sind.
-
-Wenn keine gueltige Zahl uebergeben wird, wird undef zurueckgegeben.
-
-=cut
-
-sub to_int {
-
-    my $val    = shift;
-    my $signed = shift;
-
-    return undef unless defined $val;
-    unless ( $val =~ /\d/ ) {
-        return undef;
-    }
-
-    if ($signed) {
-        $val =~ /^[^\d-]*(?:(-)\s*)?(\d+)/;
-        $val = ( defined $1 ? $1 : '' ) . $2;
-    }
-    else {
-        $val =~ /^\D*(\d+)/;
-        $val = $1;
-    }
-
-    return $val + 0;
-
-} ## end sub to_int
-
-#------------------------------------------------------------------------------------------
-
-=head2 escape_html( $text )
-
-Maskiert alle '&', '<', '>' und '"' im uebergebenen Text durch entsprechende
-HTML-Entities.
-
-Entnommen dem Modul L<CGI::Util>.
-
-=cut
-
-sub escape_html {
-
-    return unless defined( my $toencode = shift );
-
-    $toencode =~ s{&}{&amp;}gso;
-    $toencode =~ s{<}{&lt;}gso;
-    $toencode =~ s{>}{&gt;}gso;
-    $toencode =~ s{\"}{&quot;}gso;
-
-# Doesn't work.  Can't work.  forget it.
-#    $toencode =~ s{\x8b}{&#139;}gso;
-#    $toencode =~ s{\x9b}{&#155;}gso;
-
-    $toencode;
-
-}
-
-#------------------------------------------------------------------------------------------
-
-1;
-
-#------------------------------------------------------------------------------------------
-
-__END__