ui.cfg

# Set global defaults for UI images location
Variable UI_IMAGE_DIR /interchange-5/
Variable UI_IMAGE_DIR_SECURE /interchange-5/

# Set the base for the UI pages
Variable UI_BASE admin
Variable UI_HELP_TABLE ichelp
#Variable UI_HELP_URL http://other-help-host/...

Variable UI_STATE_TABLE   state
Variable UI_COUNTRY_TABLE country

# This one is MV because used internally as well
Variable MV_OPTION_TABLE options

# Load individual locale settings.
# Comment this out to remove language selection box from login page.
include lib/UI/locales/*_*.cfg

# Set up for default locale
Locale en_US MV_LANG_NAME English

# instruct Interchange to use this directory as alternative
# for searching Interchange pages
TemplateDir lib/UI/pages

# This tag is here to initialize the imports
UserTag reconfigure Order table file
UserTag reconfigure Routine <<EOR
use UI::Primitive;
use Vend::Table::Editor;
*ui_check_acl = \&UI::Primitive::ui_check_acl;
*ui_acl_enabled = \&UI::Primitive::ui_acl_enabled;
*get_ui_table_acl = \&UI::Primitive::get_ui_table_acl;
sub {
	my ($table, $file) = @_;
	my $recon = $CGI::script_name;
	if($table and $file) {
		$recon .= " $table $file";
	}
	Vend::Util::logData("$Global::RunDir/reconfig", $recon)
			and return "SUCCESS";
	return "FAILED";
}
EOR

GlobalSub <<EOS
sub admin_links {
	return unless $Vend::admin;
	my $tmpd = $Vend::Cfg->{ScratchDir};
	$tmpd .= "/previews/$Vend::SessionID";
#::logDebug("tmpd = $tmpd");
	$Vend::Cfg->{PreviewDir} = $tmpd if -d $tmpd;
#::logDebug("PreviewDir=$Vend::Cfg->{PreviewDir}");
	$::Variable->{ADL_SUFFIX} = $Vend::Cfg->{HTMLsuffix};
	$::Variable->{ADL_PAGE} = $::Variable->{ADL_PAGE_TEMPLATE} || <<EOF;
[page href="admin/content_editor" form="
			ui_name=[var MV_PAGE 1][var ADL_SUFFIX]
			ui_type=page
		"][loc]edit[/loc]&nbsp;[loc]page[/loc]</a>
[page href="[var MV_PAGE 1]" form="
			ui_mozilla_edit=1
		"][loc]show&nbsp;tags[/loc]</a>
EOF

	$::Variable->{ADL_COMPONENT} = $::Variable->{ADL_COMPONENT_TEMPLATE} || <<EOF;
[page href="admin/content_editor" form="
			ui_name=[contol component]
			ui_type=component
		"][loc]edit[/loc]&nbsp;[control component]</a>
EOF

	$::Variable->{ADL_ITEM} = $::Variable->{ADL_ITEM_TEMPLATE} || <<EOF;
<a href="[area
			href=admin/item_edit
			form=|
				item_id=[item-code]
				ui_return_to=index
			|
		]">[loc]edit[/loc]&nbsp;[loc]item[/loc]</a>
EOF
	$::Variable->{ADL_MENU} = $::Variable->{ADL_MENU_TEMPLATE} || <<EOF;
<a class="[control link_class]"
	href="[area
			href=admin/menu_editor
			form=|
				qmenu_name=[either][control menu_name][or][var MV_PAGE 1][/either]
			|
		]">[loc]edit[/loc]&nbsp;[loc]menu[/loc]</a>
EOF

	if($CGI::values{ui_mozilla_edit}) {
		$::Pragma->{no_locale_parse} = 1;
		$::Pragma->{init_page} = 'show_tags_for_edit';
	}
	return;

}
EOS

GlobalSub <<EOS
sub show_tags_for_edit {
	my $html = shift;

	my @headers;
	my $i = 0;
	while($$html =~ m{\[control-set\](.*?)\[/control-set\]}isg) {
		$i++;
		my $data = $1;
		while($data =~ m{\[(\w+)\](.*?)\[/\1]}sg) {
			my $parm = $1;
			my $val = HTML::Entities::encode_entities($2);
			push @headers, qq{<meta name="ic-component" content="$i;$parm;$val">};
		}
	}

	while($$html =~ m{
						\[ (seti?|tmpn?) \s+ (\w+) \s*\]
							(.*?)
						\[/\1\]
						(?=.*
							(<!--+\s+BEGIN\s+PREAMBLE|\@_\w+_TOP_\@)
						)
					}isgx
				)
	{
		my $type = $1;
		my $parm = $2;
		my $val = HTML::Entities::encode_entities($3);
		next if $parm eq 'meta_header';
		next if $parm eq 'page_title';
		push @headers, qq{<meta name="ic-setting" content="$type;$parm;$val">};
	}

	my $meta_string = join "\n", @headers;
	if($meta_string) {
		$$html =~ s{(\[(seti?|tmpn?)\s+meta_header\s*\])(.*?\[/\2])}
					{$1 . $meta_string . "\n" . $3}is
			or
		 $$html =~ s{^}{[set meta_header]$meta_string\[/set]\n};
	}

	$$html =~ s{(<!--+\s*BEGIN\s+CONTENT\s*--+>)}{[strip reparse=0]$1};
	$$html =~ s{(<!--+\s*END\s+CONTENT\s*--+>)}{$1\[/strip]};
}
EOS

ActionMap admin_publish <<EOR
sub {
	require HTML::HeadParser;
	my $path = shift;
#::logDebug("Path is $path");

	use vars qw/
		$Tag
	/;
	
#::logDebug("env is " . ::uneval(Vend::Dispatch::http()->{env}));

	$Vend::Extension and $path .= $Vend::Cfg->{HTMLsuffix};

	unless($CGI::request_method eq 'PUT') {
		$Tag->deliver('text/html', { status => "405 Not Implemented" }, 0);
		logError("admin_publish expecting PUT.");
		return;
	}

	unless($Vend::admin) {
		$Tag->deliver('text/html', { status => "403 forbidden" }, 0);
		logError("PUT by non-admin, quitting.");
		return;	
	}

	my $mimetype = Vend::Util::mime_type($path);

	my $publish_dir;
	my $icpage;
	my $umask;
	my $orig_umask;

	if($mimetype eq 'text/html') {
		$icpage = 1;
		$publish_dir = $::Variable->{PUBLISH_PUT_PAGES}  || 'pages';
		unless($Tag->if_mm('pagematch', $path)) {
			$Tag->deliver('text/html', { status => "403 forbidden" }, 0);
			logError("User %s not authorized for page %s.", $Vend::username, $path);
			return;	
		}
	}
	else {
		$publish_dir = $::Variable->{PUBLISH_PUT_IMAGES} || 'images';
		unless($Tag->if_mm('filematch', "$publish_dir/$path")) {
			$Tag->deliver('text/html', { status => "403 forbidden" }, 0);
			logError(
					"User %s not authorized for file %s.",
					$Vend::username,
					"$publish_dir/$path",
				);
			return;	
		}
		$umask = oct($::Variable->{PUBLISH_IMAGES_UMASK} || 2);
	}

	if(	$::Variable->{PUBLISH_NO_PAGE_ROOT}
		and $mimetype eq 'text/html'
		and $path !~ m{/}
	) {
		$Tag->deliver('text/html', { status => "403 forbidden" }, 0);
		logError("PUT in top level of page directory not allowed.");
		return;	
	}

	my %header;

	CREATEPAGE: {
		my $top;
		my $bottom;

		last CREATEPAGE unless $icpage;

		$::Pragma->{no_locale_parse} = 1;
		my $origfile = readin($path);

		my $dir = $path;
		$dir =~ s:/[^/]+$::
			or $dir = '';

		GETPAGE: {
			last GETPAGE if $origfile;
			my $newpath = $path;
			my $idx = $Vend::Cfg->{DirectoryIndex} || 'index';
			while(! $origfile and $newpath =~ s:/?([^/]+)$::) {
				$origfile = readin(Vend::File::catfile($newpath, $idx));
			}
		}
		if(! $origfile) {
			::logDebug("Cannot find template file, publishing as is.");
			last CREATEPAGE;
		}
		$origfile =~ s{(.*)\s*<!--+\s+BEGIN\s+CONTENT\s+--+>}{}s
			and $top = $1;
		$origfile =~ s{.*<!--+\s+END\s+CONTENT\s+--+>\s*}{}s
			and $bottom = $origfile;
		my $content = $$CGI::put_ref;

		my $p = HTML::HeadParser->new();

		$p->parse($content);
		$header{page_title} = $p->header('title');
		
		my %sets;
		my @components;
		my $compcheck = sub {
			my($hname, $value) = @_;
#::logDebug("Calling compcheck name=$hname value=$value");
			$hname = lc $hname;
			return unless $hname =~ /^x-meta-ic-(\w+)/;
			$hname = $1;
			if($hname eq 'component') {
#::logDebug("doing $value");
				my ($idx, $name, $val) = split /;/, $value, 3;
				return unless $idx > 0;
				$components[$idx - 1] ||= [];
				$val = HTML::Entities::decode_entities($val);
				my $string = join "",
								"[$name]",
								$val,
								"[/$name]",
								;
				push @{$components[$idx - 1]}, $string;
			}
			elsif ($hname eq 'setting') {
				my ($type, $name, $val) = split /;/, $value, 3;
				$val = HTML::Entities::decode_entities($val);
				my $string = join "",
								"[$type $name]",
								$val,
								"[/$type]",
								;
				$sets{$name} = $string;
			}
		};

		$p->header->scan($compcheck);

		if(@components) {
			my @c;
			for(my $i = 0; $i < @components; $i++) {
				my $ref = $components[$i];
				push @c, '[control-set]';
				if($ref) {
					for(@$ref) {
						push @c, $_;
					}
				}
				push @c, '[/control-set]';
			}
			my $cstring = join "\n", @c;
#::logDebug("Component cstring:\n$cstring");
			$top =~ s{(\[control\s+reset=1\s*\]).*(\[control\s+reset=1\s*\])}
			         {$1$cstring$2}si;
		}

		for(keys %sets) {
			$top =~ s{\[(seti?|tmpn?)\s+$_\s*\].*?\[/\1\]}
					 {$sets{$_}}s
			  or $top =~ s{\[/comment]\s*}{[/comment]\n$sets{$_}}
			  or $top =~ s{^}{$sets{$_}\n};
		}
#::logDebug("header title=$header{page_title} object" . ::uneval($p));
		$top =~ s{(\[(seti?|tmpn?)\s+(\w+)\s*\])(.*?)(\[/\2\])}
				{$1 . ($header{$3} || $4) . $5}eg;

		$content =~ s{.*<!--+\s+BEGIN\s+CONTENT\s+--+>\s*}{}s
			or $content =~ s:.*<body.*?>\s*::is;
		$content =~ s{\s*<!--+\s+END\s+CONTENT\s+--+>.*}{}s
			or $content =~ s:\s*</body\s*>.*::is;
		$content =~ s/\r\n/\n/g;

		my %strip_vars;
		my $strip_init;

		my $change_sub = sub {
			my $url = shift;
			return $url if $url =~ m{^\w+:};
			return $url if $url =~ m{^[[/]};
			my @parts = split m{/}, $dir;
			while($url =~ s{^../}{}) {
				splice @parts, -1, 1;
			}
			my $newdir = join "/", @parts;
			$url = "$newdir/$url" if $newdir;

			my $arg;
			my @args;
			my @out;
			($url, $arg) = split /[?&]/, $url, 2;
			@args = split $Global::UrlSplittor, $arg;
			if(@args) {
				for(@args) {
					my ($var, $val) = split /=/, $_, 2;
					next if $strip_vars{$var};
					push @out, "$var=" . unhexify($_);
				}
				my $fstr = join "\n", @out;
				return qq{[area href='$url' form=|$fstr|]};
			}
			return qq{[area $url]};
		};

		1 while $content =~ s{(<\w+[^>]*\s+[-\w]+\s*=\s*")([^"]*\%5b.*?\%5d)}
							{$1 . unhexify($2)}ie;
		if($dir) {
			$dir =~ s:/*$:/:;
			$content =~ s{(<a\s+[^>]*href\s*=\s*)(["'])(\.\.[^'"]+)\2}
							{$1 . $2 . $change_sub->($3) . $2}gei;
			$content =~ s#(<i\w+\s+[^>]*?src=")(?!\w+:)([^/'][^"]+)#
						$1 . $dir . $2#ige;
			$content =~ s#(<body\s+[^>]*?background=")(?!\w+:)([^/'][^"]+)#
						$1 . $dir . $2#ige;
			$content =~ s#(<t(?:[dhr]|able)\s+[^>]*?background=")(?!\w+:)([^/'][^"]+)#
							$1 . $dir . $2#ige;
		}

		$top =~ s/\s+$//;
		$content =~ s/^\s+//;
		$content =~ s/\s+$//;
		$$CGI::put_ref = join "\n\n",
							$top,
							'<!-- BEGIN CONTENT -->',
							$content,
							'<!-- END CONTENT -->',
							$bottom;
	}

	if($::Variable->{PUBLISH_TO_PREVIEWS}) {
		$Vend::Cfg->{PreviewDir} ||=
			catfile($Vend::Cfg->{ScratchDir}, 'previews', $Vend::SessionID);
		$publish_dir = $Vend::Cfg->{PreviewDir};
		$publish_dir =~ s{^$Vend::Cfg->{VendRoot}/*}{};
	}

#::logDebug("PUBLISH_DIR=$publish_dir FILE=$path");

	my $fn = catfile($publish_dir, $path);

	$orig_umask = umask($umask) if $umask;

	if($icpage and $::Variable->{PUBLISH_DO_RCS} and -f $fn) {
		## Make the RCS directory if not there
		my $dir;
		$fn =~ m{(.*)/};
		$dir = "$1/RCS";
		File::Path::mkpath($dir) if ! -d $dir;

		my $msg = errmsg("Change by %s published via PUT.", $Vend::username);
		my @rcs_cmd = (
					qq{ci -m"$msg" $fn >/dev/null 2>/dev/null},
					qq{co -l $fn >/dev/null 2>/dev/null},
					);

		# See if in RCS already, check in initial if not
		system(qq{rlog $fn >/dev/null 2>/dev/null});
		if($?) {
#::logDebug("RCS version was not there.");
			my $m = $header{page_title} || 'New page';
			$m =~ s/"/\\"/g;
			$rcs_cmd[0] = qq{ci -i1.1 -t-"$m" $fn >/dev/null 2>/dev/null};
			## Do nothing, there was already a version
		}
		else {
#::logDebug("RCS version previously checked in.");
			## Don't need to check in, already done
		}
		for(@rcs_cmd) {
#::logDebug("RCS command: $_");
			system $_;
			if($?) {
				logError("PUT RCS error on command '%s': %s", $_, $!);
				if ($::Variable->{PUBLISH_QUIT_ON_RCS_ERROR}) {
					$Tag->deliver('text/html', { status => "500 Server Error" }, 0);
					umask($orig_umask) if defined $orig_umask;
					return;
				}
			}
		}
	}

#::logDebug("Getting ready to put $fn.");

	my $existing = -f $fn;

	unless($Tag->write_relative_file($fn, $$CGI::put_ref)) {
		$Tag->deliver('text/html', { status => "500 Server Error" }, 0);
		logError("PUT of $fn failed, write error.");
		umask($orig_umask) if defined $orig_umask;
		return;
	}

	umask($orig_umask) if defined $orig_umask;

	$Vend::Session->{put_files} ||= [];
	push (@{$Vend::Session->{put_files}}, $path);

	my $status = $existing ? '204 OK' : '201 OK';
	::logError("put of %s succeeded, status=$status.", $fn);

	$Tag->deliver('text/html', { status => $status}, 1);
	return;
}
EOR

# user tags
include lib/UI/vars/*
Profiles lib/UI/profiles/*

Message ...UI is loaded...