# mmtags.cfg - MiniMate User Tags

# Copyright (C) 1998 Michael J. Heins <mikeh@minivend.com>
# Copyright (C) 1999 Stefan Hornburg <racke@linuxia.de>

# Author: Michael J. Heins <mikeh@minivend.com>
# Maintainer: Stefan Hornburg <racke@linuxia.de>

# This file 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, or (at your option) any
# later version.

# This file is distributed in the hope that it will be
# useful, but WITHOUT ANY WARRANTY; without even the implied warranty
# of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
# General Public License for more details.

# You should have received a copy of the GNU General Public License
# along with this file; see the file COPYING.  If not, write to the Free
# Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.

UserTag reconfigure Routine <<EOR
use MiniMate::CfgMgr;
*mm_check_acl = \&MiniMate::CfgMgr::mm_check_acl;
*mm_acl_enabled = \&MiniMate::CfgMgr::mm_acl_enabled;
*get_mm_table_acl = \&MiniMate::CfgMgr::get_mm_table_acl;
sub {
	MiniMate::CfgMgr::rotate();
	Vend::Util::logData("$Global::ConfDir/reconfig", $CGI::script_name)
			and return "SUCCESS";
	return "FAILED";
}
EOR


UserTag unconfigure Routine <<EOR
sub {
	use MiniMate::CfgMgr;
	MiniMate::CfgMgr::rotate(undef, 'unsave')
		and Vend::Util::logData("$Global::ConfDir/reconfig", $CGI::script_name)
			and return "SUCCESS";
	return "FAILED";
}
EOR

UserTag rotate_file Routine <<EOR
sub {
	my($file, $rollback) = @_;
	MiniMate::CfgMgr::rotate(undef, 'unsave')
		and return "SUCCESS";
	return "ERROR";
}
EOR

UserTag read_serial Order file
UserTag read_serial Routine <<EOR
sub {
	my ($file) = @_;
	return '' unless -f $file;
	my $out;
	open(F, $file) or return '';
	$out = <F>;
	$out = <F>;
	$out .= <F>;
	close F;
	return $out;
}
EOR

UserTag list_glob Order spec prefix
UserTag list_glob PosNumber 2 
UserTag list_glob Routine <<EOR
sub {
	my @files = MiniMate::CfgMgr::list_glob(@_);
	return join "\n", @files;
}
EOR


UserTag list_pages order options ext keep base
UserTag list_pages PosNumber 4 
UserTag list_pages Routine <<EOR
sub {
	my ($return_options, $ext, $keep, $base) = @_;
	my $out;
	if($return_options) {
		$out = "<OPTION> " . (join "<OPTION> ", MiniMate::CfgMgr::list_pages($keep,$ext,$base));
	} else {
		$out = join " ", MiniMate::CfgMgr::list_pages($keep,$ext, $base);
	}
}
EOR

UserTag display_directive order name value option
UserTag display_directive Routine <<EOR
sub {
	MiniMate::CfgMgr::directive_box(@_);
}
EOR

UserTag directive_value order name unparse
UserTag directive_value PosNumber 2
UserTag directive_value Routine <<EOR
sub {
	my($name,$unparse) = @_;
	my ($value, $parsed) = MiniMate::CfgMgr::read_directive($name);
	if($unparse) {
		$parsed =~ s/\@\@([A-Z]\w+?)\@\@/$Global::Variable->{$1}/g;
		$parsed =~ s/__([A-Z]\w+?)__/$Vend::Cfg->{Variable}{$1}/g;
	}
	return ($parsed || $value);
}
EOR


UserTag list_directives Routine <<EOR
sub {
	return join " ", MiniMate::CfgMgr::list_directives();
}
EOR

UserTag write_config Interpolate 1
UserTag write_config hasEndTag 1
UserTag write_config Order name complex
UserTag write_config PosNumber 2
UserTag write_config Routine <<EOR
sub {
	my ($name, $complex, $value) = @_;
	#Vend::Util::logError(join "','", "write-config args: '", @_, "'");
	return undef unless $name;
	MiniMate::CfgMgr::set_directive($name, $value, $complex || undef);
}
EOR

UserTag ifdef hasEndTag   1
UserTag ifdef Interpolate 1
UserTag ifdef routine <<EOR
sub {
	return $_[1] if $_[0];
}
EOR

UserTag ifndef hasEndTag   1
UserTag ifndef Interpolate 1
UserTag ifndef routine <<EOR
sub {
	return $_[1] unless $_[0];
}
EOR

