is_unix()_tabify($string,%options)#!/usr/bin/perl # Automatic POD-making requires that :-( package ServDoc; #----------------------------------------------------------------------
ServDoc - common procs for ServDoc-Modules
$Id: ServDoc.pm,v 1.44 2004/02/22 21:23:29 uherbst Exp $
use ServDoc;
ServDoc_debug($feature,$options,$intensity,$debugtext); $options = process_cmdline($options);
report_string ($title,$short_desc,$long_desc,$text); report_cmd ($title,$short_desc,$long_desc,$cmd); report_file ($title,$short_desc,$long_desc,$file); report_dir ($title,$short_desc,$long_desc,$dir);
@files = listdir("/path/to/dir");
$text = readfile("/path/to/file");
$fullcmd = find_path ( "httpd" [,@DIRLIST] );
@procs = ps_grep ( "httpd" ); $procs = get_proc_info( "xxx" );
$output = do_cmd("cmd xxx");
if (!report_allowed(%options)) {
print "you aren't allowed to do that\n";
}
if (is_unix()) { do_something_unix_special; }
if (are_we_GID(23)) { do_something_special_for_group_23; }
print array2table(@array);
print byte2hrn(537634,'K');
print output_i18n($message_hash,'messagekey');
print i18n_mesg($key);
report_i18n('report-type','key',$output);
print i18n_mesg(i18n_std('running','testprog');
In this perlmodule are some common used procedures for almost every ServDoc-module.
The most used procs will be report_string, report_cmd and report_file.
#---------------------------------------------------------------------- require Exporter; use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION); use English; use Getopt::Long; # command line options # Data::Dumper is not included in standard perl, # but it is VERY helpful in debugging complex # data structures. BEGIN { $HAS_DATA_DUMPER = 0; eval "use Data::Dumper"; if ( $@ eq "" ) { $HAS_DATA_DUMPER = 1 } } @ISA = qw(Exporter); # Which function are public ? @EXPORT = qw( ServDoc_debug report_string report_cmd report_file report_dir process_cmdline listdir readfile ps_grep get_proc_info is_unix do_cmd report_allowed find_path are_we_GID output_i18n i18n_mesg report_i18n i18n_std array2table byte2hrn ); # CVS (and RCS) uses a version numbering style, # which isn't compatible with perl's # versioning-style for modules. # This transformation is copied from LWP/Simple.pm $VERSION = sprintf( "%d.%02d", q$Revision: 1.44 $ =~ /(\d+)\.(\d+)/ ); #---------------------------------------------------------------------- # Here come the Language hashes for ServDoc.pm my $output_i18n_sd_pm; # Format: # Get the appropriate message for your message with # $output_i18n->{<LANG>}->{message}; # Look at the documentation for output_i18n %{$output_i18n_sd_pm->{en}}= ( newlines_in_title => "You have newlines in title %s!", unsufficent_rights => "Unsufficents rights for '%s'", cmd_not_exec => "command '%s' isn't executable or doesn't exist in PATH", rc => "RC from '%s': %i", uid_not_correct => "UID '%s' isn't correct for '%s'", cmd_timeout => "cmd '%s' timed out (timeout=%s sec.)", unknown_tab => "Unknown tab-option: '%s'", cmd_not_found => "Executable '%s' not found", emtpy_columns => "Empty columns: %s", unsupported_os => "OS not supported: %s", undefined_mesg => "Message not defined: '%s'", # and now some standard messages running => "%s is running.", filecontent => "look at '%s'", cmdout => "Output from '%s'", # OK, filecontent and cmdout weren't lucky choices.... file => "look at '%s'", cmd => "Output from '%s'", unsupported => "ServDoc doesn't currently support this OS ". "with feature %s", ); %{$output_i18n_sd_pm->{de}}= ( newlines_in_title => "Zeilenumbruch im Title %s!", unsufficent_rights => "Keine ausreichenden Rechte fuer: '%s'", cmd_not_exec => "Befehl '%s' nicht ausfuehrbar oder nicht im Pfad", rc => "RC von '%s': %i", uid_not_correct => "UID '%s' nicht freigegeben fuer '%s'", cmd_timeout => "Befehl '%s' abgebrochen wegen Timeout (%s sec.)", unknown_tab => "Unbekannte Tab-option: '%s'", cmd_not_found => "Programm '%s' nicht gefunden", emtpy_columns => "Leere Spalten: %s", unsupported_os => "Betriebssystem nicht unterstuetzt: %s", undefined_mesg => "Message nicht definiert: '%s'", # und noch noch einige Standard-Messages running => "%s laeuft jetzt.", filecontent => "steht in '%s'", cmdout => "Ausgabe von '%s'", file => "steht in '%s'", cmd => "Ausgabe von '%s'", unsupported => "ServDoc unterstützt (noch) nicht dieses ". "Betriebssystem mit dem Feature %s", ); #----------------------------------------------------------------------
ServDoc_debug($feature,$options,$intensity,$debugtext);
You give your actual debugfeature, a debugmessage and a intensity for that message to ServDoc_debug.
If the actual intensitylevel for this feature (set on the commandline) is greater or equal than your intensity, the debugmessage will be printed on STDERR.
If not, not.
$options is a hash reference like the output from process_cmdline().
In most ServDoc modules you can find something like
sub debug {ServDoc_debug("<your own feature>",$options,shift,shift);};
in the code.
If you do that, you can print debug messages with
debug(3,"debugtext");
sub ServDoc_debug { my $feature = shift; my $options = shift; my $intensity = shift; my $debugtext = shift; my $DEBUGLEVEL; if ( defined( $options->{debug} ) ) { $DEBUGLEVEL = $options->{debug}; } else { return; } if ( defined( $DEBUGLEVEL->{$feature} ) && ( $DEBUGLEVEL->{$feature} >= $intensity ) ) { print STDERR "$feature ($intensity)::$debugtext\n"; return; } if ( defined( $DEBUGLEVEL->{ALL} ) && $DEBUGLEVEL->{ALL} >= $intensity ) { print STDERR "$feature ($intensity)::$debugtext\n"; } } #----------------------------------------------------------------------
report_string ($title,$short_desc,$long_desc,$text[,%options]); report_cmd ($title,$short_desc,$long_desc,$cmd[,%options]); report_file ($title,$short_desc,$long_desc,$file[,%options]); report_dir ($title,$short_desc,$long_desc,$dir[,%options]);
Format and output the text (report_string) or the output of the command (report_cmd) or the text in the file (report_file) or the list of files in the dir (report_dir) together with title, short and long description.
This format is described in the ServDoc userguide (Output Format of ServDoc Modules)
The typical call to one of this functions looks like
report_file ("List of all users",
"All users in your system",
"(they are listed in /etc/passwd, see also passwd(5))",
"/etc/passwd");
There are some options possible:
report_file ("List of all users",
"All users in your system",
"(they are listed in /etc/passwd, see also passwd(5))",
"/etc/passwd",
GROUP=>"bin" );
The function is executed only when you are the given UID (numeric) or USER (text) or you are part of the given GID (numeric) or GROUP (text). If no UID,GID,USER,GROUP is given, or UID or GID or USER or GROUP == ``*'', then the function is executed.
If more then one of UID,GID,USER,GROUP is given, they have all to be fulfilled.
report_file ("sendmail.cf","","",
"/etc/sendmail.cf",
delcomment=>'^#.*')
Delete comments (give a regex which chars are comments)
sub _xml_encode { # "xmlify" some chars ('<','<','"',"'") my $data = shift; return $data if ($data =~ m/<table>/); $data =~ s/</</g; $data =~ s/>/>/g; $data =~ s/"/"/g; $data =~ s/'/'/g; # some strange data isn't printable... $data =~ s///g; return $data; } sub report_string { my $title = shift; my $short_desc = shift; my $long_desc = shift; my $output = shift; my %options = @_; my $titlexml; # check $title for correctness: # $title has to be # <h0>xxx</h0> # <h1>yyy</h1> # ... # <hx>zzz</hx> # OR: # xxx%+yyy%+...%+zzz if ($title =~ /^<h0>/) { $titlexml = "$title"; } else { # $title has the old format xxx%+...%+... # Title has to be without newlines! if ($title =~ /\n/x) { # We substitute \n with " " $title =~ s/\n/ /gx; main::debug(1,output_i18n($output_i18n_sd_pm,'newlines_in_title',$title)); } my @headings = split /\%\+/, $title; my $i; for ($i=0; $i<=$#headings;$i++) { $titlexml .= "<h$i>$headings[$i]</h$i>"; } } # I think, UID checks for string output is senseless, # but so, every "report_xxx"-function has similar parameters. if (!report_allowed(%options)) { main::debug(1, output_i18n($output_i18n_sd_pm,'unsufficent_rights',$output)); return; } # Should we delete comments and blank lines ? if ($options{delcomment}) { $output =~ s/$options{delcomment}//gm; } if ($options{delblanklines}) { $output =~ s/\n\s*\n/\n/gm; } # If we have some "tab => xxx" options, we # make a special coded output $output = _tabify($output,%options); $output = _xml_encode($output); print "<SDitem>"; print "<title>$titlexml</title>"; print "<short>$short_desc</short>"; print "<long>$long_desc</long>"; print "<data>$output</data>"; print "</SDitem>"; } sub report_cmd { my $title = shift; my $short_desc = shift; my $long_desc = shift; my $cmd = shift; my %options = @_; if (!report_allowed(%options)) { main::debug(1, output_i18n($output_i18n_sd_pm,'unsufficent_rights',$cmd)); return; } return &report_string( $title, $short_desc, $long_desc, do_cmd($cmd), %options ); } sub report_file { my $title = shift; my $short_desc = shift; my $long_desc = shift; my $file = shift; my %options = @_; if (!report_allowed(%options)) { main::debug(1, output_i18n($output_i18n_sd_pm,'unsufficent_rights',$file)); return; } if ( -r $file ) { my $text = readfile($file); return &report_string( $title, $short_desc, $long_desc, $text, %options); } } sub report_dir { my $title = shift; my $short_desc = shift; my $long_desc = shift; my $dir = shift; my %options = @_; if (!report_allowed(%options)) { main::debug(1, output_i18n($output_i18n_sd_pm,'unsufficent_rights',$dir)); return; } if (-d $dir) { report_string ($title, $short_desc, $long_desc, join "\n", listdir ($dir), %options); } }
if (!report_allowed(%options)) {
print "You aren't allowed to do this.\n";}
Possible options are UID,GID,USER and GROUP.
If you are allowed according this settings, report_allowed will return 1. If not 0.
This is used for the report_xxx functions in this Library. To allow the same feature for foreign functions (eg report_sql in the oracle module), this function is exported.
sub report_allowed { # internal function to check if report is allowed my %options=@_; my ($rc_uid,$rc_user,$rc_gid,$rc_group)=(1,1,1,1); if (defined($options{UID}) && $options{UID} ne '*' && $options{UID} != $UID ) { $rc_uid = 0; } if (defined($options{USER}) && $options{USER} ne '*' && $options{USER} ne scalar getpwuid $UID ) { $rc_user = 0; } if (defined($options{GID}) && $options{GID} ne '*') { # $GID could contain more than one number $rc_gid = 0; my $gid; foreach $gid (split/\s+/,$GID) { if ($options{GID} == $gid) { $rc_gid = 1; last; } } } if (defined($options{GROUP}) && $options{GROUP} ne '*') { # $GID could contain more than one number $rc_group = 0; my $gid; foreach $gid (split/\s+/,$GID) { if ($options{GROUP} eq scalar getgrgid $gid) { $rc_group = 1; last; } } } return ($rc_uid && $rc_user && $rc_gid && $rc_group); } #----------------------------------------------------------------------
$options=process_cmdline($options);
Process the standard commandline options for a ServDoc module.
If requested, write version or this helptext to stdout.
$options is a hash reference. %{$options->{debug}} is a hash with the debug options.
sub process_cmdline { my $options = shift; my ( $help, $version, @debug, $output_format, $output_i18n, @INCdir ); # Commandline-processing &GetOptions( "help" => \$help, "h" => \$help, "version" => \$version, "v" => \$version, "debug=s@" => \@debug, "output=s" => \$output_format, "lang=s" => \$output_i18n, ); ($help) and exec("perldoc $0"); ($version) and do { print "$options->{Version}\n"; exit 0; }; for ( my $x = 0 ; $x <= $#debug ; $x++ ) { my ( $feature, $level ) = split /,/, $debug[$x]; # Default Level is 1 $level = 1 if ( !$level ); $options->{debug}->{$feature} = $level; } $options->{output_format} = $output_format; $options->{output_i18n} = $output_i18n || 'en'; return $options; } #----------------------------------------------------------------------
@files = listdir("/path/to/dir");
List all files in that directory without ``.'' and ``..''. The filenames are alphabetically sorted. The filenames are absolute pathes.
sub listdir { my $path = shift; # delete the last / $path =~ s{/$}{}; opendir( DH, $path ); my @files = map { "$path/$_" } sort grep !/^\.\.?$/, readdir DH; return @files; } #----------------------------------------------------------------------
$text = readfile("/path/to/file");
Put the content of that file in $text.
sub readfile { my $file = shift; return "" if ( !-r $file ); my $old_irs = $/; undef $/; open( FILE, $file ); my $text = <FILE>; # Whole file in one try close(FILE); $/ = $old_irs; return $text; } #----------------------------------------------------------------------
my @inetd = ps_grep ( "x{0,1}inetd\$" );
Make a 'ps -ef | grep xxx' (or something with appropriate ps options for your os).
sub ps_grep { my $command = shift; my $PSCMD="ps -ef"; for ($OSNAME) { /hpux/ and do {$ENV{'UNIX95'}=1; $PSCMD="ps -eo pid,args"}; #/linux/ and $PSCMD="ps -ww -eo pid,args"; /darwin/ and $PSCMD='ps -ax -eo pid,command'; # SUNOS 5.x: ps -ef ok. # SUNOS 4: ps -ax (but not supported :-) # aix: ps -ef ok } return grep /$command/,grep !/$0/, `$PSCMD`; } #----------------------------------------------------------------------
is_unix()
if (is_unix()) { do_something unix_special; }
returns true, if your OS is a unix-like OS
sub is_unix { return ($OSNAME =~ /linux|aix|hpux|solaris|darwin/) ; # To be continued... } #----------------------------------------------------------------------
$output=do_cmd("command"[,UID]);
returns the output from the given command.
If you give UID, then the command is executed only when you are that UID.
You can also give UID=``*'' (which is the same as no UID). That means, for every UID is that command executed.
If the command runs longer then $timeout seconds (default: 20sec.), then it will aborted and a debug output is written.
If you set timeout = 0, then there is no timeout!
sub do_cmd { my $cmd = shift; my $cmd_UID = shift; if (!defined($cmd_UID)) {$cmd_UID = "*"}; my $timeout = shift; if (!defined($timeout)) {$timeout = 20}; my %options = @_; my $output; my $is_executable=0; # cmd has 2 variants: # cmd starts with cmd-name (eg: 'vgscan') : No leading / -> # which has to know that executable # cmd starts with / -> seems like absolute path, we can check # that. # Strip options from cmd: $cmd =~ m{^\s*(\S*)}; my $cmd_without_options = $1 || $cmd; # FIXME: For windows, that has to change! if ( $cmd_without_options =~ m{^/} ) { # starts with / if ( -x $cmd_without_options ) { $is_executable=1; } } else { my $which = `which $cmd_without_options 2>/dev/null`; if ($which =~ m{.*(/\S+).*}) { chomp($which); if ( -x $which ) { $is_executable=1; } } } if ( ! $is_executable ) { main::debug(1, output_i18n($output_i18n_sd_pm,'cmd_not_exec',$cmd)); return ""; } # What about Errors ? Returncodes ? main::debug(9,"Cmd_UID: $cmd_UID; real UID: $UID; Command: '$cmd'"); my $TMPFILE="/tmp/Servdoc.stderr.tmp.$$"; $SIG{ALRM} = sub { die "timeout" }; eval { alarm($timeout); if ($cmd_UID eq '*' || $cmd_UID == $UID) { $output = `$cmd 2>$TMPFILE`; my $rc = $?; if ($rc != 0) { # We assume just RC=0 is a good RC ... # But that hasn't to be true for every command we # see here main::debug(8, output_i18n($output_i18n_sd_pm,'cmd',$cmd,$rc)); } } else { # UID isn't correct main::debug(1, output_i18n($output_i18n_sd_pm,'uid_not_correct',$UID,$cmd)); # FIXME: If we are root, we could do a su - $UID -c or something similar } alarm(0); }; if ($@) { if ($@ =~ /timeout/) { # cmd timed out main::debug(1, output_i18n($output_i18n_sd_pm,'cmd_timeout',$cmd,$timeout)); return ""; } else { # We got another problem..... alarm(0); die "Unknown Problem with command $cmd\n"; } } # If we are here, we haven't had a timeout. # if stderrfilter is set, then we filter the STDERR from the command open ERR,$TMPFILE or die "can't open $TMPFILE: $! ($0)"; if (defined($options{stderrfilter})) { print STDERR grep !/$options{stderrfilter}/,<ERR>; } else { print STDERR <ERR>; } close ERR; unlink $TMPFILE; return $output; }
_tabify($string,%options)
$output=_tabify($output,%options)
_tabify is a internal function (mostly used from report_string), which tries to make a table from your multilined string according your options in %options.
possible Options are:
In the output, the table is marked with: <table> <tr><td>...</td><td>...</td></tr> [...] </table>
sub _tabify { my $string = shift; my %options = @_; my $output; if (! defined($options{tab})) {return $string}; if ($options{tab} eq "self") {return $string;}; if ($options{tab} eq "space") { # every newline is a new table row, every space is a new cell $output = "<table>"; my $row; foreach $row (@lines) { $output .= "<tr>"; my $cell; foreach $cell (split /\s+/, $row) { $output .= "<td>$cell</td>"; } $output .="</tr>"; } $output="</table>"; return $output; } elsif ( $options{tab} eq "autocolumn") { return _tabify_autocolumn(@lines); } else { main::debug(1,output_i18n($output_i18n_sd_pm, 'unknown_tab',$options{tab})); } } #----------------------------------------------------------------------
my $fullcmd = find_path ( "httpd" [,@DIRLIST] );
Tries to get the full path for the given command on various ways and returns it:
sub find_path { my $command = shift; my @extradirs = @_; my @procs = ps_grep ($command); my $fullcmd; # Shows ps the whole path ? if ($procs[0] && $procs[0] =~ m{(/\S*$command)}) { $fullcmd = $1; if (-x $fullcmd) {return $fullcmd}; } # Maybe the command is in the PATH $fullcmd = `which $command 2>/dev/null`; if ($fullcmd =~ m{.*(/\S+).*}) { chomp($fullcmd); if ( -x $fullcmd ) { return $fullcmd } } # Try some standard dirs my $dir; foreach $dir ("/*bin", "/usr/*bin", "/usr/local/*bin", "/opt/*/*bin") { while (<$dir/$command>) { if ( -x $_) {return $_}; } } # Try custom dirs foreach $dir (@extradirs) { while (<$dir/$command>) { if ( -x $_) {return $_}; } } # We should never be here... main::debug(1, output_i18n($output_i18n_sd_pm,'cmd_not_found',$command)); return; } #---------------------------------------------------------------------- sub _tabify_autocolumn { # Internal function to search autocolumns in strings. my @lines=@_; # Think of @lines as matrix. # First we identify all empty (that is: whitespace) columns. # The first field is from char 0 to the first empty colum # The second field is from the following first nonempty column to # the second empty column. # And so on. # For every field, we truncate the whitespace at end. my @emptycolumns=(-1); my $minlength=length($lines[0]); my $maxlength=$minlength; foreach (@lines) { my $l=length($_); if ($l < $minlength) { $minlength = $l; } elsif ($l > $maxlength) { $maxlength = $l; } } my $col; for ($col=0; $col <= $minlength; $col++) { my $isnt_empty = 0; my $line; for ($line =0; $line <=$#lines; $line++) { if (substr($lines[$line],$col,1) !~ m/\s/) { $isnt_empty = 1; last; } } if (!$isnt_empty) { push @emptycolumns,$col; } ; } # The last field ends at end of string. push @emptycolumns,$maxlength; main::debug(9,output_i18n($output_i18n_sd_pm,'empty_columns', join(@emptycolumns," "))); my @field; # $field[0][3] is the 4th field in the first line. # $field[2][0] is the first field in the 3rd line. my $x; $col=0; for ($x =1; $x<=$#emptycolumns; $x++) { # Are there two empty columns directly following ? if ($emptycolumns[$x] -1 == $emptycolumns[$x-1]) { # if yes: do nothing. next; } my $line; # Start at after last empty col. my $start = $emptycolumns[$x-1]+1; # Length = (this empty_col - last_empty_col); my $fieldlength=$emptycolumns[$x]-$emptycolumns[$x-1]; for ($line =0; $line <=$#lines; $line++) { $field[$line][$col]=substr($lines[$line], $start, $fieldlength ); $field[$line][$col] =~ s/\s+$//; } $col++; } my $output; $output = "<table>"; my $y; for ($x=0; $x<=$#field;$x++) { $output.="<tr>"; for ($y=0; $y<=$#{$field[$x]}; $y++) { $output.="<td>$field[$x][$y]</td>"; } $output.="</tr>"; } $output.="</table>"; return $output } #----------------------------------------------------------------------
$procs = get_proc_info( "xxx" );
Give me more information about all processes with names like ``xxx'' (regex are allowed).
$procs is an anonymous hash of hashes. $procs looks like:
$procs->{<PID1>}->{UID}->"0",
->{GID}->"22",
->{CMD}->"/usr/sbin/xxx -f /etc/xxx.conf",
->{<PID2>}-> ... (The same informations for every PID)
<PID1> and <PID2> are just placeholders for real PIDs.
Returned values for every process who matches the regex are:
sub get_proc_info { my $command = shift; my $hash; # For future enhancements: # pid: the first field # uid: the second field # gid: the third field # etime: the forth field # room for future enhancements # args: the last field ! $number_of_fields = 5; my $PSCMD; for ($OSNAME) { /hpux/ and do {$ENV{'UNIX95'}=1; $PSCMD="ps -eo pid,uid,gid,etime,args";}; /linux/ and $PSCMD="ps -www -eo pid,uid,gid,etime,args"; /aix/ and $PSCMD="ps -eo pid,uid,gid,etime,args"; /darwin/ and $PSCMD="ps -ax -eo pid,uid,rgid,start,command"; /solaris/ and $PSCMD="ps -eo pid,uid,gid,etime,args"; } if (!$PSCMD) { main::debug(1,output_i18n($output_i18n_sd_pm,'unsupported_os','ps -xxx')); exit} # No Zombies my @proclist=grep /^\s*\d/, grep !/defunct/, `$PSCMD`; #remove headings from ps shift @proclist; foreach (grep /$command/,@proclist) { s/^\s+//; chomp; my @field = split /\s+/,$_,$number_of_fields; next if ($#field < $number_of_fields-1); # Create the hash $hash->{$field[0]}->{UID} = $field[1]; $hash->{$field[0]}->{GID} = $field[2]; $hash->{$field[0]}->{ETIME} = $field[3]; $hash->{$field[0]}->{CMD} = $field[-1]; } return $hash; } #----------------------------------------------------------------------
if (are_we_GID(23)) { do_something_special_for_group_23; }
test for membership in the named group. the named group has to be numeric.
Return values are 1 (true) or 0 (false).
sub are_we_GID { my $gid = shift; # $GID could contain more than one number my $rc_gid=0; foreach (split /\s+/,$GID) { if ($gid == $_) { $rc_gid = 1; last; } } return $rc_gid; } #----------------------------------------------------------------------
output_i18n(\%hash_with_localized_messages,$hashkey[,parameters]*)
output_i18n returns your localized messages.
It runs sprintf with \%hash_with_localized_messages->{$main::options}->{output_i18n}->{$hashkey} and the given parameters.
To localize your messages, your code must have such a HoH with different languages ('en','de',...) as first keys and the different_messages as second keys.
sub output_i18n { my $output_i18n = shift; my $message = shift; my $lang = $main::options->{output_i18n}||'en'; if (!defined($output_i18n->{$lang}->{$message})) { main::debug(1,"Undefined messages: $message"); # OK, we haven't a localized message. Maybe we have an english message if (defined($output_i18n->{en}->{$message})) { $output_i18n->{$lang}->{$message}=$output_i18n->{en}->{$message}; } else { # Sorry, no english message, too return ''; } } return sprintf($output_i18n->{$lang}->{$message},@_); } #----------------------------------------------------------------------
i18n_mesg($hashkey[,parameters]*)
i18n_mesg is just a shortcut for
output_i18n($main::options->{lang},$hashkey[,parameters]*)
The messages have to be defined in $mail::options->{lang};
sub i18n_mesg { $main::options||='en'; return output_i18n($main::options->{lang},@_); } #----------------------------------------------------------------------
report_i18n('Type','key', forth parameter of report_xxx function);
report_i18n returns the output of one of the report_xxx -functions. Heading has to be defined in
$main::options->{lang}->{xx}->{key},
the short and the long text have to defined in
$main::options->{lang}->{xx}->{key_short},
$main::options->{lang}->{xx}->{key_long}.
type is one of 'file','cmd','string','dir' according to report_string, report_cmd,report_file,report_dir.
The output of
report_string(i18n_mesg('xxx'),
i18n_mesg('xxx_short'),
i18n_mesg('xxx_long'),
"test test");
is identical to
report_i18n('string','xxx',"test test");
sub report_i18n { no strict 'refs'; my $function_name="report_" . shift; my $key=shift; return &$function_name(i18n_mesg($key),i18n_mesg($key."_short"), i18n_mesg($key."_long"),@_); } #----------------------------------------------------------------------
print i18n_std('key'[,parameters]);
i18n_std gives the translated standard message for the given key. If there are more parameters, they will be used as parameters to sprintf.
The standard messages are part of $output_i18n_sd_pm.
sub i18n_std { my $key=shift; main::debug(1,"i18n_std: Key '$key' not found") unless (defined($output_i18n_sd_pm->{$main::options->{output_i18n}}->{$key})); return sprintf($output_i18n_sd_pm->{$main::options->{output_i18n}}->{$key},@_); } #----------------------------------------------------------------------
print array2table(@array2d);
Input: an 2dimensional array Output: a string with the table-markup and the data from the array. First row will be marked as heading.
sub array2table { my $output; my ($row,$col); $output="<table>"; for ($row=0;$row<=$#_; $row++) { $output.="<tr>"; for ($col=0; $col<= $#{$_[$row]}; $col++) { if ($row==0) { $output.="<th>".$_[$row][$col]."</th>"; } else { $output.="<td>".$_[$row][$col]."</td>"; } } $output.="</tr>"; } return $output."</table>\n"; } #----------------------------------------------------------------------
print byte2hrn(1387,'B|K|M|G');
Input: A number in Byte/KB/MB/GB and the unit (B,K,M,G) Output: A Human Readable Number, rounded to 2 digits.
Example:
byte2hrn(1387,'B') gives ``1.38K''
byte2hrn(5763616,'K') gives ``5.76G''
sub byte2hrn { my $number=shift; my $unit=uc(shift); my $all_units="BKMGTP"; my $unit_exp=index $all_units, $unit; while ($number >= 1000 ) { $number=$number/1000; $unit_exp++; } return sprintf("%.2f%s",$number,substr $all_units,$unit_exp,1); } #----------------------------------------------------------------------
Ulrich Herbst <ulrich.herbst@gmx.de>
1;