Name

substitute_file —

ATTRIBUTES

Attribute Pos. Req. Default Description
file Yes
content
begin
end
newline
scratch
greedy
replace
case
global
interpolate     0 interpolate input?
reparse     1 interpolate output?
hide     0 Hide the tag return value?

DESCRIPTION

BEHAVIOR

This tag does not appear to be affected by, or affect, the rest of Interchange.

EXAMPLES

No examples are available at this time. We do consider this a problem and will try to supply some.

NOTES

AVAILABILITY

substitute_file is available in Interchange versions:

4.6.0-5.9.0 (git-head)

SOURCE

Interchange 5.9.0:

Source: code/UI_Tag/substitute_file.coretag
Lines: 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

AUTHORS

Interchange Development Group

SEE ALSO

DocBook! Interchange!