#!/usr/bin/perl
#$Id: replace,v 1.9 1998/01/26 16:48:19 schwartz Exp $
#
# replace - replaces things with thongs
#
# Demonstrates the use of module Startup.pm
#
# See also usage() of this file. General information at:
# http://wwwwbs.cs.tu-berlin.de/~schwartz/pmh/index.html
#
# Copyright (C) 1997 Martin Schwartz <schwartz@cs.tu-berlin.de>
#
my $PROGNAME = "replace";
my $VERSION=do{my@R=('$Revision: 1.9 $'=~/\d+/g);sprintf"%d."."%d"x$#R,@R};
my $DATE = ('$Date: 1998/01/26 16:48:19 $' =~ / ([^ ]*) /) && $1;
use Getopt::Long;
use Startup;
my ($Startup, $text);
my %opt = ();
main: {
$|=1;
GetOptions (\%opt,
"overwrite",
"search=s",
"replace=s",
"mode=s",
"log",
"gimmick",
"src_base|source_base|source_dir=s",
"dest_base|destbase|destdir=s",
"from_stdin|from_0|from0",
"to_stdout|to_1|to1",
"filemode=s",
"dirmode=s",
"help",
"recurse|recursive",
"relative",
"suffix=s",
);
usage() if $opt{"help"};
usage() if !defined $opt{"search"};
usage() if !defined $opt{"replace"};
fail(1) if !($Startup = new Startup);
$Startup -> init ({
SUB_FILES => \&handle_files,
SUB_STREAM => \&handle_stream,
PROG_NAME => $PROGNAME,
PROG_VER => $VERSION,
FROM_STDIN => $opt{"from_stdin"},
SRCPATH => $opt{"src_base"},
DESTPATH => $opt{"dest_base"},
RECURSE => $opt{"recurse"},
RELATIVE => $opt{"relative"},
FILEMODE => $opt{"filemode"},
DIRMODE => $opt{"dirmode"},
});
$Startup->msg_silent(1) if $opt{"to_stdout"};
$Startup->allow_logging if $opt{"log"};
$Startup->open_log();
$Startup->log('s/'.$opt{"search"}.'/'.$opt{"replace"}.'/'.$opt{"mode"});
if ($opt{"to_stdout"}) {
$Startup->log("writing to STDOUT");
} elsif ($opt{"suffix"}) {
$Startup->log("output files get suffix \"".$opt{"suffix"}."\"");
}
$Startup->go(@ARGV);
$Startup->close_log();
exit 1;
}
sub handle_stream {
my ($dp) = @_;
$Startup->log("processing <STDIN>");
{
return $Startup->error("Nothing to do!") if -t STDIN;
undef $/;
$text = <STDIN>;
}
return 0 if !main_work("stdin.txt");
1}
sub handle_files {
my ($sp, $sf, $dp, $status) = @_;
$Startup->msg_reset();
$Startup->log("processing $sp/$sf");
$Startup->msg("Processing \"$sf\"");
return error ("File \"$sf\" doesn't exist!") if !$status;
return 1 if $status < 0;
{
return 0 if !open INFILE, "$sp/$sf";
my $len = read INFILE, $text, -s "$sp/$sf";
close INFILE;
return $Startup->error("Error when reading \"$sp/$sf\"")
if $len != -s "$sp/$sf"
;
}
return 0 if !main_work("$dp/$sf");
$Startup->msg_finish("done");
1}
sub main_work {
my ($dp) = @_;
$dp = basename($dp) . $opt{"suffix"} if $opt{"suffix"};
my $find = $opt{"search"} || "";
my $replace = $opt{"replace"} || "";
my $mode = $opt{"mode"} || "g";
if (!$opt{"overwrite"}) {
return $Startup->error("File \"$dp\" already exists!") if -e $dp;
}
if ($opt{"gimmick"}) {
$replace = $Startup -> gimmick ($replace);
}
eval '$text =~ s/$find/'."$replace/$mode";
if ($opt{"to_stdout"}) {
return print STDOUT $text;
} else {
return $Startup->error("Cannot open output file \"$dp\"")
if !open OUTFILE, ">$dp"
;
my $status = print OUTFILE $text;
close OUTFILE;
return $Startup->error("Write error") if !$status;
return 1;
}
}
sub fail {
my ($num) = @_;
print "Strange error #$num! Exiting!\n"; exit 0;
}
sub basename {
#
# $basename = basename($filepath)
#
(substr($_[0], rindex($_[0],'/')+1) =~ /(^[^.]*)/) && $1;
}
sub usage {
_print_usage (
"$PROGNAME V$VERSION ($DATE) - replace things in texts.\n"
."usage: $PROGNAME {--option [arg]} --search pat --replace str file(s)",
[
"search s search pattern",
"replace s replace pattern",
"mode s substitute mode (i=ignore case, g=global) default g",
"log write a logfile",
"gimmick replace pattern shall be \"gimmicked\"",
"src_base s Regard this as start directory in relative mode",
"dest_base s Store output files based at this directory",
"from_stdin Take input from stdin",
"to_stdout Write output to stdout",
"filemode s New files get access mode s (default 0600)",
"dirmode s New directories get access mode s (default 0700)",
"overwrite Overwrite existing files",
"recurse Operate recursively on directories",
"relative Store files relatively to destdir when in recurse mode",
"suffix s Output files shall get suffix 's' (not: '.s')",
]
);
exit 0;
}
sub _print_usage {
my ($header, $bodylistR, $footer) = @_;
print "$header\n" if $header;
print map " --$_\n", sort { lc($a) cmp lc($b) } @$bodylistR;
print "$footer\n" if $footer;
}
__END__
=head1 NAME
replace - substitutes text
Use perls regular expressions on a list of files.
=head1 SYNOPSIS
Example:
replace --search 'foo' --replace 'bar' --recurse --log *
=head1 DESCRIPTION
Replace is a utility to substitute text in a bunch of files. It is used
also to demonstrate the use of perl module Startup. You can use perls
regular expressions as search and replace strings.
usage: $PROGNAME {--option [arg]} file(s)
search s search pattern
replace s replace pattern
mode s substitute mode (i=ignore case, g=global) default g
log write a logfile
gimmick replace pattern shall be "gimmicked"
src_base s Regard this as start directory in relative mode
dest_base s Store output files based at this directory
from_stdin Take input from stdin
to_stdout Write output to stdout
filemode s New files get access mode s (default 0600)
dirmode s New directories get access mode s (default 0700)
overwrite Overwrite existing files
recurse Operate recursively on directories
relative Store files relatively to destdir when in recurse mode
suffix s Give output files this suffix
=head1 SEE ALSO
L<Startup>
=head1 AUTHOR
Martin Schwartz E<lt>F<schwartz@cs.tu-berlin.de>E<gt>.
=cut