dist/admin/subs.cfg

UserTag  check-file  Order      file flags
UserTag  check-file  PosNumber  2
UserTag  check-file  Routine <<EOR
use strict;
sub {
	my ($files, $flags) = @_;
	$flags = 'dw' unless $flags;
	my(@files) = grep /\S/, split /\s+/, $files;
	my(@flags) = grep /[dwrfxluzse]/, split //, $flags;
	my ($result, $file);
	foreach $file (@files) {
		for(@flags) {
			eval "\$result = -$_ '$file'";
			next if $result;
			$::Values->{mv_error_file_test} = "-$_ $file not passed.";
			return undef;
		}
	}
	return 1;
}
EOR

UserTag embed HasEndTag 1
UserTag embed Routine <<EOR
sub {
	my $code = shift;
	my ($result, $error);
	eval {
		($result, $error) = eval $code;
	};
	if($@) {
		$::Values->{mv_error_embed} = "Syntax? error: $@\nfrom code:\n $code";
		return undef;
	}
	$::Values->{mv_error_embed} = $error || undef;
	return $result;
}
EOR

UserTag cat-param Order name param;
UserTag cat-param PosNumber 2
UserTag cat-param Routine <<EOR
sub {
	my ($name, $param) = @_;
	my $g;
	return undef unless $g = $Global::Catalog{$name};
	if($param) {
		return $g->{$param};
	}
	else {
		return join " ", $name, $g->{'dir'}, $g->{script}, $g->{aliases}; 
	}
}
EOR

UserTag listcats Routine <<EOR
sub {
	return join "\n", grep $_ ne '_mv_admin', sort keys %Global::Catalog;
}
EOR

UserTag additional AddAttr
UserTag additional Order template
UserTag additional PosNumber 1
UserTag additional Routine <<EOR
sub {
	my ($dir, $opt) = @_;
	$opt = {} if ! $opt;
	ADDITIONAL: {
		last ADDITIONAL if $opt->{'name'} and
			defined $::Scratch->{MVC_HELP};
		unless ($dir =~ m{(?:[A-Z]:)?[/\\]} ) {
			$dir = "$Global::VendRoot/$dir";
		}
		return '' unless -f "$dir/config/additional_fields";
		open(ADDL, "$dir/config/additional_fields")
			or return '';
		my @var;
		my %help;
		my %prompt;
		my %default;
		local ($/) = "";
		if(open(ADDLHELP, "$dir/config/additional_help") ) {
			while(<ADDLHELP>) {
				my($parm,$help) = split /\n/, $_, 2;
				$help =~ s/\s*$/\n\n/;
				$help{uc $parm} = $help;
			}
			close ADDLHELP;
		}
		while(<ADDL>) {
			s/\s+$//;
			s/__MVC_([A-Z0-9]+)__/$::Values->{$1}/eg;
			my ($var, $prompt, $default) = split /\n/, $_, 3;
			$var =~ s/\s+//g;
			$var = uc $var;
			push @var, $var;
			$prompt{$var} = $prompt;
			$default{$var} = $default;
			if (defined $help{$var}) {
				$help{$var} =~ s/__MVC_([A-Z0-9]+)__/$::Values->{$1}/eg;
			}
		}
		close ADDL;
		$::Scratch->{MVC_HELP}    = \%help;
		$::Scratch->{MVC_VAR}     = \@var;
		$::Scratch->{MVC_PROMPT}  = \%prompt;
		$::Scratch->{MVC_DEFAULT} = \%default;
	}
	if($opt->{'name'}) {
		my $name = uc $opt->{'name'};
		return $::Scratch->{MVC_HELP}{$name}
			if $opt->{'help'};
		return $::Scratch->{MVC_PROMPT}{$name}
			if $opt->{'prompt'};
		return $::Scratch->{MVC_DEFAULT}{$name} || ' '
			if $opt->{'default'};
	}
	else {
		return "" if ! $::Scratch->{MVC_VAR};
		return join " ", @{$::Scratch->{MVC_VAR}};
	}
}
EOR

