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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.2 - (hide 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 joko 1.1 #!/usr/bin/perl
2    
3     ## ------------------------------------------------------------------------
4 joko 1.2 ## $Id: modifier.pl,v 1.1 2003/02/01 02:56:03 joko Exp $
5 joko 1.1 ## ------------------------------------------------------------------------
6 joko 1.2 ## $Log: modifier.pl,v $
7     ## Revision 1.1 2003/02/01 02:56:03 joko
8     ## + initial commit
9     ##
10 joko 1.1 ## ------------------------------------------------------------------------
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 joko 1.2 #use Data::Storage::Handler::File qw( s2f );
40     use Data::Storage::Handler::File;
41    
42 joko 1.1
43     # ----------------------------------------
44     package main;
45    
46     my $settings;
47    
48     sub main {
49    
50     my $defaults = {
51     options => {
52 joko 1.2 'in-type' => 'stdin',
53 joko 1.1 #'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 joko 1.2 if ($settings->{options}->{'in-type'} eq 'stdin') {
81 joko 1.1 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 joko 1.2 #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 joko 1.1
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