# 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 xfer-catalog Order file

UserTag xfer-catalog addAttr

UserTag xfer-catalog Version 1.7

UserTag xfer-catalog Routine <<EOR

sub {

my ($file, $opt) = @_;

my %dsn;

my %db;

my %export;

my %dbtype;

my %dbname;

my %user;

my %pass;

my $now = time();

my $root = $Vend::Cfg->{VendRoot};

my $catname = $Vend::Cfg->{CatalogName};

my @exclude = ("./$catname.tar.gz", './products/existing.site.txt');

my %exclude = (

tmp => ['./tmp/*'],

session => ['./session/*'],

usertrack => ["./$Vend::Cfg->{TrackFile}"],

orders => ["./logs/tracking.asc", './orders/*'],

survey => ["./logs/survey"],

logs => ['./logs/log', './error.log'],

backup => ['./backup/*'],

config => ['./config/*'],

upload => ['./upload/*'],

download => ['./download/*'],

);

my $export_and_exclude = sub {

my ($t, $o) = @_;

my $dbo = dbref($t);

$dbo = $dbo->ref() if $dbo;

$export{$t} = $o->{file};

my $dir = $o->{DIR};

my $dbf = $o->{db_file};

if($dbf =~ m{^/}) {

$dbf =~ s{^$root}{.};

}

elsif($dir =~ s{^$root}{.}) {

$dbf = "$dir/$dbf";

}

else {

::logDebug("Unrecognized db file $dbf");

}

push @exclude, $dbf;

};

my @restore = (<<'EOF');

#!/bin/sh

DIR=$1

USAGE="ic_restore.sh [directory]";

if test -n "$DIR"

then

cd $DIR || (echo "$DIR: does not exist"; echo $USAGE; exit 1);

fi

if test ! -d xfer/exports

then

echo "Not a restore directory for Interchange."

echo $USAGE

exit 1;

fi

cp -r xfer/exports/* products

EOF

my %maptype = (

mysql => {

restore => $::Variable->{RESTORE_COMMAND_MYSQL} || 'mysql',

create => $::Variable->{CREATE_COMMAND_MYSQL} || 'mysqladmin create %s',

command => $::Variable->{DUMP_COMMAND_MYSQL} || 'mysqldump --add-drop-table',

host => '-h %s',

port => '-p %s',

user => '-u %s',

pass => '-p%s',

},

Pg => {

restore => $::Variable->{RESTORE_COMMAND_PG} || 'psql -q',

create => $::Variable->{CREATE_COMMAND_PG} || 'createdb %s',

command => $::Variable->{DUMP_COMMAND_PG} || 'pg_dump -c -O',

host => '-h %s',

port => '-p %s',

user => '-U %s',

},

);

my %usermap = (

mysql => {

USER => '-u %s',

PASS => '-p%s',

},

Pg => {

USER => '-U %s',

},

);

my %dbparm = (

mysql => {

database => 1,

},

Pg => {

dbname => 1,

},

);

my $date = POSIX::strftime('%Y%m%d%H%M%S', localtime());

if(-e 'xfer') {

unless($opt->{backup_old}) {

File::Path::rmtree('xfer');

}

else {

rename 'xfer', "xfer.backup.$date";

}

}

File::Path::mkpath('xfer');

File::Path::mkpath('xfer/exports');

File::Path::mkpath('xfer/dumps');

while( my ($t, $o) = each %{$Vend::Cfg->{Database}} ) {

next if $t eq 'site';

#::logDebug("Parsing $t");

if(! $o) {

::logDebug("bad object=$o table=$t");

next;

}

#::logDebug("$t type=$o->{type}");

if($o->{type} != 8) {

$export_and_exclude->($t, $o);

next;

}

my $dsn = $o->{DSN};

#::logDebug("$t DSN=$o->{DSN}");

next if $dsn{$dsn};

my $dbstring = $dsn;

$dbstring =~ s/^dbi://i;

$dbstring =~ s/^(\w+)://i;

my $driver = $1;

#::logDebug("$t driver=$driver");

my $map = $maptype{$driver};

if(! $map) {

$export_and_exclude->($t, $o);

next;

}

$dbtype{$dsn} = $driver;

my $dbname;

my @pieces = split /\s*;\s*/, $dbstring;

my @args;

for(@pieces) {

#::logDebug("checking piece=$_");

if(/=/) {

my ($k, $v) = split /\s*=\s*/, $_;

$k = lc $k;

if(my $tpl = $map->{$k}) {

$tpl =~ s/\%s/$v/g;

push @args, $tpl;

}

elsif($dbparm{$driver}->{$k}) {

$dbname = $v;

}

else {

Vend::Tags->warnings("Unrecognized DSN atom '$_'");

next;

}

}

else {

$dbname = $_;

}

}

if(! $dbname) {

my $msg = "Unable to find dbname for $dsn.";

logError($msg);

return $msg if $opt->{show_error};

return;

}

$dbname{$dsn} = $dbname;

if (my $user = $o->{USER}) {

$user{$dsn} = $user;

my $tpl = $map->{user};

$tpl =~ s/\%s/$user/g

and push @args, " $tpl";

}

if (my $pass = $o->{PASS}) {

$pass{$dsn} = $pass;

my $tpl = $map->{pass};

$tpl =~ s/\%s/$pass/g

and push @args, " $tpl";

}

$dsn{$dsn} = join " ", $map->{command}, @args, $dbname;

}

