1package IO::Toolkit;
2
3# $LastChangedDate: 2006-07-06 21:49:47 -0500 (Thu, 06 Jul 2006) $
4# $LastChangedRevision: 8 $
5# $LastChangedBy: markus.linke@linke.de $
6
7use 5.008;
8use strict;
9use warnings;
10
11use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
12use base qw(Exporter);
13use Crypt::RC6;
14use English;
15use POSIX;
16use DirHandle;
17use Digest::MD5;
18use Getopt::Long;
19use File::Basename;
20
21require Exporter;
22
23our @ISA = qw(Exporter);
24our %EXPORT_TAGS = (
25    'all' => [
26        qw(
27
28          )
29    ]);
30
31our @EXPORT_OK = (@{$EXPORT_TAGS{'all'}});
32
33our @EXPORT  = qw(&logme &gettimestamp);
34$VERSION = 1 + sprintf("%3f",((qw$LastChangedRevision: 8 $)[-1])/1000);
35
36
37sub logme
38{
39
40    my $severity = $_[0];
41    my $message  = $_[1];
42
43    if ($severity eq "open")
44    {
45
46        if (!defined($message))
47        {    # If no filename is provided, use defaults
48            my $program = $0;    # Script Name with path
49            $program =~ m/\/(.+)\.pl/i;    # Without leading path and extension
50            my $logfilename = $1 . ".log";
51            $message = $logfilename;
52        }
53
54        open LOGFILE, ">>$message"
55          or die "*** Fatal Error: Logfile $message cannot be opened.";
56    }
57    elsif ($severity eq "close")
58    {
59        close LOGFILE or die "*** Fatal Error: Logfile cannot be closed.";
60    }
61
62    elsif (   ($main::getopt_loglevel =~ m/$severity/)
63           || ($main::getopt_loglevel eq "all"))
64    {
65        my $timestamp = &gettimestamp();
66        my $line = "$timestamp [$main::programname] <$severity> $message\n";
67        if (not $main::getopt_loglevel =~ m/-/) { print $line; }
68        print LOGFILE $line;
69    }
70
71    if (($severity eq "E") || ($severity eq "F"))
72    {
73        $main::error_occured++;
74    }
75
76    if ($severity eq "F")
77    {
78        close LOGFILE;
79        die "\n*** Fatal Error: $_[1]\n\n";
80    }
81    return 1;
82}
83
84sub gettimestamp
85{
86    my $format = $_[0];
87
88    if (! defined($format)) {
89       return strftime("%Y-%m-%d %H:%M:%S",localtime);
90    } elsif ($format eq "filename") {
91       return strftime("%Y%m%d%H%M%S",localtime);
92    } else {
93       return strftime($format,localtime);
94    }
95}
96
97sub trim
98{
99    my @out = @_;
100    for (@out)
101    {
102        s/^\s+//;    # trim left
103        s/\s+$//;    # trim right
104    }
105    return @out == 1
106      ? $out[0]      # only one to return
107      : @out;        # or many
108}
109
110sub moduleinfo
111{
112    print "Directories searched:\n\t", join("\n\t" => @INC),
113      "\nModules loaded:\n\t", join("\n\t" => sort values %INC), "\n";
114    return 1;
115}
116
117sub hash2sqlinsert
118{
119    my $table  = shift;
120    my %hash   = @_;
121    my @fields = sort keys %hash;
122    my @values;
123
124    foreach $a (sort keys %hash)
125    {
126        push @values, $hash{$a};
127    }
128
129    return "insert into $table ("
130      . join(",", @fields)
131      . ") values (\'"
132      . join("\',\'", @values) . "\')";
133}
134
135sub sql2data
136{
137    my $localdbh = $_[0];
138    my $sql      = $_[1];
139
140    logme("S",$sql);
141
142    my $sth = $localdbh->prepare($sql);
143    my $rc  = $sth->execute;
144
145    my $num_of_fields = $sth->{NUM_OF_FIELDS}
146      or logme("E", "Cannot get number of columns. SQL Syntax error?");
147    my @field_names = @{$sth->{NAME}} or logme("E", "Cannot get column names");
148
149    my $ary_ref = $sth->fetchall_arrayref() or logme("E", "Cannot fetch data");
150    my $total_rows = @$ary_ref;
151
152    my @resultlist;
153
154    if ($@)
155    {
156        logme("F", "Database Error: Unable to get data $localdbh->errstr");
157    }
158    else
159    {
160        foreach my $row (@$ary_ref)
161        {
162            my $hashrow = {};
163            my $i       = 0;
164            while ($i < $num_of_fields)
165            {
166                if (defined(@$row[$i]))
167                {
168                    $hashrow->{$field_names[$i]} = @$row[$i];
169                }
170                else
171                {
172                }
173                $i++;
174            }
175            push @resultlist, $hashrow;
176        }
177    }
178
179    return @resultlist;
180}
181
182sub dosql
183{
184    my $locdbh = $_[0];
185    my $locsql = $_[1];
186    my $locsth = $locdbh->prepare_cached($locsql);
187    my $ret    = $locsth->execute or logme("E", "Database error: " . $locdbh->errstr);;
188    return $ret;
189}
190
191sub encrypt
192{
193    my $suppliedseed = shift or die "Usage: <seed> <password>\n";
194    my $pwd          = shift or die "Usage: <seed> <password>\n";
195    my $seed     = sprintf("%-8.8s", $suppliedseed);
196    my $password = sprintf("%-16s",  $pwd);
197    my $key      = "";
198    map { $key .= sprintf("%02lx", ord($_)); } split("", $seed);
199    my $cipher             = new Crypt::RC6 $key;
200    my $ciphertext         = $cipher->encrypt($password);
201    my $encrypted_password = "";
202    map { $encrypted_password .= sprintf("%02lx", ord($_)) }
203      split("", $ciphertext);
204    return $encrypted_password;
205}
206
207sub decrypt
208{
209    my $seed  = shift;
210    my $crypt = shift;
211    $seed = sprintf("%-8.8s", $seed);
212    my $key = "";
213    map { $key .= sprintf("%02lx", ord($_)); } split("", $seed);
214    my $cipher = new Crypt::RC6 $key;
215    my $ep     = "";
216
217    while ($crypt =~ m/../g) { $ep .= chr(hex($MATCH)); }
218    my $pwd = $cipher->decrypt($ep);
219    $pwd =~ s/\s//g;
220    return $pwd;
221}
222
223sub pid {
224   my $status = $_[0];
225   my $file   = $_[1];
226
227   if   ($status eq "exclusive") {
228      if (-e $file) { die "PID File $file exists! Program ends here.\n";}
229      open PID,">$file";
230      print PID $$;
231      close PID;
232   } if ($status eq "overwrite") {
233      open PID,">$file";
234      print PID $$;
235      close PID;
236   } if ($status eq "remove") {
237      unlink $file;
238   }
239}
240
241sub filelist {
242
243   # Desc: Filelist returns a list of files in a directory
244   # Para: Directory
245
246   my $dir = shift;
247   my $dh = DirHandle->new($dir)   or die "can't opendir $dir: $!";
248   return sort                       # sort pathnames
249#         grep { -f   }              # -l links -f files
250          map  { "$dir/$_" }         # create full paths
251          grep {  !/^\./   }         # filter out dot files
252          $dh->read( );              # read all entries
253}
254
255sub get_md5_checksum{
256
257   # Desc: Returns MD5 checksum for given filename
258
259   my $filename=$_[0];
260   my $md5 = Digest::MD5->new;
261   open(my $fh, "< $filename") or die "cant open file $filename";
262   $md5->reset;
263   $md5->addfile($fh);
264   close $fh;
265   return $md5->hexdigest;
266}
267
268sub commandline {
269	my @extra_options = @_;
270	my $help;
271	my $verbose;
272	my @default_options = (
273		{
274		  Spec		=>  "loglevel=s",
275		  Variable  	=> \$main::getopt_loglevel,
276		  Help		=> "--loglevel=FEMSW-",
277		  Verbose	=> ["--loglevel=Which messages should be logged",
278		  				"F=FATAL",
279						"E=ERROR",
280						"M=MESSAGE",
281						"-=No output to STDOUT",
282						"all=Show all messages",
283						]
284		},
285		{
286		  Spec		=>  "help!",
287		  Variable  	=> \$help,
288		  Help		=> "--help",
289		  Verbose	=> ["--help - Display Usage information and exit"]
290		},
291		{
292		  Spec		=>  "verbose!",
293		  Variable  	=> \$verbose,
294		  Help		=> "--verbose",
295		  Verbose	=> ["--verbose - Display more detailed Usage information and exit"]
296		},
297		);
298	my %options = ();
299	foreach my $o (@default_options, @extra_options) {
300		$options{$o->{Spec}} = $o->{Variable};
301	}
302	my $result = GetOptions(%options);
303	die("GetOptions failed: $!\n") unless $result;
304	if (defined($help) or defined($verbose)) {
305		my $usage = get_usage($verbose, @default_options, @extra_options);
306		print $usage;
307		exit(0);
308	}
309
310	$main::getopt_loglevel="all" unless defined($main::getopt_loglevel);
311}
312
313sub get_usage {
314	my ($verbose, @opts) = @_;
315	my $filename = basename($0);
316	my $usage = "Usage: $filename ";
317	my @usage = ();
318	my $indent = " " x length($usage);
319
320	foreach my $opt (@opts) {
321		if ($verbose) {
322			my $firstline = 1;
323			foreach my $desc (@{ $opt->{Verbose} }) {
324				my $indent = $firstline ? "" : "\t";
325				push(@usage, "$indent$desc");
326				$firstline = 0;
327			}
328		}
329		else {
330				push(@usage, $opt->{Help});
331		}
332	}
333	return wantarray ? @usage : $usage.join("\n$indent", @usage)."\n";
334}
335
336
3371;
338
339__END__
340
341=head1 NAME
342
343IO::Toolkit
344
345=head1 ABSTRACT
346
347IO::Toolkit - Perl extension to create logfiles
348
349=head1 PREREQUISITS
350
351This module needs Crypt::RC6 for its encryption/decryption routine.
352Digest::MD5 and DirHandle used for checksum routines.
353
354=head1 SYNOPSIS
355
356Sample Script (please also have a look into the samples directory):
357
358   use IO::Toolkit;
359   use File::Basename;
360
361   package main;
362   use vars qw($getopt_loglevel $program $programname);
363
364   my $program = basename($0);
365   $programname = $program;
366   $programname =~ s/\.pl//g;
367
368   my $logfilename = $programname . ".log";
369   my $VERSION = sprintf "%d.%05d", '$Revision: 8 $' =~ /(\d+)/g;
370   my $description = "Script";
371
372   my $extra;
373   my @extra_options = (
374  			{
375		  		Spec		=>  "extra=s",
376		  		Variable  	=> \$extra,
377		  		Help		=> "--extra=whatever",
378		  		Verbose		=> ["--extra=whatever",
379					    	    "whatever whenever...",
380				   	   	   ]
381   			},
382   		    );
383
384   IO::Toolkit::commandline(@extra_options);
385
386   logme("open", $logfilename);
387   logme("M","$programname V$VERSION started --------------------------------------------------");
388   logme("C", "Logfile $logfilename used.");
389   logme("M","$programname V$VERSION ended   --------------------------------------------------");
390   logme("close");
391
392This displays and creates a logfile like this:
393
394   2004-11-14 13:07:48 [mytemplate] <M> mytemplate V1.00004 started --------------------------------------------------
395   2004-11-14 13:07:48 [mytemplate] <C> Logfile mytemplate.log used.
396   2004-11-14 13:07:48 [mytemplate] <M> mytemplate V1.00004 ended   --------------------------------------------------
397
398=head1 IMPORTANT NOTICE
399
400If you are looking for a better logging-module, please check Log4Perl instead.
401
402=head1 DESCRIPTION
403
404Provides a human-readable logfile and is ment to replace "print" and "die" in your programs.
405
406This module was written to provide an easy way to log messages. It
407checks for an option --loglevel=EMCDQ- where each character stands
408for a certain level. e.g.
409
410   E   = Error
411   S   = System
412   M   = Message
413   D   = Debug
414   -   = Silent
415   all = All messages
416
417You can use all characters you would like to use. These are just examples.
418
419the minus ("-") has a special meaning: supresses output to the screen and
420ONLY logs them to the file. Please see the sample script for more details.
421
422The function gettimestamp returns the current time in the format used for the logfile.
423If you specifiy the format &gettimestamp("filename") it returns something like
424this: 20041009131500
425
426=head2 IO::Toolkit::logme("M","Message")
427
428The first parameter specifies the severity of the message. The message is only logged, if
429$getopt_loglevel contains that severity.
430
431Because IO::Toolkit::logme is exported, you can just use logme("M","message") in your scripts.
432
433=head2 IO::Toolkit::moduleinfo
434
435prints a list of loaded modules.
436
437=head2 IO::Toolkit::trim
438
439trims a variable.
440
441=head2 IO::Toolkit::hash2sql
442
443creates SQL code to insert a hash into a table.
444
445Example:
446
447   use IO::Toolkit;
448
449   my %hash=(
450      firstname=>"Markus",
451      lastname=>"Linke",
452   );
453
454   print IO::Toolkit::hash2sqlinsert("tablename",%hash)."\n";
455
456Result:
457
458   insert into tablename (firstname,lastname) values ("Markus","Linke")
459
460IO::Toolkit::sql2data executes SQL statement and creates a array of hashs
461
462   use IO::Toolkit;
463   use Data::Dumper;
464   print Dumper(IO::Toolkit::sql2data($dbh,"select * from environments"));
465
466
467=head2 IO::Toolkit::encrypt and IO::Toolkit::decrypt
468
469needs two strings as parameters (e.g. seed and password) and returns an
470encrypted/decrypted value.
471
472=head2 IO::Toolkit::pid("exclusive|overwrite|remove","/tmp/filename.pid");
473
474Create or delete PID file. If set to exclusive, the program dies if the
475file already exists.
476
477=head2 my $md5 = IO::Toolkit::get_md5_checksum("Toolkit.pm");
478
479Create a MD5 checksum for the filename provided.
480
481=head1 EXPORT
482
483logme and gettimestamp are exported.
484
485=head1 SEE ALSO
486
487   http://www.linke.de for my personal homepage and
488   http://trac.it-projects.com/iotoolkit for the project TRAC pages
489
490   Please submit bugs at http://bugzilla.it-projects.com
491
492   Hosted Subversion Version Control provided by http://svn.it-projects.com
493   Checkout the latest version at https://svn.it-projects.com/svn/iotoolkit
494
495=head1 AUTHOR
496
497Markus Linke, markus.linke@linke.de
498
499=head1 COPYRIGHT AND LICENSE
500
501Copyright 2003-2006 by Markus Linke
502
503This library is free software; you can redistribute it and/or modify
504it under the same terms as Perl itself.
505
506=cut
507
508