libs/shortcuts/files.pm

## ---------------------------------------------------------------------------
##  $Id: files.pm,v 1.1 2003/02/11 09:50:00 joko Exp $
## ---------------------------------------------------------------------------
##  $Log: files.pm,v $
##  Revision 1.1  2003/02/11 09:50:00  joko
##  + code from Data::Storage::Handler::File::Basic
##
## ---------------------------------------------------------------------------


package shortcuts::files;

use strict;
use warnings;

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


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 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.2	## $Id: files.pm,v 1.1 2003/02/11 09:50:00 joko Exp $
3	joko	1.1	## ---------------------------------------------------------------------------
4	joko	1.2	## $Log: files.pm,v $
5			## Revision 1.1 2003/02/11 09:50:00 joko
6			## + code from Data::Storage::Handler::File::Basic
7			##
8	joko	1.1	## ---------------------------------------------------------------------------
9
10
11			package shortcuts::files;
12
13			use strict;
14			use warnings;
15
16			require Exporter;
17			our @ISA = qw( Exporter );
18			our @EXPORT_OK = qw(
19			s2f
20			a2f
21			f2s
22			);
23
24
25			use Data::Dumper;
26
27			sub s2f {
28			my $filename = shift;
29			my $string = shift;
30			open(FH, '>' . $filename);
31			print FH $string;
32			print FH "\n";
33			close(FH);
34			}
35
36			sub f2s {
37			my $filename = shift;
38	joko	1.2	if (! -e $filename) {
39			print STDERR __PACKAGE__ . ':' . __LINE__ . ": File $filename does not exist!" . "\n";
40			return;
41			}
42	joko	1.1	# read file at once (be careful with big files!!!)
43			open(FH, '<' . $filename);
44			my @buf_arr = <FH>;
45			my $buf = join("", @buf_arr);
46			close(FH);
47			return $buf;
48			}
49
50			sub a2f {
51			my $filename = shift;
52			my $string = shift;
53			open(FH, '>>' . $filename) or do {
54			print "Could not append to \"$filename\"!", "\n";
55			print "Log-Message was: ";
56			print $string if $string;
57			print "\n";
58			return;
59			};
60			#print FH "\n";
61			print FH $string;
62			print FH "\n";
63			close(FH);
64			return 1;
65			}
66
67			sub ris {
68			my $string = shift;
69			my $rules = shift;
70
71			our $ris_result = 1;
72
73			if (ref $rules eq 'HASH') {
74			my @re_find = keys %{$rules};
75			# replace all keys with substitutes from hash "%re_table"
76			foreach my $find (@re_find) {
77			my $replace = $rules->{$find};
78			$ris_result &= ($string =~ s/$find/$replace/g);
79			}
80			}
81
82			if (ref $rules eq 'ARRAY') {
83			foreach my $rule (@{$rules}) {
84			my $find = $rule->[0];
85			my $replace = $rule->[1];
86			$ris_result &= ($string =~ s/$find/$replace/g);
87			}
88			}
89
90			return $string;
91			}
92
93			sub rif {
94			my $filename = shift;
95			my $rules = shift;
96			my $out_suffix = shift;
97
98			my $outfile = $filename;
99			$outfile .= '.' . $out_suffix if ($out_suffix);
100
101			my $buf = f2s($filename);
102			$buf = ris($buf, $rules);
103			s2f($outfile, $buf);
104			}
105
106			sub findKeyEntries {
107			my $string = shift;
108			my $pattern = shift;
109			my @arr = split("\n", $string);
110			my @entries;
111			foreach (@arr) {
112			chomp;
113			#print "l: ", $_, "\n";
114			if (m/$pattern/) {
115			push @entries, $1;
116			}
117			}
118			return \@entries;
119			}
120
121			# ---------------------------------
122			# is a context-entry in a file?
123			# a "context-entry" is an entry identified
124			# by a certain keystring, which itself
125			# is detected dynamically
126			sub isEntryInFile {
127
128			my $chk = shift;
129			my $content_current = f2s($chk->{filename});
130
131			# try to find all key-entries via patterns which are "entry-identifiers"
132			if (my @keys = @{ findKeyEntries($chk->{'out'}, $chk->{'pattern'}{'EntryIdent'}) }) {
133			# iterate through all "entry-identifiers"
134			foreach (@keys) {
135			my $pattern = $chk->{'pattern'}{'EntryCheck'};
136			$pattern =~ s/\@\@KEY\@\@/$_/;
137			my $bool_AlreadyThere = ($content_current =~ m/$pattern/);
138			if ($bool_AlreadyThere) {
139			$chk->{'EntryFound'} = $_;
140			return 1;
141			}
142			}
143			}
144
145			}
146
147			1;
148			__END__
MailToCvsAdmin">MailToCvsAdmin	ViewVC Help
Powered by ViewVC 1.1.26