[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 cat area [cgi qmenu_products] __UI_META_TABLE__ [/seti] [perl tables="[scratch medit_tables]"] my $menupath = $Variable->{MV_MENU_DIRECTORY} || 'include/menus'; @menufields = qw/ code mgroup msort next_line indicator exclude_on depends_on page form name super inactive description help_name img_dn img_up img_sel img_icon url member /; $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. Active on next access.", $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 @valid; for(my $i = 0; $i < @fields; $i++) { push @valid, $i if defined $db->test_column($fields[$i]); } #Debug("valid entries=" . join(',', @valid)); @fields = @fields[@valid]; 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; @row = @row[@valid]; 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 %s table %s.", 'products', $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 %s table %s.", 'products', $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}"); } } elsif ($CGI->{qmenu_cat}) { AREABUILD: { my $tab = $CGI->{qmenu_area} || 'area'; my $ctab = $CGI->{qmenu_cat} || 'cat'; my $db = $Db{$tab} or do { $Tag->error({ set => errmsg( "Failed to open %s table %s.", 'area', $tab, ), }); last AREABUILD; }; #Debug("LARGE=" . $db->config('LARGE')); my $q = qq{ SELECT * FROM $tab ORDER BY sort }; my $ary = $db->query({ sql => $q, hashref => 1 } ) or do { $Tag->error({ set => errmsg( "No results from %s table %s.", 'area', $tab, ), }); last AREABUILD; }; sub old_link { my ($row, $nrow) = @_; #Debug("row link_type='$row->{link_type}'"); if($row->{link_type} eq 'external') { $first = $row->{url}; $first =~ s/\s+$//; $first =~ s/^\s+//; $nrow->{page} = $first; } elsif ($row->{link_type} eq 'internal') { my ($page, $form) = split /\s+/, $row->{url}, 2; $nrow->{page} = $page; $nrow->{form} = $form; } elsif ($row->{link_type} eq 'simple') { my (@items) = split /\s*[\n,]\s*/, $row->{selector}; my @out; my $fi = $row->{tab}; my $sp = $row->{page}; my $arg = ''; $nrow->{page} = 'search'; push @out, "fi=$fi" if $fi; push @out, "sp=$sp" if $sp; push @out, "st=db"; if(! @items) { push @out, "ra=yes"; $nrow->{form} = join "\n", @out; } else { push @out, "co=yes"; for(@items) { my ($col, $string) = split /\s*=\s*/; push @out, "sf=$col"; push @out, "se=$string"; } push @out, $row->{search} if $row->{search} =~ /^\s*\w\w=/; push @out, qq{va=banner_image=$row->{banner_image}}; push @out, qq{va=banner_text=$row->{banner_text}}; $arg = join "\n", @out; $nrow->{form} = $arg; } } elsif ($row->{link_type} eq 'complex') { $row->{search} =~ s/[\r\n+]/\n/g; $row->{search} .= qq{\nva=banner_text=$row->{banner_text}}; $row->{search} .= qq{\nva=banner_image=$row->{banner_image}}; $nrow->{form} = $row->{search}; } else { $url = ""; } return $nrow; } my @rows; my $nc = '0000'; my $cdb = $Db{$ctab}; foreach my $row (@$ary) { my $code = $row->{code}; my $nrow = { code => $nc++, name => $row->{name}, img_icon => $row->{image}, msort => 0, mgroup => $row->{set_selector}, }; old_link($row, $nrow); my $sq = qq{ SELECT * FROM $ctab WHERE sel = '$code' OR sel like '$code %' OR sel like '% $code' OR sel like '% $code %' ORDER BY sort }; #Debug("subquery=$sq"); push @rows, $nrow; my $sary = $cdb->query({ sql => $sq, hashref => 1 }); #Debug("subquery returned: " . uneval($sary)); for my $crow (@$sary) { my $nsub = { code => $nc++, name => $crow->{name}, img_icon => $crow->{image}, msort => 1, mgroup => $crow->{sel}, }; old_link($crow, $nsub); push @rows, $nsub; } } for(@rows) { #Debug("pushing out --> " . $_->{name}); push @out, join "\t", @{$_}{@menufields}; #Debug("pushing out --> row=" . uneval($_)); } push @out, join $Scratch->{qmenu_data} = join "\n", @out, ''; $CGI->{qmenu_name} = ''; $CGI->{qmenu_new} ||= 'Untitled'; #Debug("qmenu_data=$Scratch->{qmenu_data}"); } } 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 $sort = $start; $sort =~ s/./x/; my($href, $parms) = split /\?/, $link, 2; my %record = ( code => $start++, msort => $sort, page => $href, form => $parms, name => $anchor, description => $desc, ); push @out, join "\t", @record{@menufields}; } $Scratch->{qmenu_data} = join "\n", @out, ''; $CGI->{qmenu_name} = ''; $CGI->{qmenu_new} ||= 'Untitled'; } my $files = $Tag->list_pages({ base => $menupath, ext => '.txt', arrayref => 1, }); #Debug("files=" . join(",", @$files)); my @names; for(@$files) { my $tmp = $_; $tmp =~ s/%([A-Fa-f0-9]{2})/chr(hex $1)/eg; $_ = "$menupath/$_.txt"; 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/]
Menu name: [page href="__UI_BASE__/file_transfer" form=" initial_dir=include/menus "]Delete/Manage
[/if]
[warnings auto=1] [error all=1 text="
  • %s
" joiner="
  • "]
  • Build menu tree from database table:


    Override, build even if large
    [/restrict]

    Save to new menu          
    Tree mode Write tree to DB Show numerical level

    [set empty][/set]
    [loop head-skip=1 lr=1 list="[scratch qmenu_data]"][list]
    [/list][no-match][set empty]1[/set][/no-match] [/loop] [loop ranges=1 list="[scratch lastfull]..[scratch loopinc]"]
    [loop-change 1] [condition]1[/condition][if scratch empty]

    Create menu from HTML


    [/if] [/loop-change 1]
    [/loop]
    Name
    Page
    Form values
     
    Options Menu Group    Inactive entry
    Label only
    Break line
    Detailed Description


         
    Disable Enable
    @_UI_STD_FOOTER_@