for my $t (keys %export) {

$export{$t} =~ m{(.*)/}

and do {

my $dircomp = $1;

File::Path::mkpath("$root/xfer/exports/$dircomp");

};

Vend::Data::export_database($t, "$root/xfer/exports/$export{$t}", undef, {})

or logError("Failed to export table $t in xfer-catalog.");

}

for(keys %dsn) {

my $ext = $_ eq $::Variable->{SQLDSN} ? 'maindump' : 'dump';

my $cmd = "$dsn{$_} > xfer/dumps/$dbname{$_}.$dbtype{$_}.$ext";

#::logDebug("executing $cmd");

system $cmd;

if($?) {

my $status = $?;

my $err = $status >> 8;

my $msg = errmsg("error=%s, status=%s execuding dump '%s': %s", $err, $status, $cmd, $!);

::logDebug($msg);

::logError($msg);

return $msg if $opt->{show_error};

return;

}

}

if($opt->{keep_together} ||= $CGI::values{keep_together}) {

my @keys = grep /\w/, split /[\s,\0]+/, $opt->{keep_together};

for(@keys) {

#::logDebug("Setting keepname keep_$_");

$opt->{"keep_$_"} = 1;

}

}

for my $name (keys %exclude) {

my $kname = "keep_$name";

if(exists $opt->{$kname}) {

next if $opt->{$kname};

}

if ($CGI::values{$kname}) {

next;

}

push @exclude, @{$exclude{$name}};

}

my $excludestring = join("\n", @exclude, '');

#::logDebug("exclude:\n$excludestring");

unlink 'exclude-files';

Vend::File::writefile('exclude-files', $excludestring);

my @vars = qw/

CGI_URL

DOCROOT

IMAGE_DIR

ORDERS_TO

SAMPLEHTML

SAMPLEURL

SECURE_SERVER

SERVER_NAME

SQLDSN

SQLPASS

SQLUSER

IC_DIR

CGI_DIR

CGIWRAP

LINKMODE

LINKHOST

LINKPORT

LINKPORT

/;

if(defined $opt->{variables}) {

@vars = grep /\S/, split /[\s,\0+]/, $opt->{variables};

}

my $vdb = dbref('variable');

my @vdb = "code\tVariable\tpref_group";

my $imagebase;

## Don't really care if this fails

rename 'products/site.txt', 'products/existing.site.txt';

my @backups = '.';

my $newdriver;

my %restore;

