--- nfo/perl/libs/shortcuts/files.pm	2003/02/11 09:50:00	1.1
+++ nfo/perl/libs/shortcuts/files.pm	2003/06/06 04:00:35	1.5
@@ -1,12 +1,36 @@
 ## ---------------------------------------------------------------------------
-##  $Id: files.pm,v 1.1 2003/02/11 09:50:00 joko Exp $
+##  $Id: files.pm,v 1.5 2003/06/06 04:00:35 joko Exp $
 ## ---------------------------------------------------------------------------
 ##  $Log: files.pm,v $
+##  Revision 1.5  2003/06/06 04:00:35  joko
+##  + binary mode file write
+##  + don't add a trailing newline always
+##
+##  Revision 1.4  2003/05/13 09:23:03  joko
+##  pre-flight checks for existance of base directory of to-be-executed script
+##
+##  Revision 1.3  2003/03/31 05:47:01  janosch
+##  Mis mif gex
+##
+##  Revision 1.2  2003/02/20 21:12:24  joko
+##  + prints to STDERR if logfile could not be opened
+##
 ##  Revision 1.1  2003/02/11 09:50:00  joko
 ##  + code from Data::Storage::Handler::File::Basic
 ##
 ## ---------------------------------------------------------------------------
 
+=pod
+
+=head1  Background
+
+   UNIX = Everything is a file
+   Perl ~ Everything is a string   ;-)
+
+
+=cut
+
+
 
 package shortcuts::files;
 
@@ -19,22 +43,47 @@
   s2f
   a2f
   f2s
+  rif
+  mif
 );
 
 
 use Data::Dumper;
+use File::Basename;
 
 sub s2f {
   my $filename = shift;
   my $string = shift;
+  my $args = shift;
+  
+  # pre-flight checks: Does directory exist?
+  my $dirname = dirname($filename);
+  if (not -e $dirname) {
+    print STDERR __PACKAGE__ . ':' . __LINE__ . ": ERROR: Directory '$dirname' does not exist! (Write attempt)" . "\n";
+    return;
+  }
+
+  # Perform: File write
   open(FH, '>' . $filename);
+  if ($args->{mode} && $args->{mode} eq 'binary') {
+    binmode(FH);
+  }
   print FH $string;
-  print FH "\n";
+  # Always inject ending newline? No, since it unneccessarily 
+  # modifies files with absolutely *no* changes in content.
+  print FH "\n" if $string !~ /\n$/;
   close(FH);
 }
 
 sub f2s {
   my $filename = shift;
+  
+  # pre-flight checks: Does file exist?
+  if (! -e $filename) {
+    print STDERR __PACKAGE__ . ':' . __LINE__ . ": ERROR: File '$filename' does not exist! (Read attempt)" . "\n";
+    return;
+  }
+  
   # read file at once (be careful with big files!!!)
   open(FH, '<' . $filename);
   my @buf_arr = <FH>;
@@ -99,6 +148,52 @@
   s2f($outfile, $buf);
 }
 
+sub mis {
+  my $string = shift;
+  my $rules = shift;
+
+  my $mis_result = {};
+  
+  if (ref $rules eq 'HASH') {
+    my @re_find = keys %{$rules};
+    # replace all keys with substitutes from hash "%re_table"
+    foreach my $find (@re_find) {
+      #my $replace = $rules->{$find};
+      #$mis_result &= ($string =~ m/$find/g);
+      $mis_result->{$find} = ($string =~ m/$find/g);
+      $mis_result->{$find} ||= 0;
+    }
+  }
+  
+  if (ref $rules eq 'ARRAY') {
+    foreach my $rule (@{$rules}) {
+      my $find    = (ref $rule eq 'ARRAY') ? $rule->[0] : $rule;
+      $mis_result->{$find} = 0;
+      my $pattern = quotemeta($find);
+      $string =~ s{
+        $pattern     # the pattern used to search through the whole file
+      }{
+        $mis_result->{$find}++;   # build result (increase counter per occourance)
+      }gex;
+    }
+  }
+  
+  return $mis_result;
+}
+
+sub mif {
+  my $filename = shift;
+  my $rules = shift;
+  my $out_suffix = shift;
+
+  my $outfile = $filename;
+  $outfile .= '.' . $out_suffix if ($out_suffix);
+
+  my $buf = f2s($filename);
+  return mis($buf, $rules);
+  #s2f($outfile, $buf);
+}
+
 sub findKeyEntries {
   my $string = shift;
   my $pattern = shift;