-
Notifications
You must be signed in to change notification settings - Fork 27
/
substitute_file.coretag
116 lines (105 loc) · 3.13 KB
/
substitute_file.coretag
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
# Copyright 2002-2007 Interchange Development Group and others
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version. See the LICENSE file for details.
#
# $Id: substitute_file.coretag,v 1.4 2007-03-30 23:40:54 pajamian Exp $
UserTag substitute_file Order file
UserTag substitute_file addAttr
UserTag substitute_file hasEndTag
UserTag substitute_file Version $Revision: 1.4 $
UserTag substitute_file Routine <<EOR
## This is a stupid thing to make 5.6.1 and File::Copy
## compatible with Safe
require File::Copy;
package File::Copy;
require File::Basename;
import File::Basename 'basename';
package Vend::Interpolate;
sub {
my ($file, $opt, $replace) = @_;
my $die = sub {
my @args = @_;
$::Scratch->{ui_failure} = errmsg(@args);
return undef;
};
return $die->("substitute_file - %s: file does not exist", $file)
if ! -f $file;
return $die->("substitute_file - %s: file not writeable", $file)
if ! -w $file;
if($opt->{content}) {
$opt->{begin} = '<!--+\s*begin\s+content\s*--+>';
$opt->{end} = '<!--+\s*end\s+content\s*--+>';
$opt->{newline} = 1 if ! defined $opt->{newline};
}
if($opt->{scratch}) {
$opt->{begin} = '\[(?:tmp|seti?)\s*' . $opt->{scratch} . '\]';
$opt->{end} = '\[/(?:tmp|seti?)\]';
$opt->{greedy} = 0 if ! defined $opt->{greedy};
$opt->{newline} = 1 if ! defined $opt->{newline};
}
if (! length($opt->{begin}) or ! length($opt->{end})) {
return $die->("missing begin or end marker");
}
my $bak = POSIX::tmpnam();
File::Copy::copy($file, $bak)
or return $die->(
"substitute_file - %s: unable to backup to %s",
$file, $bak,
);
my $data = Vend::Util::readfile($file);
return $die->("substitute_file - %s: file has no data", $file)
unless length $data;
my $exist;
if(defined $opt->{greedy} and ! Vend::Util::is_yes($opt->{greedy}) ) {
$exist = $opt->{newline} ? '[\s\S]*?' : '.*?';
}
else {
$exist = $opt->{newline} ? '[\s\S]*' : '.*';
}
my $begin = $opt->{begin};
my $end = $opt->{end};
my $subbed;
my $sub = sub {
my ($begin, $replace, $end) = @_;
return $replace if $opt->{replace};
return $begin . $replace . $end;
};
if($opt->{case} and $opt->{global}) {
$subbed = $data =~ s{($begin)$exist($end)}{$sub->($1, $replace, $2)}ge;
}
elsif($opt->{global}) {
$subbed = $data =~ s{($begin)$exist($end)}{$sub->($1, $replace, $2)}ige;
}
elsif($opt->{case}) {
$subbed = $data =~ s{($begin)$exist($end)}{$sub->($1, $replace, $2)}e;
}
else {
$subbed = $data =~ s{($begin)$exist($end)}{$sub->($1, $replace, $2)}ie;
}
if( $subbed ) {
open(SUBFILE, ">$file")
or return $die->(
"substitute_file: cannot write %s, backup in %s",
$file, $bak,
);
print SUBFILE $data
or return $die->(
"substitute_file: error writing %s, backup in %s",
$file, $bak,
);
close SUBFILE
or return $die->(
"substitute_file: error closing %s, backup in %s",
$file, $bak,
);
unlink $bak;
}
else {
unlink $bak;
return 0;
}
}
EOR