libs/shortcuts/files.pm

## ---------------------------------------------------------------------------
##  $Id: files.pm,v 1.2 2003/02/20 21:12:24 joko Exp $
## ---------------------------------------------------------------------------
##  $Log: files.pm,v $
##  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;

use strict;
use warnings;

require Exporter;
our @ISA = qw( Exporter );
our @EXPORT_OK = qw( 
  s2f
  a2f
  f2s
  rif
  mif
);


use Data::Dumper;

sub s2f {
  my $filename = shift;
  my $string = shift;
  open(FH, '>' . $filename);
  print FH $string;
  print FH "\n";
  close(FH);
}

sub f2s {
  my $filename = shift;
  if (! -e $filename) {
    print STDERR __PACKAGE__ . ':' . __LINE__ . ": File $filename does not exist!" . "\n";
    return;
  }
  # 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 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;
  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;
      }
    }
  }

}

1;
__END__
1	joko	1.1	## ---------------------------------------------------------------------------
2	janosch	1.3	## $Id: files.pm,v 1.2 2003/02/20 21:12:24 joko Exp $
3	joko	1.1	## ---------------------------------------------------------------------------
4	joko	1.2	## $Log: files.pm,v $
5	janosch	1.3	## Revision 1.2 2003/02/20 21:12:24 joko
6			## + prints to STDERR if logfile could not be opened
7			##
8	joko	1.2	## Revision 1.1 2003/02/11 09:50:00 joko
9			## + code from Data::Storage::Handler::File::Basic
10			##
11	joko	1.1	## ---------------------------------------------------------------------------
12
13	janosch	1.3	=pod
14
15			=head1 Background
16
17			UNIX = Everything is a file
18			Perl ~ Everything is a string ;-)
19
20
21			=cut
22
23
24	joko	1.1
25			package shortcuts::files;
26
27			use strict;
28			use warnings;
29
30			require Exporter;
31			our @ISA = qw( Exporter );
32			our @EXPORT_OK = qw(
33			s2f
34			a2f
35			f2s
36	janosch	1.3	rif
37			mif
38	joko	1.1	);
39
40
41			use Data::Dumper;
42
43			sub s2f {
44			my $filename = shift;
45			my $string = shift;
46			open(FH, '>' . $filename);
47			print FH $string;
48			print FH "\n";
49			close(FH);
50			}
51
52			sub f2s {
53			my $filename = shift;
54	joko	1.2	if (! -e $filename) {
55			print STDERR __PACKAGE__ . ':' . __LINE__ . ": File $filename does not exist!" . "\n";
56			return;
57			}
58	joko	1.1	# read file at once (be careful with big files!!!)
59			open(FH, '<' . $filename);
60			my @buf_arr = <FH>;
61			my $buf = join("", @buf_arr);
62			close(FH);
63			return $buf;
64			}
65
66			sub a2f {
67			my $filename = shift;
68			my $string = shift;
69			open(FH, '>>' . $filename) or do {
70			print "Could not append to \"$filename\"!", "\n";
71			print "Log-Message was: ";
72			print $string if $string;
73			print "\n";
74			return;
75			};
76			#print FH "\n";
77			print FH $string;
78			print FH "\n";
79			close(FH);
80			return 1;
81			}
82
83			sub ris {
84			my $string = shift;
85			my $rules = shift;
86
87			our $ris_result = 1;
88
89			if (ref $rules eq 'HASH') {
90			my @re_find = keys %{$rules};
91			# replace all keys with substitutes from hash "%re_table"
92			foreach my $find (@re_find) {
93			my $replace = $rules->{$find};
94			$ris_result &= ($string =~ s/$find/$replace/g);
95			}
96			}
97
98			if (ref $rules eq 'ARRAY') {
99			foreach my $rule (@{$rules}) {
100			my $find = $rule->[0];
101			my $replace = $rule->[1];
102			$ris_result &= ($string =~ s/$find/$replace/g);
103			}
104			}
105
106			return $string;
107			}
108
109			sub rif {
110			my $filename = shift;
111			my $rules = shift;
112			my $out_suffix = shift;
113
114			my $outfile = $filename;
115			$outfile .= '.' . $out_suffix if ($out_suffix);
116
117			my $buf = f2s($filename);
118			$buf = ris($buf, $rules);
119			s2f($outfile, $buf);
120	janosch	1.3	}
121
122			sub mis {
123			my $string = shift;
124			my $rules = shift;
125
126			my $mis_result = {};
127
128			if (ref $rules eq 'HASH') {
129			my @re_find = keys %{$rules};
130			# replace all keys with substitutes from hash "%re_table"
131			foreach my $find (@re_find) {
132			#my $replace = $rules->{$find};
133			#$mis_result &= ($string =~ m/$find/g);
134			$mis_result->{$find} = ($string =~ m/$find/g);
135			$mis_result->{$find} \|\|= 0;
136			}
137			}
138
139			if (ref $rules eq 'ARRAY') {
140			foreach my $rule (@{$rules}) {
141			my $find = (ref $rule eq 'ARRAY') ? $rule->[0] : $rule;
142			$mis_result->{$find} = 0;
143			my $pattern = quotemeta($find);
144			$string =~ s{
145			$pattern # the pattern used to search through the whole file
146			}{
147			$mis_result->{$find}++; # build result (increase counter per occourance)
148			}gex;
149			}
150			}
151
152			return $mis_result;
153			}
154
155			sub mif {
156			my $filename = shift;
157			my $rules = shift;
158			my $out_suffix = shift;
159
160			my $outfile = $filename;
161			$outfile .= '.' . $out_suffix if ($out_suffix);
162
163			my $buf = f2s($filename);
164			return mis($buf, $rules);
165			#s2f($outfile, $buf);
166	joko	1.1	}
167
168			sub findKeyEntries {
169			my $string = shift;
170			my $pattern = shift;
171			my @arr = split("\n", $string);
172			my @entries;
173			foreach (@arr) {
174			chomp;
175			#print "l: ", $_, "\n";
176			if (m/$pattern/) {
177			push @entries, $1;
178			}
179			}
180			return \@entries;
181			}
182
183			# ---------------------------------
184			# is a context-entry in a file?
185			# a "context-entry" is an entry identified
186			# by a certain keystring, which itself
187			# is detected dynamically
188			sub isEntryInFile {
189
190			my $chk = shift;
191			my $content_current = f2s($chk->{filename});
192
193			# try to find all key-entries via patterns which are "entry-identifiers"
194			if (my @keys = @{ findKeyEntries($chk->{'out'}, $chk->{'pattern'}{'EntryIdent'}) }) {
195			# iterate through all "entry-identifiers"
196			foreach (@keys) {
197			my $pattern = $chk->{'pattern'}{'EntryCheck'};
198			$pattern =~ s/\@\@KEY\@\@/$_/;
199			my $bool_AlreadyThere = ($content_current =~ m/$pattern/);
200			if ($bool_AlreadyThere) {
201			$chk->{'EntryFound'} = $_;
202			return 1;
203			}
204			}
205			}
206
207			}
208
209			1;
210			__END__
MailToCvsAdmin">MailToCvsAdmin	ViewVC Help
Powered by ViewVC 1.1.26