/[cvs]/nfo/perl/libs/shortcuts/files.pm
ViewVC logotype

Diff of /nfo/perl/libs/shortcuts/files.pm

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

revision 1.2 by joko, Thu Feb 20 21:12:24 2003 UTC revision 1.4 by joko, Tue May 13 09:23:03 2003 UTC
# Line 2  Line 2 
2  ##  $Id$  ##  $Id$
3  ## ---------------------------------------------------------------------------  ## ---------------------------------------------------------------------------
4  ##  $Log$  ##  $Log$
5    ##  Revision 1.4  2003/05/13 09:23:03  joko
6    ##  pre-flight checks for existance of base directory of to-be-executed script
7    ##
8    ##  Revision 1.3  2003/03/31 05:47:01  janosch
9    ##  Mis mif gex
10    ##
11  ##  Revision 1.2  2003/02/20 21:12:24  joko  ##  Revision 1.2  2003/02/20 21:12:24  joko
12  ##  + prints to STDERR if logfile could not be opened  ##  + prints to STDERR if logfile could not be opened
13  ##  ##
# Line 10  Line 16 
16  ##  ##
17  ## ---------------------------------------------------------------------------  ## ---------------------------------------------------------------------------
18    
19    =pod
20    
21    =head1  Background
22    
23       UNIX = Everything is a file
24       Perl ~ Everything is a string   ;-)
25    
26    
27    =cut
28    
29    
30    
31  package shortcuts::files;  package shortcuts::files;
32    
# Line 22  our @EXPORT_OK = qw( Line 39  our @EXPORT_OK = qw(
39    s2f    s2f
40    a2f    a2f
41    f2s    f2s
42      rif
43      mif
44  );  );
45    
46    
47  use Data::Dumper;  use Data::Dumper;
48    use File::Basename;
49    
50  sub s2f {  sub s2f {
51    my $filename = shift;    my $filename = shift;
52    my $string = shift;    my $string = shift;
53      
54      # pre-flight checks: Does directory exist?
55      my $dirname = dirname($filename);
56      if (not -e $dirname) {
57        print STDERR __PACKAGE__ . ':' . __LINE__ . ": ERROR: Directory '$dirname' does not exist! (Write attempt)" . "\n";
58        return;
59      }
60    
61      # Perform: File write
62    open(FH, '>' . $filename);    open(FH, '>' . $filename);
63    print FH $string;    print FH $string;
64      # Always inject ending newline?
65    print FH "\n";    print FH "\n";
66    close(FH);    close(FH);
67  }  }
68    
69  sub f2s {  sub f2s {
70    my $filename = shift;    my $filename = shift;
71      
72      # pre-flight checks: Does file exist?
73    if (! -e $filename) {    if (! -e $filename) {
74      print STDERR __PACKAGE__ . ':' . __LINE__ . ": File $filename does not exist!" . "\n";      print STDERR __PACKAGE__ . ':' . __LINE__ . ": ERROR: File '$filename' does not exist! (Read attempt)" . "\n";
75      return;      return;
76    }    }
77      
78    # read file at once (be careful with big files!!!)    # read file at once (be careful with big files!!!)
79    open(FH, '<' . $filename);    open(FH, '<' . $filename);
80    my @buf_arr = <FH>;    my @buf_arr = <FH>;
# Line 106  sub rif { Line 139  sub rif {
139    s2f($outfile, $buf);    s2f($outfile, $buf);
140  }  }
141    
142    sub mis {
143      my $string = shift;
144      my $rules = shift;
145    
146      my $mis_result = {};
147      
148      if (ref $rules eq 'HASH') {
149        my @re_find = keys %{$rules};
150        # replace all keys with substitutes from hash "%re_table"
151        foreach my $find (@re_find) {
152          #my $replace = $rules->{$find};
153          #$mis_result &= ($string =~ m/$find/g);
154          $mis_result->{$find} = ($string =~ m/$find/g);
155          $mis_result->{$find} ||= 0;
156        }
157      }
158      
159      if (ref $rules eq 'ARRAY') {
160        foreach my $rule (@{$rules}) {
161          my $find    = (ref $rule eq 'ARRAY') ? $rule->[0] : $rule;
162          $mis_result->{$find} = 0;
163          my $pattern = quotemeta($find);
164          $string =~ s{
165            $pattern     # the pattern used to search through the whole file
166          }{
167            $mis_result->{$find}++;   # build result (increase counter per occourance)
168          }gex;
169        }
170      }
171      
172      return $mis_result;
173    }
174    
175    sub mif {
176      my $filename = shift;
177      my $rules = shift;
178      my $out_suffix = shift;
179    
180      my $outfile = $filename;
181      $outfile .= '.' . $out_suffix if ($out_suffix);
182    
183      my $buf = f2s($filename);
184      return mis($buf, $rules);
185      #s2f($outfile, $buf);
186    }
187    
188  sub findKeyEntries {  sub findKeyEntries {
189    my $string = shift;    my $string = shift;
190    my $pattern = shift;    my $pattern = shift;
Legend:
Removed from v.1.2  
changed lines
  Added in v.1.4
MailToCvsAdmin">MailToCvsAdmin
 ViewVC Help
Powered by ViewVC 1.1.26 RSS 2.0 feed