# 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.

UserTag substitute_file Order file

UserTag substitute_file addAttr

UserTag substitute_file hasEndTag

UserTag substitute_file Version 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;

require File::Temp;

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 = File::Temp::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