/[cvs]/nfo/perl/scripts/archiver/bin/modifier.pl
ViewVC logotype

Contents of /nfo/perl/scripts/archiver/bin/modifier.pl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.2 - (show annotations)
Sat Feb 1 06:44:08 2003 UTC (21 years, 5 months ago) by joko
Branch: MAIN
CVS Tags: HEAD
Changes since 1.1: +58 -5 lines
File MIME type: text/plain
+ added option and implementation for '--in-type=pathlist'

1 #!/usr/bin/perl
2
3 ## ------------------------------------------------------------------------
4 ## $Id: modifier.pl,v 1.1 2003/02/01 02:56:03 joko Exp $
5 ## ------------------------------------------------------------------------
6 ## $Log: modifier.pl,v $
7 ## Revision 1.1 2003/02/01 02:56:03 joko
8 ## + initial commit
9 ##
10 ## ------------------------------------------------------------------------
11
12
13 =pod
14
15 modifier.pl - modify things (files) using regular expressions
16
17 - cat <file.txt> | ./modifier.pl --regex=s/:pserver:/:ext:/
18 modifies content piped to it applying the regular expression given (on unix)
19
20 - type <file.txt> | perl modifier.pl --regex="s/main/Hello World!/g"
21 modifies content piped to it applying the regular expression given (on win32)
22
23 =cut
24
25
26 use strict;
27 use warnings;
28
29 BEGIN {
30 use FindBin qw($Bin);
31 #require "$Bin/use_libs.pl";
32 #use org::netfrag::preambel;
33 }
34
35 use lib qw( ../../../libs ../libs ../etc );
36
37 use Data::Dumper;
38 use Getopt::Easy;
39 #use Data::Storage::Handler::File qw( s2f );
40 use Data::Storage::Handler::File;
41
42
43 # ----------------------------------------
44 package main;
45
46 my $settings;
47
48 sub main {
49
50 my $defaults = {
51 options => {
52 'in-type' => 'stdin',
53 #'in-type' => 'pathlist',
54 #'regex' => '.*',
55 },
56 #args => [qw( . )],
57 };
58
59 my $optReader = Getopt::Easy->new();
60 $optReader->merge_defaults($defaults);
61 $optReader->merge_cli_arguments();
62 $settings = $optReader->getOptions();
63
64 if (!$settings->{options}->{regex}) {
65 die("Please specify regular expression to apply to " . $settings->{options}->{'in-type'});
66 }
67
68 #print Dumper($settings); exit;
69 #print Dumper($settings);
70 replace();
71
72 #find(\&wanted, $settings->{args}->[0]);
73 #my $where = $settings->{args}->[0];
74 #find(\&wanted, $where);
75
76 }
77
78 sub replace {
79
80 if ($settings->{options}->{'in-type'} eq 'stdin') {
81 my @buffer;
82 my $pattern = $settings->{options}->{regex};
83 while (<STDIN>) {
84 chomp;
85 eval($pattern);
86 print;
87 print "\n";
88 }
89
90 } elsif ($settings->{options}->{'in-type'} eq 'pathlist') {
91 #die("not implemented yet!");
92 my $pattern = $settings->{options}->{regex};
93 while (<STDIN>) {
94 chomp;
95 print "modifying $_: ";
96 my $file = Data::Storage::Handler::File->new( path => $_ );
97 #print Dumper($file), "\n";
98 #print Dumper($file->toString()), "\n";
99 #exit;
100 #print "replacing...", "\n";
101
102 if ($file->matches($pattern)) {
103 print "MATCH - ";
104
105 if (my $suffix_backup = $settings->{options}->{backup}) {
106 if ($suffix_backup eq '1') { $suffix_backup = 'bak'; }
107 #print "made backup of original-file";
108 $file->backup( { suffix => $suffix_backup } );
109 }
110
111 if ($settings->{options}->{infile}) {
112 print "replaced infile";
113 die("not yet implemented");
114
115 } elsif ($settings->{options}->{overwrite}) {
116 print "overwritten";
117 $file->save();
118
119 } elsif (my $suffix = $settings->{options}->{suffix}) {
120 print "suffixed with $suffix";
121 $file->addSuffix($suffix);
122 $file->save();
123
124 } else {
125 print "no action (e.g. --infile|--suffix=tmp) applied";
126 }
127 #exit;
128
129 } else {
130 print "NO match - not touched";
131 }
132 #print;
133 print "\n";
134 #print Dumper($content), "\n";
135
136 #print "writing ....", "\n";
137 #exit;
138 }
139
140
141 }
142 }
143
144 main();
145
146 1;
147 __END__

MailToCvsAdmin">MailToCvsAdmin
ViewVC Help
Powered by ViewVC 1.1.26 RSS 2.0 feed