UserTag list-keys Order table
UserTag list-keys addAttr
UserTag list-keys Routine <<EOR
sub {
	my $table = shift;
#::logDebug("list-keys $table");
	$table = $::Values->{mvc_data_table} || $::Values->{mv_data_table}
		unless $table;
#::logDebug("list-keys $table");
	my @keys;
	my $record;
	if(! ($record = $Vend::Minimate_entry) ) {
		$record =  mm_acl_enabled();
	}

	my $acl;
	my $keys;
	if($record) {
#::logDebug("list_keys: record=$record");
		$acl = get_mm_table_acl($table);
#::logDebug("list_keys table=$table: acl=$acl");
		if($acl and $acl->{yes_keys}) {
#::logDebug("list_keys table=$table: yes.keys enabled");
			@keys = grep /\S/, split /\s+/, $acl->{yes_keys};
		}
	}
	unless (@keys) {
		my $db = Vend::Data::database_exists_ref($table);
		return '' unless $db;
		$db = $db->ref() unless $Vend::Interpolate::Db{$table};
		my $keyname = $db->config('KEY');
		if($db->config('LARGE')) {
			return ::errmsg('--not listed, too large--');
		}
		my $query = "select $keyname from $table order by $keyname";
#::logDebug("list_keys: query=$query");
		$keys = $db->query(
						{
							query => $query,
							ml => $::Variable->{MINIMATE_KEY_LIMIT} || 500,
							st => 'db',
						}
					);
		if(defined $keys) {
			@keys = map {$_->[0]} @$keys;
		}
		else {
			my $k;
			while (($k) = $db->each_record()) {
				push(@keys, $k);
			}
			if( $db->numeric($db->config('KEY')) ) {
				@keys = sort { $a <=> $b } @keys;
			}
			else {
				@keys = sort @keys;
			}
		}
#::logDebug("list_keys: query=returned " . ::uneval(\@keys));
	}
	if($acl) {
#::logDebug("list_keys acl: ". ::uneval($acl));
		@keys = MiniMate::CfgMgr::mm_acl_grep( $acl, 'keys', @keys);
	}
	return join("\n", @keys);
}
EOR


UserTag list-databases Order nohide
UserTag list-databases routine <<EOR
sub {
	my $nohide = shift;
	my @dbs;
	my $v = $Vend::Session->{'values'};
	my $d = $Vend::Cfg->{Database};
	@dbs = sort keys %$d;
	my @outdb;
	my $record =  mm_acl_enabled();
	undef $record
		unless ref($record)
			   and $record->{yes_tables} || $record->{no_tables};

	for(@dbs) {
		next if $v->{mvc_tables_to_hide} =~ /\b$_\b/;
		if($record) {
			next if $record->{no_tables}
				and mm_check_acl($_, $record->{no_tables});
			next if $record->{yes_tables}
				and ! mm_check_acl($_, $record->{yes_tables});
		}
		push @outdb, $_;
	}

	@dbs = $nohide ? (@dbs) : (@outdb);
	
	my $string = join " ", grep /\S/, @dbs;
	if(defined $v->{mv_data_table}) {
		return $string unless $d->{$v->{mv_data_table}};
		my $size = -s $Vend::Cfg->{ProductDir} .
						"/" .  $d->{$v->{mv_data_table}}{'file'};
		$size = 3_000_000 if $size < 1;
		$v->{mvc_too_large} = $size > 100_000 ? 1 : '';
		$v->{mvc_way_too_large} = $size > 2_000_000 ? 1 : '';
		local($_) = $v->{mv_data_table};
		$v->{mvc_rotate_spread} = $v->{mvc_tables_to_rotate} =~ /\b$_\b/;
	}
	return $string;
}
EOR

UserTag if-key-exists  Routine <<EOR
sub {
		my($table,$key,$text) = @_;
		$text =~ s:\[else\](.*)\[/else\]::si;
		my $else = $1 || '';
		my $db = $Vend::Database{$table} || do { logError "Bad database $table"; return $else; };
		$db = $db->ref() unless $Vend::Interpolate::Db{$table};
		my $status;
		eval {
			$status = $db->record_exists($key);
		};
		return $else if $@;
		return $else unless $status;
		return $text;
}
EOR
UserTag if-key-exists Order table key
UserTag if-key-exists hasEndTag

UserTag db_columns  Order name columns joiner
UserTag db_columns  AttrAlias table name
UserTag db_columns  AttrAlias fields columns
UserTag db_columns  Routine <<EOR
sub {
	my ($table,$columns, $joiner) = @_;
	$table = $Values->{mv_data_table}
		unless $table;
	my $db = Vend::Data::database_exists_ref($table)
		or return undef;
	my $acl = MiniMate::CfgMgr::get_mm_table_acl($table);
	$db = $db->ref() unless $Vend::Interpolate::Db{$table};
	my $key = $db->config('KEY');

	$joiner = "\n" unless defined $joiner;

	my @cols;
	if(! $columns || $columns =~ /^[\s,\0]*$/) {
		@cols = $db->columns();
	}
	else {
		@cols = grep /\S/, split /[\s,\0]+/, $columns;

		my %col;
		@col{@cols} = @cols;
		$col{$key} = $key if ! defined $col{$key};

		@cols = grep defined $col{$_}, $db->columns();
	}

	if($acl) {
		@cols = MiniMate::CfgMgr::mm_acl_grep( $acl, 'fields', @cols);
	}

	return join $joiner, @cols;
}
EOR

UserTag newer Order source target
UserTag newer Routine <<EOR
sub {
	my ($source, $file2) = @_;
	my $file1 = $source;
	if(! $file2 and $source !~ /\./) {
		if($Global::GDBM) {
			$file1 .= '.gdbm';
		}
		elsif($Global::DB_File) {
			$file1 .= '.db';
		}
		else {
			return undef;
		}
		$file2 = $Vend::Cfg->{Database}{$source}{'file'}
			or return undef;
		$file1 = $Vend::Cfg->{ProductDir} . '/' . $file1
			unless $file1 =~ m:/:;
		$file2 = $Vend::Cfg->{ProductDir} . '/' . $file2
			unless $file2 =~ m:/:;
	}
	my $time1 = (stat($file1))[9]
		or return undef;
	my $time2 = (stat($file2))[9];
	return 1 if $time1 > $time2;
	return 0;
}
EOR

