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