Permalink
Fetching contributors…
Cannot retrieve contributors at this time
executable file 142 lines (115 sloc) 3.7 KB
#!/usr/bin/perl
# This code is a part of Slash, and is released under the GPL.
# Copyright 1997-2005 by Open Source Technology Group. See README
# and COPYING for more information, or see http://slashcode.com/.
# $Id$
use strict;
use File::Basename;
use Getopt::Std;
use Slash::DB;
(my $VERSION) = ' $Revision$ ' =~ /\$Revision:\s+([^\s]+)/;
my $PROGNAME = basename($0);
my(@blocktypes) = ('blocks', 'portald');
my(%opts);
usage('Options used incorrectly') unless getopts('hDvu:TM:b:m:', \%opts);
usage() if ($opts{'h'} || !keys %opts);
version() if $opts{'v'};
$opts{'u'} ||= 'slash';
$"='|';
my $regexp = '^(' . "@blocktypes" . ')$';
usage() if $#ARGV < 1 || $opts{h} || ($opts{m} && $opts{M}) ||
($opts{M} && $opts{M} !~ /$regexp/);
my($search, $replace) = @ARGV;
# Catch common errors.
$opts{r}=~ s/^\*//;
$search =~ s/^\*//;
my($dbName, $blockName, $debug, $cond, $count, $replaced) =
($opts{u}, $opts{b}, $opts{D}, '', 0);
my($m_regexp, $m_type) = @opts{qw[m M]};
my $dbobject = new Slash::DB($dbName) ||
die "%%%%%% Can't open database on Virtual User $dbName.\n";
$cond = 'bid=' . $dbobject->{dbh}->quote($blockName) if $blockName;
$cond .= ' type=' . $dbobject->{dbh}->quote($opts{t}) if $opts{t};
if ($cond !~ /^bid/ && !$opts{T}) {
print (!$m_type ? <<EOGT:<<EOTT);
%%%%%% You are about to perform a global search and replace on your blocks
%%%%%% table.
EOGT
%%%%%% You are about to perform a global search and replace on all blocks of
%%%%%% type $m_type.
EOTT
print <<EOT;
%%%%%%
%%%%%% Please confirm that this is what you wish by typing 'YES' at the prompt
%%%%%% below:
EOT
print "> ";
my $response = <STDIN>;
die "%%%%%% Cancelled by user.\n" if $response ne 'YES';
}
print "%%%%%% Searching for: $search\n%%%%%% Replacing with: $replace\n"
if $debug;
my $sth = $dbobject->sqlSelectMany('bid,block', 'blocks', $cond);
while (my($bid, $block) = $sth->fetchrow_array()) {
print "%%%%%% Processing '$bid'\n" if !$blockName;
$count++;
if ($m_regexp) {
eval { next if $bid !~ /$m_regexp/ } ;
die "Invalid block regexp '$m_regexp'!\n" if $@;
print "%%%%%% -- Matched\n" if $debug;
}
my $replace_cond = 'bid='.$dbobject->{dbh}->quote($bid);
print <<EOT if $debug;
%%%%%% Current contents for $block
$block
EOT
my $rc;
eval { $rc = $block =~ s/$search/$replace/g; };
die <<EOT if $@;
Error in regular expression: SEARCH='$search'; REPLACE='$replace'\n
EOT
unless ($rc) {
print "%%%%%% -- Search string not found.\n";
next;
}
$replaced++;
print "%%%%%% Resulting contents\n$block\n" if $debug && $rc;
if (! $opts{T}) {
$dbobject->sqlUpdate('blocks', { block => $block }, $replace_cond)
|| print <<EOT;
%%%%%% -- Error occured while writing to database: $dbobject->{dbh}->errstr
EOT
}
print "%%%%%% -- Testing, replace not performed.\n" if $opts{T};
}
print "%%%%%% $count blocks processed, $replaced blocks substituted.\n";
0;
sub usage {
local $" = "\n\t\t";
print <<EOT;
$PROGNAME: [-b <block>|-m <regexp>] [-M <type>] [-u <DBVirtualUser>] [-Dhv] <s> <r>
-b Block on which we perform operation.
-m Perform operation on blockname matching <regexp> [do not use with -M]
-M Specify Block Type [do not use with -m]
-u Specify Database Virtual User (default: slash) [do not use with -M].
-D Display debugging information.
-T Test mode (does not actually perform replace)
-h Shows this screen.
-v Shows program version.
<s> Search expression
<r> Replacement expression
Types recognized:
@blocktypes
EOT
exit 1;
}
sub version {
print <<EOT;
$PROGNAME $VERSION
This code is a part of Slash, and is released under the GPL.
Copyright 1997-2005 by Open Source Technology Group. See README
and COPYING for more information, or see http://slashcode.com/.
EOT
exit;
}
__END__