replaceblock

#!/usr/bin/perl
# This code is a part of Slash, and is released under the GPL.
# Copyright 1997-2002 by Open Source Development Network. 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-2002 by Open Source Development Network. See README
and COPYING for more information, or see http://slashcode.com/.
 
EOT
exit;
}

__END__