for(@vars) {

my $val = $CGI::values{$_} || $::Variable->{$_};

my $pref = tag_data('variable', 'pref_group', $_);

push @vdb, join("\t", $_, $val, $pref);

if($_ eq 'SQLDSN') {

my $thing = $restore{sqldsn} = $val;

$thing =~ s/^dbi:(\w+)://i

and $newdriver = $1;

if($thing =~ /\bdatabase=(\w+)/ or $thing =~ /\bdbname=(\w+)/) {

$thing = $1;

}

$restore{dbname} = $thing;

}

elsif($_ eq 'DOCROOT') {

$restore{docroot} = $val;

$imagebase = $val if $val;

}

elsif($_ eq 'IMAGE_DIR') {

my $add = $val;

if($add =~ m{^http:}) {

undef $imagebase;

}

else {

$add =~ s{^/\~[^/]+}{};

$imagebase .= $add if $imagebase;

}

}

else {

$restore{lc $_} = $val;

}

}

#::logDebug("imagebase=$imagebase");

RESTOREBUILD: {

if($imagebase) {

push @backups, './images/*';

push @restore, <<EOF;

mkdir -p $imagebase

cp -r images/* $imagebase

rm -rf images

ln -s $imagebase images

EOF

}

last RESTOREBUILD unless $newdriver;

my @possible = glob('xfer/dumps/*.maindump');

if(@possible) {

my $m = $maptype{$newdriver}

or last RESTOREBUILD;

if(! $opt->{restore_command}) {

$opt->{restore_command} = $m->{restore}

or last RESTOREBUILD;

if($restore{sqluser}) {

my $tpl = $m->{user};

$tpl =~ s/\%s/$restore{sqluser}/g

and $opt->{restore_command} .= " $tpl";

}

if($restore{sqlpass}) {

my $tpl = $m->{pass};

$tpl =~ s/\%s/$restore{sqlpass}/g

and $opt->{restore_command} .= " $tpl";

}

$opt->{restore_command} .= ' %s';

$opt->{restore_command} .= ' < %f';

}

if($opt->{create_db} || $CGI::values{create_db}) {

$opt->{create_command} ||= $m->{create};

$opt->{create_command} =~ s/\%s/$restore{dbname}/g;

$opt->{create_command} .= ' 2> /dev/null'

unless $opt->{create_command} =~ /2\s*>/;

push @restore, $opt->{create_command};

}

else {

undef $opt->{create_command};

}

$opt->{restore_command} =~ s/\%s/$restore{dbname}/g;

$opt->{restore_command} =~ s/\%f/$possible[0]/g;

push @restore, $opt->{restore_command};

}

else {

undef $opt->{create_command};

undef $opt->{restore_command};

}

}

my $did_link;

my $did_catline;

RESTORECGI: {

last RESTORECGI if $restore{linkmode} =~ /none/i;

my $dest = $restore{cgi_dir};

my $progname = $restore{cgi_url};

$progname =~ s:.*/::;

$dest .= "/$progname";

my @args = "$restore{ic_dir}/bin/compile_link";

if($restore{linkmode} =~ /^u/i) {

push @args, '-u';

push @args, '-nosuid' if $restore{cgiwrap};

}

else {

push @args, '-i';

push @args, "-h $restore{linkhost}" if $restore{linkhost};

push @args, "-p $restore{linkport}" if $restore{linkport};

}

push @args, "-o $dest";

my $cstring = join " ", @args;

push @restore, "\n$cstring\n";

$did_link = 1;

}

my $newname = $CGI::values{rename} || $catname;

$restore{newname} = $newname;

ADDCATLINE: {

last ADDCATLINE unless $opt->{addcatline} ||= $CGI::values{addcatline};

$restore{perl} = $^X;

my $script = <<'EOScript';

#!__PERL__

use File::Copy;

use Cwd;

my $vendroot = '__IC_DIR__';

my $catalogname = '__NEWNAME__';

my $cgiurl = '__CGI_URL__';

my $aliases = '__CGI_ALIASES__';

my $targfile = "$vendroot/interchange.cfg";

unless ($vendroot and $catalogname and $cgiurl) {

die "xfer/modic_cfg.pl: Not all information necessary to add Catalog line.\n";

}

my $cur = cwd();

my $newcfgline = sprintf "%-10s %s %s %s %s\n", 'Catalog',

$catalogname, $cur, $cgiurl, $aliases;

my ($mark, @out);

my $tmpfile;

$tmpfile= "$targfile.$$";

if (-f $targfile) {

File::Copy::copy ($targfile, $tmpfile)

or die "\nCouldn't copy $targfile: $!\n";

}

else {

my @cf = ("$targfile.dist", "$vendroot/interchange.cfg.dist");

my $cf;

for(@cf) {

$cf = $_ if -f $_;

}

File::Copy::copy($cf, $tmpfile)

or die "\nCouldn't copy $cf: $!\n";

}

open(CFG, "< $tmpfile")

or die "\nCouldn't open $tmpfile: $!\n";

while(<CFG>) {

$mark = $. if /^#?catalog\s+/i;

print "\nDeleting old configuration $catalogname.\n"

if s/^(catalog\s+$catalogname\s+)/#$1/io;

push @out, $_;

}

close CFG;

if ($targfile) {

open(NEWCFG, ">$targfile")

or die "\nCouldn't write $targfile: $!\n";

} else {

open(NEWCFG, ">$targfile")

or die "\nCouldn't write $targfile: $!\n";

}

$newcfgline = sprintf "%-13s %s %s %s %s\n", 'Catalog',

$catalogname, $cur, $cgiurl, $aliases;

if (defined $mark) {

print NEWCFG @out[0..$mark-1];

print NEWCFG $newcfgline;

print NEWCFG @out[$mark..$#out];

}

else {

print "\nNo catalog previously defined. Adding $catalogname at top.\n";

print NEWCFG $newcfgline;

print NEWCFG @out;

}

close NEWCFG || die "close: $!\n";

unlink $tmpfile;

EOScript

$script =~ s/__([A-Z]\w+?)__/$restore{lc $1}/eg;

Vend::File::writefile('>xfer/addcatline.pl', $script );

push @restore, "\nperl xfer/addcatline.pl\n";

$did_catline = 1;

}

my $finmsg = <<EOThis;

Finished the restore script.

You should inspect the output above (if any) in case of errors.

EOThis

$finmsg .= <<EOThis unless $did_catline;

You will need to add the following line to interchange.cfg if

you haven't done so already:

Catalog $newname \$CURDIR $restore{cgi_url}

EOThis

$finmsg .= <<EOThis unless $did_link;

You will also need to copy an appropriate link program if it is

not already in place.

EOThis

push @restore, <<EOThis;

CURDIR=`pwd`

cat <<EOF

$finmsg

And of course you need to restart Interchange.

EOF

EOThis

Vend::File::writefile('>xfer/restore.sh', join ("\n", @restore, '') );

Vend::File::writefile('>products/site.txt', join("\n", @vdb, ""));

chmod 0755, 'xfer/restore.sh';

my $fstring = join " ", @backups;

my $cmdstring = "tar -X exclude-files -c -z -f $catname.tar.gz .";

#::logDebug("executing $cmdstring");

eval {

system $cmdstring;

};

## Don't really care if this fails

unlink 'products/site.txt';

rename 'products/existing.site.txt', 'products/site.txt';

if($?) {

my $status = $?;

my $err = $status >> 8;

my $msg = errmsg("error=%s, status=%s executing dump '%s': %s", $err, $status, $cmdstring, $!);

::logDebug($msg);

::logError($msg);

return $msg if $opt->{show_error};

return;

}

#return join("\n###\n", ::uneval(\%dsn), ::uneval(\%export), $excludestring);

return 1;

}

EOR