[if cgi junksubmit]
[or cgi cancelsubmit]
Hit action for no-content
[tag op=header]Status: 204 No content[/tag]
[goto]
[/if]
[set page_title]Menu construction[/set]
[tmpn dhtml_required]1[/tmpn]
[set ui_class]Design[/set]
[set page_banner]Menu constructor: Make a quick menu[/set]
[set page_perm]layout=e[/set]
[set help_name]layout.edit[/set]
[set icon_name]icon_pages.gif[/set]
[seti ui_body_extra][/seti]
@_UI_STD_HEAD_@
[loop list="tree __MV_TREE_TABLE__"]
[flag type=write table="[loop-code]"]
[/loop]
[seti medit_tables]
__MV_TREE_TABLE__
__ProductFiles_0__
tree
[cgi qmenu_products]
__UI_META_TABLE__
[/seti]
[perl tables="[scratch medit_tables]"]
my $menupath = $Variable->{MV_MENU_DIRECTORY} || 'include/menus';
@menufields = qw/code mgroup inactive msort page form name description extended/;
$Tag->tmp('qmenu_fdata');
$Tag->tmp('qmenu_data');
%menuinit = (
code => 0,
inactive => 0,
msort => "'x'",
);
if($CGI->{qmenu_text}) {
my $menufile;
my $menuname;
if($CGI->{qmenu_new} =~ /\S/) {
$menuname = $CGI->{qmenu_new};
$menuname =~ s/\s+$//;
$menuname =~ s/^\s+//;
}
else {
$menuname = $CGI->{qmenu_name};
}
$CGI->{qmenu_name} = $menuname;
if($menuname) {
$menufile = $Tag->filter('filesafe', "$menupath/$menuname.txt");
my $text = $CGI->{qmenu_text};
$text =~ s{\\([\\r])}{
if ($1 eq 'r') { "\r" }
elsif($1 eq "\\") { "\\" }
else { "\\$1" }
}eg;
$text =~ s/\r\n/\n/g;
$Tag->backup_file($menufile) if -f $menufile;
if($Tag->write_relative_file($menufile, $text) ) {
$Tag->warnings( errmsg(
"Menu '%s' saved to file %s.",
$menuname,
$menufile,
));
}
else {
$Tag->error({ name => 'Save menu',
set => errmsg(
"Failed to save menu '%s' to file %s.",
$Tag->filter('unescape', $menuname),
$menufile,
),
});
}
my $tab = $Variable->{MV_TREE_TABLE} || 'tree';
if($CGI->{qmenu_tree} && $CGI->{qmenu_write_tree} and $Db{$tab}) {
TREEWRITE: {
my $db = $Db{$tab}
or do {
$Tag->error({
set => errmsg(
"%s database %s for tree write: %s",
'open',
$tab,
'non-existent',
),
});
last TREEWRITE;
};
my @lines = split /\n/, $text;
my @fields = split /\t/, shift(@lines);
my $pfield = $Variable->{MV_TREE_PARENT_FIELD} || 'parent_fld';
my $gfield = $Variable->{MV_TREE_GROUP_FIELD} || 'mgroup';
my $sfield = $Variable->{MV_TREE_SORT_FIELD} || 'msort';
my $gptr;
my $sptr;
for(my $i = 1; $i < @fields; $i++) {
if($fields[$i] eq $gfield) {
$gptr = $i;
}
elsif($fields[$i] eq $sfield) {
$sptr = $i;
}
}
my $num = @fields;
my $last = $num - 1;
my $pptr = @fields;
push @fields, $pfield;
shift(@fields);
my @parent = ($menuname);
my $plev = 0;
my $query = qq{delete from $tab where $gfield = '$menuname'};
$db->query($query);
for(@lines) {
my @row = split /\t/, $_, $num;
my @f = @fields;
$#row = $last;
my $lev = $row[$sptr];
#Debug("menu level=$lev");
$row[$gptr] = $menuname;
$row[$pptr] = $parent[$lev];
splice(@parent, $lev + 1);
shift(@row);
#Debug("fields to set: " . uneval(\@f));
#Debug("values to set: " . uneval(\@row));
my $key = $db->set_slice(undef, \@f, \@row);
#Debug("fields to set: " . uneval(\@f));
#Debug("values to set: " . uneval(\@row));
$parent[$lev + 1] = $key;
}
$Tag->warnings( errmsg(
"Successfully wrote %s lines to tree %s.",
scalar(@lines),
$menuname,
) );
}
}
}
else {
$Tag->error({ name => 'qmenu_name/qmenu_new',
set => "No menu name to write.",
});
}
}
elsif ($CGI->{qmenu_products}) {
PRODBUILD: {
my $tab = $CGI->{qmenu_products};
my $db = $Db{$tab}
or do {
$Tag->error({ set => errmsg(
"Failed to open products table %s.",
$tab,
),
});
last PRODBUILD;
};
#Debug("LARGE=" . $db->config('LARGE'));
if(! $CGI->{qmenu_even_large} and $db->config('LARGE')) {
$Tag->error({ set => errmsg(
"%s database %s for tree write: %s",
'check',
$tab,
'too large, must override',
),
});
last PRODBUILD;
}
my @somefields = qw/mgroup page name description/;
my $q = qq{
SELECT sku,prod_group,category,description
FROM $tab
ORDER BY prod_group,category,description
};
my $ary = $db->query($q)
or do {
$Tag->error({
set => errmsg(
"No results from products table %s.",
$tab,
),
});
last PRODBUILD;
};
my $prev_area = '';
my $prev_cat = '';
my @out = join "\t", @menufields;
my @rows;
my $base_search = "scan/co=yes/fi=$tab";
for(@$ary) {
my($sku, $area, $cat, $desc) = @$_;
for( \$sku, \$area, \$cat, \$desc) {
$$_ =~ s/\s+$//;
}
if($area ne $prev_area) {
$prev_area = $area;
$prev_cat = '';
my $url = join '/',
$base_search,
"sf=prod_group",
"se=$area",
"op=eq",
"tf=category,description",
;
push @rows, {
%menuinit,
msort => 0,
page => $url,
inactive => 0,
name => $area,
};
}
if($cat ne $prev_cat) {
$prev_cat = $cat;
my $url = join '/',
$base_search,
"sf=prod_group",
"se=$area",
"op=eq",
"sf=category",
"se=$cat",
"op=eq",
"tf=description",
;
push @rows, {
%menuinit,
msort => 1,
page => $url,
inactive => 0,
name => $cat,
};
}
push @rows, {
%menuinit,
msort => 2,
name => $desc,
inactive => 0,
page => $sku,
};
}
for(@rows) {
#Debug("pushing out --> " . $_->{name});
push @out, join "\t", @{$_}{@menufields};
}
$Scratch->{qmenu_data} = join "\n", @out, '';
$CGI->{qmenu_name} = '';
$CGI->{qmenu_new} ||= 'Untitled';
#Debug("qmenu_data=$Scratch->{qmenu_data}");
}
}
@menufields = qw/code mgroup inactive msort page form name description extended/;
if($CGI->{qmenu_html_create} and $CGI->{qmenu_create}) {
my $text = $CGI->{qmenu_html_create};
my $start = '0001';
my @out = join "\t", @menufields;
while($text =~ s{}{}is) {
my $blob = $1;
my $desc = '';
$blob =~ m{^[^>]*\s+title=(['"]?)(.*?)\1}
and $desc = $2;
$blob =~ s{^.*?\shref\s*=\s*(["'])?(.*?)\1}{}is
or next;
my $link = $2;
$blob =~ s/.*?>//;
1 while $blob =~ s{<.*?>}{};
$anchor = $blob;
my($href, $parms) = split /\?/, $link, 2;
push @out,
join "\t", $start, '', 0, $start, $href, $parms, $anchor, $desc;
$start++;
}
$Scratch->{qmenu_data} = join "\n", @out, '';
$CGI->{qmenu_name} = '';
$CGI->{qmenu_new} ||= 'Untitled';
}
my @files = sort $Tag->list_glob("$menupath/*.txt");
my @names;
for(@files) {
my $tmp = $_;
$tmp =~ s:.*/::;
$tmp =~ s/\.txt$//;
$tmp =~ s/%([A-Fa-f0-9]{2})/chr(hex $1)/eg;
push @names, $tmp;
}
@qmenu{@names} = @files;
my @fdata = "code\tfile";
for(my $i = 0; $i < @names; $i++) {
push @fdata, "$names[$i]\t$files[$i]";
}
$Scratch->{qmenu_fdata} = join "\n", @fdata;
if(my $mn = $CGI->{qmenu_name}) {
my $filedata = $Tag->file($qmenu{$mn});
if(! $filedata) {
$filedata = $Tag->file("$menupath/$mn.txt");
## Aha, in admin include
$CGI->{qmenu_new} ||= $mn;
}
if($filedata) {
$filedata =~ /^(.*)/;
my $f = $1;
$f =~ s/\s+$//;
@menufields = split /\t/, $f;
}
else {
$filedata = join("\t", @menufields);
}
$Scratch->{qmenu_data} = $filedata;
$Scratch->{qmenu_name} = $mn;
my $mbase;
for $mbase ( $CGI->{ui_meta_view}, "menu_editor::$mn") {
$menumeta = $Tag->meta_record($mbase)
and $metabase = $mbase
and last;
}
}
my %illegal;
my @illegal = qw/check msg code/;
my %suggested = qw/
extended 1
inactive 1
/;
my @required = qw/
description
form
mgroup
msort
name
page
/;
@required{@required} = @required;
@illegal{@illegal} = @illegal;
my $illegal = 0;
for(my $i = 1; $i < @menufields; $i++) {
my $f = lc $menufields[$i];
$menu_fh{$f} = $i;
delete $required{$f};
delete $suggested{$f};
if($illegal{$f}) {
$Tag->error({
name => 'Illegal field name',
set => errmsg( "Name reserved: %s.", $f),
});
$illegal++;
}
}
@suggested = keys %suggested;
for(keys %required) {
$Tag->error({
set => errmsg( "Required field '%s' missing.", $_),
});
$illegal++;
}
delete $Scratch->{qmenu_data} if $illegal;
@required{@required} = @required;
return;
[/perl]
[tmp qmenu_options]
[loop head-skip=1 lr=1 list="[scratch qmenu_fdata]" cgi=1 option=qmenu_name]
[/loop]
[/tmp]
[if scratch qmenu_options =~ /\S/] [/if] |
|
[error all=1 text="