libs/shortcuts/files.pm

## ---------------------------------------------------------------------------
##  $Id: files.pm,v 1.3 2003/03/31 05:47:01 janosch Exp $
## ---------------------------------------------------------------------------
##  $Log: files.pm,v $
##  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;

use strict;
use warnings;

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


use Data::Dumper;
use File::Basename;

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