From: Frank Brehm Date: Tue, 7 Aug 2007 16:02:54 +0000 (+0000) Subject: Properties gesetzt, Unsinn gelöscht X-Git-Url: https://git.uhu-banane.org/?a=commitdiff_plain;h=839445aa715485f2e088965616e79a2b35c19e5d;p=cookbook.git 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 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 '; - -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 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. - -=cut - -sub escape_html { - - return unless defined( my $toencode = shift ); - - $toencode =~ s{&}{&}gso; - $toencode =~ s{<}{<}gso; - $toencode =~ s{>}{>}gso; - $toencode =~ s{\"}{"}gso; - -# Doesn't work. Can't work. forget it. -# $toencode =~ s{\x8b}{‹}gso; -# $toencode =~ s{\x9b}{›}gso; - - $toencode; - -} - -#------------------------------------------------------------------------------------------ - -1; - -#------------------------------------------------------------------------------------------ - -__END__