UserTag with routine sub { $Vend::Session->{scratch}->{$_[0]} = $_[1]; return '' }
UserTag with Order param value

UserTag row-edit HasEndTag
UserTag row-edit Order key table size columns
UserTag row-edit Interpolate 1
UserTag row-edit Routine <<EOR
sub {
	my ($key,$table,$size, @columns) = @_;
	$table = $table || $::Scratch->{mvc_data_table} || return "BLANK DB";
	my $db = Vend::Data::database_exists_ref($table);
	return "NON-EXISTENT DATABASE '$table' for row-edit" unless defined $db;
	$db = $db->ref() unless $Vend::Interpolate::Db{$table};
	my $acl = MiniMate::CfgMgr::get_mm_table_acl();

	my $bad;
	if ($key) {
		eval {
			$bad = ! $db->record_exists($key);
			$bad = 'DELETED' if $bad;
		};
		$bad = 'ERROR' if $@;
		if(! $bad and $acl) {
			$bad = 'Not available'
				if ! MiniMate::CfgMgr::mm_acl_atom($acl, 'keys', $key);
		}
	}

	@columns = grep /\S/, @columns;

	my @cols;
	if(@columns) {
		for(@columns) {
			push(@cols, split /[\s,\0]+/, $_);
		}
		my %col;
		for(@cols) {
			$col{$_} = 1;
		}

		@cols = grep defined $col{$_}, $db->columns();
	}
	else {
		@cols = $db->columns();
	}

	if($acl) {
		@cols = MiniMate::CfgMgr::mm_acl_grep( $acl, 'fields', @cols);
	}

	my $out = '';

	my $meta = ($::Values->{mvc_meta_display} =~ /\b$table\b/);
	my $tmp;

	$size = $size || 12;
	if($bad) {
		for(@cols) {
			$out .= "<TD>$bad</TD>";
		}
	}
	elsif($key) {
		my $text;
		for(@cols) {
			eval {
				$text = $db->field($key,$_);
			};
			$text = 'DELETED' if $@;
			if($meta and
				$tmp = MiniMate::CfgMgr::meta_display($table,$_,$key,$text) 
				)
			{
#::logDebug("meta call: table=$table col=$_ key=$key text=$text");
				$out .= "<TD>$tmp</TD>";
				next;
			}
			my $DECODE_CHARS = qq{[<"\000-\037\177-\377};
			HTML::Entities::encode($text, '&');
			HTML::Entities::encode($text, $DECODE_CHARS);
			$out .= <<EOF;
<TD><INPUT NAME="$_" SIZE=$size VALUE="$text"></TD>
EOF
		}
	}
	else {
		for(@cols) {
			$out .= qq{<TH ALIGN=LEFT>$_</TH>};
		}
	}
	return $out;

}
EOR

UserTag export-database Order table file type
UserTag export-database addAttr
UserTag export-database Routine <<EOR
sub {
		my($table, $file, $type, $opt) = @_;
		delete $Vend::Session->{'values'}{mvc_export_database}
			or return undef;
		if($opt->{delete} and ! $opt->{verify}) {
			::logError("attempt to delete field without verify, abort");
			return undef;
		}

		if(!$file and $type) {
			::logError("exporting as default type, no file specified");
			undef $type;
		}

		$Vend::WriteDatabase{$table} = 1;

		if(! $opt->{field}) {
			::logError("exporting:\ntable=$table\nfile=$file\ntype=$type\nsort=$opt->{sort}");
		}
		elsif($opt->{field} and $opt->{delete}) {
			::logError("delete field:\ntable=$table\nfield=$opt->{field}\nsort=$opt->{sort}\n");
		}
		elsif($opt->{field}) {
			::logError("add field:\ntable=$table\nfield=$opt->{field}\nsort=$opt->{sort}\n");
		}
		return Vend::Data::export_database(
									$table,
									$file,
									$type,
									$opt,
							);
}
EOR

UserTag display Order table column key
UserTag display Interpolate 1
UserTag display Routine <<EOR
sub {
	my ($table,$column,$key) = @_;
	$table = $::Values->{mv_data_table} unless $table;
	my $db = Vend::Data::database_exists_ref($table);
	return "NON-EXISTENT DATABASE '$table' for display" unless defined $db;
	$db = $db->ref() unless $Vend::Interpolate::Db{$table};
	my $text;
	my $size;
#::logDebug("meta call: table=$table col=$column key=$key text=$text");
	eval {
		$text = $db->field($key,$column);
	};
	$text = $CGI::values{$column} if $@;
#::logDebug("data call failed: $@") if $@;

	if($::Values->{mvc_meta_display} =~ /\b$table\b/) {
#::logDebug("meta call: table=$table col=$column key='$key' text=$text");
		my $out = MiniMate::CfgMgr::meta_display($table,$column,$key,$text);
#::logDebug("past meta_display, out=$out");
		return $out if $out;
	}

	my $DECODE_CHARS = qq{[<"\000-\037\177-\377};

	# Count lines for textarea
	my $count;
	$count = $text =~ s/(\r\n|\r|\n)/$1/g;

	HTML::Entities::encode($text, '&');
	HTML::Entities::encode($text, $DECODE_CHARS);
	if ($count) {
		$count++;
		$count = 20 if $count > 20;
		return <<EOF;
<TEXTAREA NAME="$column" COLS=60 ROWS=$count>$text</TEXTAREA>
EOF
	}
	elsif ($text =~ /^\d+$/) {
		$size = 8;
	}
	else {
		$size = 60;
	}
		return <<EOF;
<INPUT NAME="$column" SIZE=$size VALUE="$text">
EOF
}
EOR

UserTag if-sql  Routine  <<EOR
sub {
		my($table,$text) = @_;
		$text =~ s:\[else\](.*)\[/else\]::si;
		my $else = $1 || '';
		my $db = $Vend::Cfg->{Database}{$table} || return $else;
		return $else unless $db->{'type'} eq '8';
		return $text;
}
EOR
UserTag if-sql Order table
UserTag if-sql hasEndTag

UserTag substitute CanNest 1
UserTag substitute HasEndTag 1
UserTag substitute Order   name value
UserTag substitute Routine <<EOR
sub {
	my ($name,$value,$text) = @_;
	$text =~ s/\~\~$name\~\~/$value/g;
	return $text;
}
EOR

UserTag quick_table HasEndTag
UserTag quick_table Interpolate
UserTag quick_table Order   border
UserTag quick_table Routine <<EOR
sub {
	my ($border,$input) = @_;
	$border = " BORDER=$border" if $border;
	my $out = "<TABLE ALIGN=LEFT$border>";
	my @rows = split /\n+/, $input;
	my ($left, $right);
	for(@rows) {
		$out .= '<TR><TD ALIGN=RIGHT VALIGN=TOP>';
		($left, $right) = split /\s*:\s*/, $_, 2;
		$out .= '<B>' unless $left =~ /</;
		$out .= $left;
		$out .= '</B>' unless $left =~ /</;
		$out .= '</TD><TD VALIGN=TOP>';
		$out .= $right;
		$out .= '</TD></TR>';
		$out .= "\n";
	}
	$out .= '</TABLE>';
}
EOR

UserTag unlink_file Order name prefix
UserTag unlink_file PosNumber 2
UserTag unlink_file Routine <<EOR
sub {
	my ($file, $prefix) = @_;
#::logDebug("got to unlink: file=$file prefix=$prefix");
	$prefix = 'tmp/' unless $prefix;
	return if Vend::Util::file_name_is_absolute($file);
	return if $file =~ /\.\./;
	return unless $file =~ /^$prefix/;
#::logDebug("got to unlink: $file qualifies");
	unlink $file;
}
EOR


UserTag check-upload Order file same
UserTag check-upload PosNumber 2
UserTag check-upload Routine <<EOR
sub {
	use File::Copy;
	my $file = shift;
	my $same = shift;
	my $dir = $Vend::Cfg->{ProductDir};
	$same = $same ? '' : '+';
	if (-s "upload/$file") {
		File::Copy::copy "upload/$file", "$dir/$file$same"
			or return "Couldn't copy uploaded file!";
		unlink "upload/$file";
	}
	return '';
}
EOR

UserTag rotate-database Routine <<EOR
sub {
	my $table = delete $::Values->{mvc_rotate_database};
	return '' unless $table;
	my $direction = delete $::Values->{mvc_rotate_direction};
	my $opts = {
				Motion => $direction || 'save',
				Directory => $Vend::Cfg->{ProductDir},
				Touch => 1,
				};
	MiniMate::CfgMgr::rotate( $table, $opts )
		and return "Database rotated successfully.";
	return "DATABASE ROTATE of $table in '$direction' FAILED.";
}
EOR

UserTag rotate-table Order rotate
UserTag rotate-table PosNumber 1
UserTag rotate-table Interpolate 1
UserTag rotate-table HasEndTag 1
UserTag rotate-table Routine <<EOR
sub {
	my ($rotate, $text) = @_;
	return $text unless $rotate;
	my $rotated = '';
	$text =~ s/(.*<TABLE.*?>)//si;
	my $out = $1 || '';
	$text =~ s:(.*?)</table\s*>:</TABLE>:si;
	my $table = $1;

	my @cols;

	while ($table =~ m:<TR.*?>(.*?)</TR>:sig) {
		push @cols, $1;
	}
	
	my $i = 0;
	my @rows;
	my @meta;
	my $rows = 0;
	my @r; my @c; my @m;
	my ($r,$c);

	for (@cols) {
		while(m:<T([HD])(.*?)>(.*?)</T\1>:sig) {
			my $meta = $1 . $2;
			push @r, $3;
			if($meta =~ /SPAN/i) {
				$meta =~ s/\bcolspan\s*=/ROWMETASPAN=/ig;
				$meta =~ s/\browspan\s*=/COLMETASPAN=/ig;
				$meta =~ s/(ROW|COL)META/$1/g;
			}
			push @m, $meta;
		}
		$meta[$i] = [@m];
		$rows[$i] = [@r];
		$i++;
		$rows = $rows < $#r ? $#r : $rows;
		undef @m;
		undef @r;
	}
	foreach $r (0 .. $rows) {
		$rotated .= "<TR>\n";
		foreach $c (0 .. $#cols) {
			$rotated .= "<T" . $meta[$c]->[$r] . ">";
			$rotated .= "$rows[$c]->[$r]";
			$rotated .= "</TD>\n"
		}
		$rotated .= "</TR>\n";
	}
	return $out . $rotated . $text;
}
EOR

UserTag field_label Order table column meta
UserTag field_label PosNumber 3
UserTag field_label attrAlias db table
UserTag field_label attrAlias field column
UserTag field_label Routine <<EOR
sub {
	my ($table, $column, $meta) = @_;
	$meta = $::Variable->{MINIMATE_META} || 'mv_metadata' if ! $meta;
	return "<B>$column</B>" if ! ::tag_data($meta, 'type', "${table}::$column");
	my $label = Vend::Interpolate::tag_data($meta, 'label', "${table}::$column")
			  || $column;
	my $out;
	my $help = Vend::Interpolate::tag_data($meta, 'help', "${table}::$column");
	my $url = Vend::Interpolate::tag_data($meta, 'help_url', "${table}::$column");
	$out = "<B>$label</B>";
	$out .= qq{<BR><FONT SIZE="-1"><I>$help</I></FONT>} if $help;
	if ($url) {
		$out .= qq{<BR><FONT SIZE="-1"><I><A HREF="$url">};
		$out .= ::errmsg('more help');
		$out .= q{</I></FONT>};
	}
	return $out;
}
EOR

#UserTag field_label Order table column meta
#UserTag field_label PosNumber 3
#UserTag field_label attrAlias db table
#UserTag field_label attrAlias field column
#UserTag field_label Routine <<EOR
#sub {
#	my ($table, $column, $meta) = @_;
#	$meta = $::Variable->{MINIMATE_META} || 'mv_metadata' if ! $meta;
#	my $label = Vend::Interpolate::tag_data($meta, 'label', "${table}::$column")
#			  || $column;
#	my $help;
#	my $out;
#	if ( Vend::Interpolate::tag_data($meta, 'help', "${table}::$column") ) {
#			$help = qq{<A HREF="};
#			$help .= $Vend::Cfg->{VendURL};
#			$help .= qq{/config/help?};
#			$help .= qq{mv_help_table=$table&mv_help_column=$column};
#			$help .= '"> ? </A>';
#	}
#	$out = "<B>$label</B>";
#	$out .= qq{<BR><FONT SIZE="-1"><I>$help</I></FONT>} if $help;
#	return $out;
#}
#EOR

UserTag widget Order name
UserTag widget PosNumber 1
UserTag widget attrAlias table db
UserTag widget attrAlias field column
UserTag widget attrAlias outboard key
UserTag widget addAttr
UserTag widget HasEndTag 1
UserTag widget Interpolate 1
UserTag widget Routine <<EOR
sub {
	my($name, $opt, $string) = @_;
	#my($name, $type, $value, $table, $column, $key, $data, $string) = @_;
	my $value = $::Values->{$name} || $opt->{default};
	my $ref = {
				attribute	=> $opt->{attribute} || 'attribute',
				db			=> $opt->{table} || undef,
				field		=> $opt->{field} || undef,
				name		=> $name,
				outboard	=> $opt->{key} || undef,
				passed		=> $opt->{data} || $opt->{passed} || $string,
				type		=> $opt->{type} || 'select',
				};
	my $item = { $ref->{attribute} => $value };

	Vend::Interpolate::tag_accessories('', '', $ref, $item);
}
EOR

UserTag counter Order file
UserTag counter Routine <<EOF
sub {
    my $file = shift || 'etc/counter';
    $file = $Vend::Cfg->{VendRoot} . "/$file"
        unless index($file, '/') == 0;
    my $ctr = new File::CounterFile $file;
    return $ctr->inc();
}
EOF

UserTag title-bar Order  width size color
UserTag title-bar PosNumber 3
UserTag title-bar Interpolate 1
UserTag title-bar HasEndTag 1
UserTag title-bar Routine <<EOR
sub {
	my ($width, $size, $color, $text) = @_;
	$width = 500 unless defined $width;
	$size = 6 unless defined $size;
	$color = ($::Variable->{HEADERBG} || '#444444') unless defined $color;
	$color = qq{BGCOLOR="$color"} unless $color =~ /^\s*bgcolor=/i;
	my $tcolor = $::Variable->{HEADERTEXT} || 'WHITE';
	$text = qq{<FONT COLOR="$tcolor" SIZE="$size">$text</FONT>};
	return <<EOF;
<TABLE CELLSPACING=0 CELLPADDING=6 WIDTH="$width"><TR><TD VALIGN=CENTER $color>$text</TD></TR></TABLE>
EOF
}
EOR

UserTag send-help Order name refine
UserTag send-help Routine <<EOR
sub {
	my ($name, $refine) = @_;
	my $page = readin("admin/help/$name");
	return $page if $page;
	$name =~ s/(\W)/sprintf("%%%02x", ord $1)/eg;
	if($refine) {
		$refine =~ s/(\W)/sprintf("%%%02x", ord $1)/eg;
		$name .= "/se=$refine";
	}
	return <<EOF;
<A HREF="http://www.minivend.com/cgi-bin/mv/scan/st=glimpse/se=$name">
	Search for help on $name
</A>
EOF
}
EOR

UserTag e HasEndTag
UserTag e Routine <<EOR
sub {
	my $text = shift;
	HTML::Entities::encode($text);
}
EOR


UserTag set-click Order name page action extra
UserTag set-click PosNumber 4
UserTag set-click Routine <<EOR
sub {
    my ($name, $page, $action, $extra) = @_;
    $page = $name unless $page;
    $action = 'return' unless $action;
    $extra = '' unless $extra;
    $Vend::Session->{scratch}{$name} = <<EOS; 
mv_todo=$action
mv_nextpage=$page
$extra
EOS
    return qq{<INPUT TYPE="hidden" NAME="mv_click_map" VALUE="$name">};
}
EOR


UserTag import_fields Order table
UserTag import_fields addAttr
UserTag import_fields Routine <<EOR
sub {
	my($table, $opt) = @_;
	use strict;
	local($SIG{__DIE__});
	$SIG{"__DIE__"} = sub {
                            my $msg = shift;
                            ::response(<<EOF);
<HTML><HEAD><TITLE>Fatal Administration Error</TITLE></HEAD><BODY>
<H1>FATAL error</H1>
<PRE>$msg</PRE>
</BODY></HTML>
EOF
                            exit 0;
                        };
	my $file = $opt->{'file'} || $Vend::Cfg->{ProductDir} . "/$table.update";
	my $db = Vend::Data::database_exists_ref($table);
	die "Non-existent table '$table'\n" unless $db;
	$db = $db->ref() unless $Vend::Interpolate::Db{$table};
	my $out = '<PRE>';
	my $delimiter = quotemeta $opt->{delimiter} || "\t";
	open(UPDATE, $file)
		or die "read $file: $!\n";
	my $fields;
	if($opt->{'fields'}) {
		$fields = $opt->{'fields'};
		$out .= "Using fields from parameter: '$fields'\n";
	}
	else {
		$fields = <UPDATE>;
		chomp $fields;
		$fields =~ s/$delimiter/ /g;
		$out .= "Using fields from file: '$fields'\n";
	}
	die "No field names." if ! $fields;
	my @names;
	my $k;
	my @f;
	@names = split /\s+/, $fields;
	shift @names;
	my @set;
	my $i = 0;
	my $idx = 0;
	for(@names) {
		$db->column_index($_);
		$set[$idx++] = $db->field_settor($_);
	}
	my $count = 0;
	while(<UPDATE>) {
		chomp;
		($k, @f) = split /$delimiter/o, $_;
		if(! $k and ! length($k)) {
			next if ! $opt->{delete};
			next if $f[1] ne 'DELETE';
			$db->delete_record($f[2]);
		}
		$out .= "Record '$k' had too many fields, ignored.\n"
			if @f > $idx;
		if ( ! $db->record_exists($k)) {
			if ($opt->{add}) {
				$out .= "Adding record '$k'.\n";
				$db->set_row($k);
			}
			else {
				$out .= "Non-existent record '$k', skipping.\n";
				next;
			}
		}
		for ($i = 0; $i < $idx; $i++) {
			$set[$i]->($k, $f[$i]);
		}
		$count++;
	}
	$out .= "$count records updated.</PRE>";
	close UPDATE;
	if($opt->{'move'}) {
		my $ext = POSIX::strftime("%Y%m%d%H%M%S", localtime());
		rename $file, "$file.$ext"
			or die "rename $file --> $file.$ext: $!\n";
	}
	return $out;
}
EOR

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

# Return some info about a database
# Goes in minivend.cfg, not catalog.cfg
#
# THIS REQUIRES 3.12beta4 or higher!
#
# Examples:
#
# <PRE>
# columns:    [dbinfo table=products columns=1 joiner="|"]
# file:       [dbinfo table=products attribute=file]
# dir:        [dbinfo table=products attribute=dir]
# storage:    [dbinfo table=products storage=1]
# INDEX:      [dbinfo table=products attrib=INDEX]
# CONTINUE:   [dbinfo table=products attrib=CONTINUE]
# path to db: [dbinfo db=products attr=dir]/[dbinfo db=products attr=file]
# exists category: [dbinfo db=products column_exists=category]
# exists nevairbe: [dbinfo db=products column_exists=nevairbe No="Nope."]
# exists 00-0011: [dbinfo
#                    db=products
#                    record_exists="00-0011"
#                    YES="Yup."
#                    No="Nope."]
# exists 00-0000: [dbinfo
#                    db=products
#                    record_exists="00-0000"
#                    YES="Yup."
#                    No="Nope."]
#
# </PRE>
#
UserTag dbinfo Order table
UserTag dbinfo addAttr
UserTag dbinfo attrAlias base table
UserTag dbinfo attrAlias db table
UserTag dbinfo Routine <<EOR
sub {
	my ($table, $opt) = @_;

	sub _die {
		$Vend::Session->{failure} .= shift;
		return;
	}

	my $db_obj = $Vend::Cfg->{Database}{$table}
				|| return _die("Table '$table' does not exist\n");

	# attributes are: (case matters)
	#
	#	CONTINUE
	#	dir
	#	EXCEL
	#	file
	#	INDEX
	#	MEMORY
	#	type

	if($opt->{attribute} or $opt->{attribute} = $opt->{attrib} || $opt->{attr}) {
		return $db_obj->{$opt->{attribute}};
	}

	# COLUMN_DEF, NUMERIC, NAME
	if($opt->{attribute_ref}) {
		return Vend::Util::uneval($db_obj->{$opt->{attribute_ref}});
	}

	my $db = Vend::Data::database_exists_ref($table)
				|| return _die("Table '$table' does not exist\n");
	$db = $db->ref() unless $Vend::Interpolate::Db{$table};

    if($opt->{storage}) {
        my $string = $db;
        $string =~ /.*::(\w+).*/;
        return $1;
    }

	# doesn't include first column!
	return join (($opt->{joiner} || "\n"), $db->columns())
		if($opt->{columns});

	if($opt->{column_exists}) {
		return defined $db->test_column($opt->{column_exists})
				? ($opt->{yes} || 1)
				: ($opt->{'no'} || '');
	}
	if($opt->{record_exists}) {
		return $db->record_exists($opt->{record_exists})
				? ($opt->{yes} || 1)
				: ($opt->{'no'} || '');
	}
	return;
}
EOR

UserTag set-alias Order alias real permanent
UserTag set-alias PosNumber 3
UserTag set-alias Routine <<EOR
sub {
	my ($alias, $real, $permanent) = @_;
	my $one = $permanent ? 'path_alias' : 'one_time_path_alias';
	$Vend::Session->{$one} = {}
		if ! defined $Vend::Session->{$one};
	$Vend::Session->{$one}{$alias} = $real;
	return;
}
EOR

UserTag grep-mm Order function
UserTag grep-mm addAttr
UserTag grep-mm Interpolate
UserTag grep-mm hasEndTag
UserTag grep-mm Routine <<EOR
sub {
	my($func, $opt, $text) = @_;
#::logDebug("grep-mm record: " . Vend::Util::uneval_it(\@_));
	my $table = $opt->{table} || $::Values->{mvc_data_table};
	my $acl = MiniMate::CfgMgr::get_mm_table_acl($table);
	return $text unless $acl;
	my @items = grep /\S/, Text::ParseWords::shellwords($text);
	return join "\n", MiniMate::CfgMgr::mm_acl_grep($acl, $func, @items);
}
EOR

UserTag uneval Order ref
UserTag uneval PosNumber 1
UserTag uneval Routine <<EOR
sub {
#::logError("args: @_" . Vend::Util::uneval_it(@_));
	return Vend::Util::uneval_it(@_);
}
EOR


UserTag if-mm Order function name
UserTag if-mm addAttr
UserTag if-mm attrAlias key name
UserTag if-mm hasEndTag
UserTag if-mm Routine <<EOR
sub {
	my($func, $field, $opt, $text) = @_;

#::logDebug("if-mm: " . ::uneval(\@_));
	my $record;
	my $status;
	my $reverse;
	$text = 1 if ! $text;
  CHECKIT: {
	$reverse = $func =~ s/^\s*!\s*//;
	unless ($record = $Vend::Minimate_entry) {
		$status = $record, last CHECKIT unless ref($record = mm_acl_enabled());
	}
#::logDebug("if-mm record: " . Vend::Util::uneval_it($record));
	($status = 1, last CHECKIT) if $record->{super};
	$func = lc $func;
	$opt->{table} = $field if $func eq 'advanced';
	my $table = $opt->{table} ||
				$::Values->{mvc_data_table} ||
				$::Values->{mv_data_table};

	my %acl_func = qw/
						fields	fields
						field	fields
						columns	fields
						column	fields
						row		keys
						rows	keys
						key		keys
						keys	keys
						owner_field	owner_field
						owner	owner_field
					/;
	
	my %file_func = qw/
						page	pages
						file	files
						pages	pages
						files	files
					/;

	my %bool_func = qw/
						config   1
						reconfig 1
					/;

	my %paranoid = qw/
						mml             1
						sql             1
						report          1
						add_delete      1
						add_field       1
						journal_update  1
					/;
	my %yesno_func = qw/
						advanced  functions
						tables  tables
						table   tables
					/;

	my $acl;
	my $check;
	$status = 0, last CHECKIT if $func eq 'super';
	if($check = $file_func{$func}) {
		$status = 1, last CHECKIT unless $record->{$check};
		my $file = $field || $Global::Variable->{MV_PAGE};
		my @files =  MiniMate::CfgMgr::list_glob($record->{$check}, $opt->{prefix});
#::logDebug("if-mm file/page: file=$file set=@files");
		if(! @files) {
			$status = '';
			last CHECKIT;
		}
		$status = mm_check_acl($file, join(" ", @files));
		last CHECKIT;
	}
	if($bool_func{$func} ) {
		$status = $record->{$func};
		last CHECKIT;
	}
	if($check = $yesno_func{$func} ) {
#::logDebug("if-mm yesno check: table=$table func=$func");
		my $v;
		if($paranoid{$table}) {
			if($v = $record->{"yes_$check"}) {
				$status = mm_check_acl($table, $v);
			}
			else {
				$status = 1;
			}
			if($v = $record->{"no_$check"}) {
				$status &&= ! mm_check_acl($table, $v);
			}
		}
		else {
			$status = 1;
			if($v = $record->{"no_$check"}) {
				$status = ! mm_check_acl($table, $v);
			}
		}
		last CHECKIT;
	}
	if(! ($check = $acl_func{$func}) ) {
#::logDebug("if-mm straight check: table=$table func=$func");
		my $default = $func =~ /^no_/ ? 0 : 1;
		$status = $default, last CHECKIT unless $record->{$func};
		$status = mm_check_acl($table, $record->{$func});
#::logDebug("if-mm straight check: table=$table func=$func status=$status reverse=$reverse");
		last CHECKIT;
	}

	# Now it is definitely a job for table_control;
	$acl = MiniMate::CfgMgr::get_mm_table_acl($table);
#::logDebug("if-mm ACL check: table=$table func=$func check=$check status=$status reverse=$reverse");
#::logDebug("if-mm ACL check: ofield=$acl->{owner_field}");
#::logDebug("if-mm acl=" . Vend::Util::uneval_it($acl));

	$status = 1, last CHECKIT unless $acl;
	my $val;
	if($acl->{owner_field} and $check eq 'keys') {
#::logDebug("if-mm ACL check owner_field: table=$table field=$field check=$check ofield=$acl->{owner_field}");
		$status = ::tag_data($table, $acl->{owner_field}, $field)
					eq $Vend::Session->{mm_username};
		last CHECKIT;
	}
	elsif ($check eq 'owner_field') {
		$status = length $acl->{owner_field};
		last CHECKIT;
	}
	$status = MiniMate::CfgMgr::mm_acl_atom($acl, $check, $field);
  }
#::logDebug("if-mm: func=$func field=$field status=$status reverse=$reverse");
	return $status
		? (
			Vend::Interpolate::pull_if($text, $reverse)
		  )
		: Vend::Interpolate::pull_else($text, $reverse);
}
EOR

UserTag mm-value Order field table
UserTag mm-value addAttr
UserTag mm-value Routine <<EOR
sub {
	my($field, $table, $opt, $text) = @_;

	my $record;
	my $status;
	my $reverse;
	my $uid = $opt->{user};
	unless ($record = $Vend::Minimate_entry) {
		return '' unless ref($record = mm_acl_enabled());
	}
#::logDebug("mm-value record: " . ::uneval($record));
	$table = $opt->{table} || $::Scratch->{mvc_data_table};

	if($field eq 'user') {
		return $Vend::Session->{mm_username} || $Vend::Session->{username} || $CGI::user;
	}

	my %hash_field = qw/
						acl_keys      1
						no_fields     1
						yes_fields    1
						no_keys       1
						yes_keys      1
						owner_field   1
					/;
	
	my $acl;
	my $check;
	if($check = $hash_field{$field}) {
		if ($field eq 'acl_keys') {
			return join "\n", get_mm_table_acl($table, $uid, 1);
		}
		else {
			$acl = get_mm_table_acl($table, $uid);
			return $acl->{$field};
		}
	}
	else {
		return $record->{$field};
	}
}
EOR

UserTag file-info Order name
UserTag file-info attrAlias file name
UserTag file-info addAttr
UserTag file-info Routine <<EOR
sub {
	my ($fn, $opt) = @_;
	my @stat = stat($fn);
	my %info;
	my @ary;
	my $size  = $stat[7] < 1024
					 ? $stat[7]
					 : ( $stat[7] < 1024 * 1024
						? sprintf ("%.2fK", $stat[7] / 1024)
						: sprintf ("%.2fM", $stat[7] / 1024 / 1024)
						);
	if($opt->{flags}) {
		$opt->{flags} =~ s/\W//g;
		my @flags = split //, $opt->{flags};
		for(@flags) {
			s/(.)/"-$1 _"/ee;
		}
		return join "\t", @flags;
	}
	if($opt->{size}) {
		return $stat[7];
	}
	if($opt->{time}) {
		return $stat[9];
	}
	if($opt->{date}) {
		if($opt->{gmt}) {
			return POSIX::strftime('%c', gmtime($stat[9]));
		}
		else {
			return POSIX::strftime('%c', localtime($stat[9]));
		}
	}
	$opt->{fmt} = '%f bytes, last modified %Y-%m-%d %H:%M:%S'
		if ! $opt->{fmt};
	$opt->{fmt} =~ s/%f/$size/g;
	if($opt->{gmt}) {
		return POSIX::strftime($opt->{fmt}, gmtime($stat[9]));
	}
	else {
		return POSIX::strftime($opt->{fmt}, localtime($stat[9]));
	}
}
EOR

UserTag write-relative-file Documentation <<EOD

=head2 write-relative-file

usage: [write-relative-file file=name]content[/write-relative-file]

Writes a file C<name> in the catalog directory. Name must be relative; it will
return undef if the file name is absolute or contains C<..>.

EOD

UserTag write-relative-file Order file
UserTag write-relative-file hasEndTag
UserTag write-relative-file Routine <<EOR
sub {
	my ($file, $data) = @_;
	::logGlobal("writing $file");
	$file =~ m:(.*)/:;
	return undef if Vend::Util::file_name_is_absolute($file);
	return undef if $file =~ /\.\./;
	my $dir = $1;
	use File::Path;
	if($dir and ! -d $dir) {
		return undef if -e $dir;
		File::Path::mkpath([$dir]);
	}
	Vend::Util::writefile(">$file", $data);
}
EOR

UserTag version Routine sub { $::VERSION }
UserTag base-url Routine sub { return $Vend::Cfg->{VendURL} }

AddDirective MinimateStyle hash

UserTag mm-menu-item Order name
UserTag mm-menu-item addAttr
UserTag mm-menu-item Routine <<EOR
my %mm_style = (
	link => '<A HREF="$URL$">$ANCHOR$</A>',
	li_link  => '<LI>&nbsp;<A HREF="$URL$">$ANCHOR$</A></LI>',
	icon_text => '<A HREF="$URL$">$ICON$</A>&nbsp;<A HREF="$URL$">$ICON$</A>',
	icon   => '<A HREF="$URL$">$ICON$</A>',
	);
sub {
	my ($name, $opt) = @_;
	$name = uc "MM_$name";
	$opt->{style} = 'link' unless $opt->{style};
	my $template = $Vend::Cfg->{MinimateStyle}->{$name} || $mm_style{$opt->{style}};
}
EOR

