HighPerl Version 2.5

generated: Sun Jun 23 21:16:55 2002

1	#!/usr/bin/perl
2	use strict;
3	use warnings;
4	
5	our @Files = qw/*/;
6	our @ReFiles = ();
7	our %Match = ();
8	our $Backup = ".$$";
9	our $Rename = 1;
10	our $Verbose = 0;
11	
12	use Getopt::Long;
13	GetOptions(
14	
15	    # expression for files to match
16	    'files:s' => \@Files,
17	
18	    # regular expression
19	    're-files:s' => \@ReFiles,
20	
21	    # key=value for substitution
22	    'substitute|match:s' => \%Match,
23	
24	    # backup-extension
25	    'backup:s' => \$Backup,
26	
27	    # clobber original file?
28	    'replace|rename!' => \$Rename,
29	
30	    'verbose' => \$Verbose,
31	);
32	
33	
34	our $Process = join '|',
35	        map( { '^'.join('.*',map quotemeta,split/\*/,$_,-1).'$' } @Files ),
36	        @ReFiles
37	;
38	
39	
40	
41	use File::Find 'find';
42	use Fcntl ':flock';
43	
44	
45	find( {
46	
47	    preprocess => sub {shift;
48	
49	        grep /$Process/,@_;
50	
51	    },
52	    wanted => sub {
53	
54	        -d and return;
55	
56	        print if $Verbose;
57	
58	        local *SOURCE;
59	        open SOURCE,"<$_" or do {
60	            warn "unable to open $_: $!";
61	            return
62	        };
63	        flock SOURCE,LOCK_SH;
64	
65	        local *BACK;
66	        open BACK,">$_$Backup" or do {
67	            warn "unable to open $_$Backup: $!";
68	            close SOURCE;
69	            return;
70	        };
71	        flock BACK,LOCK_EX;
72	
73	        while( defined(local $_=<SOURCE>) ){
74	
75	            for my $m (keys %Match){
76	
77	                s/$m/"$Match{$m}"/eg;
78	                    #enables using $1 .. $n
79	            }
80	
81	            print BACK $_;
82	        }
83	
84	        close SOURCE;
85	
86	        close BACK or do {
87	            warn "could not close $_$Backup: $!";
88	            return;
89	        };
90	
91	        rename $_.$Backup , $_ or do {
92	            warn "could not rename $_: $!";
93	            return;
94	        }           if $Rename;
95	
96	        print ".\n" if $Verbose;
97	
98	    }
99	
100	},
101	    @ARGV
102	);
103