libs/shortcuts/files.pm

## ---------------------------------------------------------------------------
##  $Id: shortcuts.pm,v 1.4 2003/02/09 16:31:00 joko Exp $
## ---------------------------------------------------------------------------
##  $Log: shortcuts.pm,v $
## ---------------------------------------------------------------------------


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