Permalink
Find file
Fetching contributors…
Cannot retrieve contributors at this time
460 lines (398 sloc) 11.8 KB
# 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 (US)"
# 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;
# strip action from beginning of path
$path =~ s{\A[^/]+/}{};
#::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...