1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
|
#line 1
package Module::Install::Substitute;
use strict;
use warnings;
use 5.008; # I don't care much about earlier versions
use Module::Install::Base;
our @ISA = qw(Module::Install::Base);
our $VERSION = '0.03';
require File::Temp;
require File::Spec;
require Cwd;
#line 89
sub substitute
{
my $self = shift;
$self->{__subst} = shift;
$self->{__option} = {};
if( UNIVERSAL::isa( $_[0], 'HASH' ) ) {
my $opts = shift;
while( my ($k,$v) = each( %$opts ) ) {
$self->{__option}->{ lc( $k ) } = $v || '';
}
}
$self->_parse_options;
my @file = @_;
foreach my $f (@file) {
$self->_rewrite_file( $f );
}
return;
}
sub _parse_options
{
my $self = shift;
my $cwd = Cwd::getcwd();
foreach my $t ( qw(from to) ) {
$self->{__option}->{$t} = $cwd unless $self->{__option}->{$t};
my $d = $self->{__option}->{$t};
die "Couldn't read directory '$d'" unless -d $d && -r _;
}
}
sub _rewrite_file
{
my ($self, $file) = @_;
my $source = File::Spec->catfile( $self->{__option}{from}, $file );
$source .= $self->{__option}{sufix} if $self->{__option}{sufix};
unless( -f $source && -r _ ) {
print STDERR "Couldn't find file '$source'\n";
return;
}
my $dest = File::Spec->catfile( $self->{__option}{to}, $file );
return $self->__rewrite_file( $source, $dest );
}
sub __rewrite_file
{
my ($self, $source, $dest) = @_;
my $mode = (stat($source))[2];
open my $sfh, "<$source" or die "Couldn't open '$source' for read";
print "Open input '$source' file for substitution\n";
my ($tmpfh, $tmpfname) = File::Temp::tempfile('mi-subst-XXXX', UNLINK => 1);
$self->__process_streams( $sfh, $tmpfh, ($source eq $dest)? 1: 0 );
close $sfh;
seek $tmpfh, 0, 0 or die "Couldn't seek in tmp file";
open my $dfh, ">$dest" or die "Couldn't open '$dest' for write";
print "Open output '$dest' file for substitution\n";
while( <$tmpfh> ) {
print $dfh $_;
}
close $dfh;
chmod $mode, $dest or "Couldn't change mode on '$dest'";
}
sub __process_streams
{
my ($self, $in, $out, $replace) = @_;
my @queue = ();
my $subst = $self->{'__subst'};
my $re_subst = join('|', map {"\Q$_"} keys %{ $subst } );
while( my $str = <$in> ) {
if( $str =~ /^###\s*(before|replace|after)\:\s?(.*)$/s ) {
my ($action, $nstr) = ($1,$2);
$nstr =~ s/\@($re_subst)\@/$subst->{$1}/ge;
die "Replace action is bad idea for situations when dest is equal to source"
if $replace && $action eq 'replace';
if( $action eq 'before' ) {
die "no line before 'before' action" unless @queue;
# overwrite prev line;
pop @queue;
push @queue, $nstr;
push @queue, $str;
} elsif( $action eq 'replace' ) {
push @queue, $nstr;
} elsif( $action eq 'after' ) {
push @queue, $str;
push @queue, $nstr;
# skip one line;
<$in>;
}
} else {
push @queue, $str;
}
while( @queue > 3 ) {
print $out shift(@queue);
}
}
while( scalar @queue ) {
print $out shift(@queue);
}
}
1;
|
