/[cvs]/nfo/perl/libs/Data/Storage/Handler/File/Basic.pm
ViewVC logotype

Diff of /nfo/perl/libs/Data/Storage/Handler/File/Basic.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.1 by joko, Sun Feb 9 04:55:04 2003 UTC revision 1.2 by joko, Tue Feb 11 11:07:58 2003 UTC
# Line 2  Line 2 
2  ##  $Id$  ##  $Id$
3  ## ---------------------------------------------------------------------------  ## ---------------------------------------------------------------------------
4  ##  $Log$  ##  $Log$
5    ##  Revision 1.2  2003/02/11 11:07:58  joko
6    ##  - refactored to shortcuts::files
7    ##
8  ##  Revision 1.1  2003/02/09 04:55:04  joko  ##  Revision 1.1  2003/02/09 04:55:04  joko
9  ##  + initial commit  ##  + initial commit
10  ##  ##
# Line 13  package Data::Storage::Handler::File::Ba Line 16  package Data::Storage::Handler::File::Ba
16  use strict;  use strict;
17  use warnings;  use warnings;
18    
19  use Data::Dumper;  # FIXME: introduce some declaration here which
20    # *really* merges the contents of shortcuts::files
21    # replacing all from below
22    
23  require Exporter;  require Exporter;
24    #use base qw( shortcuts::files Exporter );
25  our @ISA = qw( Exporter );  our @ISA = qw( Exporter );
26  our @EXPORT_OK = qw(  our @EXPORT_OK = qw(
27    s2f    s2f
# Line 24  our @EXPORT_OK = qw( Line 29  our @EXPORT_OK = qw(
29    f2s    f2s
30  );  );
31    
32  sub s2f {  use shortcuts::files qw( s2f a2f f2s );
   my $filename = shift;  
   my $string = shift;  
   open(FH, '>' . $filename);  
   print FH $string;  
   print FH "\n";  
   close(FH);  
 }  
   
 sub f2s {  
   my $filename = shift;  
   # read file at once (be careful with big files!!!)  
   open(FH, '<' . $filename);  
   my @buf_arr = <FH>;  
   my $buf = join("", @buf_arr);  
   close(FH);  
   return $buf;  
 }  
   
 sub a2f {  
   my $filename = shift;  
   my $string = shift;  
   open(FH, '>>' . $filename) or do {  
     print "Could not append to \"$filename\"!", "\n";  
     print "Log-Message was: ";  
     print $string if $string;  
     print "\n";  
     return;  
   };  
   #print FH "\n";  
   print FH $string;  
   print FH "\n";  
   close(FH);  
   return 1;  
 }  
   
 sub ris {  
   my $string = shift;  
   my $rules = shift;  
   
   our $ris_result = 1;  
   
   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};  
       $ris_result &= ($string =~ s/$find/$replace/g);  
     }  
   }  
     
   if (ref $rules eq 'ARRAY') {  
     foreach my $rule (@{$rules}) {  
       my $find    = $rule->[0];  
       my $replace = $rule->[1];  
       $ris_result &= ($string =~ s/$find/$replace/g);  
     }  
   }  
     
   return $string;  
 }  
   
 sub rif {  
   my $filename = shift;  
   my $rules = shift;  
   my $out_suffix = shift;  
   
   my $outfile = $filename;  
   $outfile .= '.' . $out_suffix if ($out_suffix);  
   
   my $buf = f2s($filename);  
   $buf = ris($buf, $rules);  
   s2f($outfile, $buf);  
 }  
   
 sub findKeyEntries {  
   my $string = shift;  
   my $pattern = shift;  
   my @arr = split("\n", $string);  
   my @entries;  
   foreach (@arr) {  
     chomp;  
     #print "l: ", $_, "\n";  
     if (m/$pattern/) {  
       push @entries, $1;  
     }  
   }  
   return \@entries;  
 }  
   
 # ---------------------------------  
 # is a context-entry in a file?  
 # a "context-entry" is an entry identified  
 # by a certain keystring, which itself  
 # is detected dynamically  
 sub isEntryInFile {  
   
   my $chk = shift;  
   my $content_current = f2s($chk->{filename});  
     
   # try to find all key-entries via patterns which are "entry-identifiers"  
   if (my @keys = @{ findKeyEntries($chk->{'out'}, $chk->{'pattern'}{'EntryIdent'}) }) {  
     # iterate through all "entry-identifiers"  
     foreach (@keys) {  
       my $pattern = $chk->{'pattern'}{'EntryCheck'};  
       $pattern =~ s/\@\@KEY\@\@/$_/;  
       my $bool_AlreadyThere = ($content_current =~ m/$pattern/);  
       if ($bool_AlreadyThere) {  
         $chk->{'EntryFound'} = $_;  
         return 1;  
       }  
     }  
   }  
   
 }  
33    
34  1;  1;
35  __END__  __END__
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.2
MailToCvsAdmin">MailToCvsAdmin
 ViewVC Help
Powered by ViewVC 1.1.26 RSS 2.0 feed