UserTag makecat Order seed
UserTag makecat Routine <<EOR
sub {
	my $test = shift;
	my @session = ( qw/

    address
    aliases
    basedir
    catalogname
    catroot
    catuser
    cgibase
    cgidir
    cgiurl
    city
    company
    documentroot
    encryptor
    fax
	homedir
    imagedir
    imageurl
    linkmode
    linkprogram
    logo
    mailorderto
    minivendgroup
    minivenduser
	nocfg
	norunning
    phone
    samplehtml
    sampleurl
    serverconf
    servername
    shipmodes
    smlogo
    template
    tollfree
    vendroot

	/);

	my %server = ( qw/
    aliases			1
    basedir			1
    catalogname		1
    catroot	  		1
    catuser   		1
    cgibase   		1
    cgidir			1
    cgiurl			1
    demotype		1
    template		1
    documentroot	1
    imagedir		1
	homedir			1
    imageurl		1
    linkmode		1
    linkprogram		1
    mailorderto		1
    minivendgroup	1
    minivenduser	1
    nocfg			1
    nocopy			1
    norunning		1
    reference		1
    samplehtml		1
    sampleurl		1
    serverconf		1
    servername		1
    vendroot		1

	/);

	if(defined $::Scratch->{MVC_VAR}) {
		push @session, map { lc $_ } @{$::Scratch->{MVC_VAR}};
	}

	my %seen;
	@session = grep ! $seen{$_}++, @session;
	my %implicit = qw/nocfg 1 norunning 1/;

	my @parms;

	if($test) {
		@parms = grep /\S/, split /\s+/, $test;
		for(@parms) {
			$_ = lc $_;
		}
	}
	else {
		@parms = @session;
	}

    my $die = sub {
        $::Values->{mv_error_makecat_message} .= join "\n", @_;
        return undef;
    };
	$::Values->{mv_error_makecat_message} = '';

	my $script = "$Global::VendRoot/bin/makecat";

	return &$die("No makecat program available.") unless -x $script
		or $^O =~ /win32/i;
	
	my @cmdline;
	my $val;
	my $parm;
	foreach $parm (@parms) {
		next unless defined ($val = $::Values->{"\U$parm"});
		my $prefix = defined $server{$parm} ? '--' : '';
		unless ($val =~ m!^[-\w/:.]+$! ) {
			$val =~ s/"/\\"/g;
			$val = qq{"$val"};
		}
		if( defined $implicit{$parm} ) {
			next unless $val;
		}
		else {
			next if ! $val and ! $prefix;
			$val = '=' . $val;
		}
		push @cmdline, qq{$prefix$parm$val};
	}

	push @cmdline, ($test ? "--reference" : "-F");

	unshift @cmdline, $script;

	if($^O =~ /win32/i) {
		unshift @cmdline, $Config::Config{perlpath};
	}

	my $string = join " ", @cmdline;

	open(ERRLOG, ">makecat.errors")		or die "create makecat.errors: $!\n";
	open(STDERR, ">&ERRLOG")			or die "dup STDERR: $!\n";

	my $save_umask = umask(0);

	if($test) {
		local($/) = undef;
		my $save_umask = umask(0);
		open(CMD, "$string |")
			or return &$die("cannot fork: $!");
		my $safe = new Safe;
		my $ref = $safe->reval(<CMD>);
		close CMD;
		if($@ or ! ref $ref) {
			umask $save_umask;
			my $msg = Vend::Util::readfile('makecat.errors');
			return &$die(<<EOErrors);
Catalog test run failed. [page seefile#bottom makecat.log]See log.[/page]
<PRE>
Immediate errors:
----------------
$msg
</PRE>
EOErrors
		}
		else {
			$Vend::Session->{makecat_ref} = $ref;
		}
		my ($k, $v);
		for (@session) {
			$k = $_;
			$k = 'demotype' if $k eq 'template';
			next unless defined $ref->{$k};
			$v = $ref->{$k};
			$::Values->{"\U$_"} = $v;
		}
	}
	else {
		system($string);
		umask $save_umask;
		#system(@cmdline);
		if($?) {
			my $msg = Vend::Util::readfile('makecat.errors');
			return &$die(<<EOErrors);
Catalog build failed. [page seefile#bottom makecat.log]See log.[/page]
<PRE>
Immediate errors:
----------------
$msg
</PRE>
EOErrors
		}
		if(! $Global::Windows) {
			sleep $Global::HouseKeeping
				if $Global::HouseKeeping < 11;
		}
	}

	#if(defined $extra_file) {
	#	open(ERR, $extra_file) or die "open extra_file: $!";
	#	$extra = <ERR>;
	#	close ERR;
	#	unlink $extra_file;
	#}

	return 1;
}
EOR

UserTag  global-value  Order  name
UserTag  global-value  Routine <<EOR
sub {
	no strict 'refs';
	defined ${$_[0]} and return ${$_[0]};
	return '';
}
EOR

UserTag wizard order current next back cancel fail default routine
UserTag wizard HasEndTag 1
UserTag wizard Routine <<EOR
sub {
	1;
}
EOR