[if cgi junksubmit] [or cgi cancelsubmit] Hit action for no-content [tag op=header]Status: 204 No content[/tag] [goto] [/if] [set page_title][L]Menu construction[/L][/set] [tmpn dhtml_required]1[/tmpn] [set ui_class]Design[/set] [if cgi qmenu_separate] [cgi name=qmenu_products set="[cgi qmenu_separate]" hide=1] [/if] [if cgi qmenu_name] [set page_banner][msg arg.0="[cgi qmenu_name]"]Edit the %s menu[/msg][/set] [else] [set page_banner][L]Menu constructor: Make a quick menu[/L][/set] [/else] [/if] [tmpn check_publish]1[/tmpn] [set page_perm]layout=e[/set] [set help_name]menu.edit[/set] [set icon_name]icon_pages.gif[/set] [seti ui_body_extra][/seti] [tmp meta_header] [include include/table_populator]
[/tmp] @_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]
[set qmenu_relocate][/set] [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_products} && $CGI->{qmenu_use_comb_field}) { # Build menu from a comb_category field ('Level 1:Level 2:Level 3...Level n') $CGI->{qmenu_comb_field} ||= 'comb_category'; my %opt = ( table => $CGI->{qmenu_products}, comb_field => $CGI->{qmenu_comb_field}, sort_string => $CGI->{qmenu_sort_string}, sort_order => $CGI->{qmenu_sort_order}, type => 'comb_category', even_large => $CGI->{qmenu_even_large}, ); $CGI->{qmenu_text} = $Tag->menu_load(\%opt); $CGI->{qmenu_name} = ''; $CGI->{qmenu_new} = 'Untitled'; } elsif ($CGI->{qmenu_products}) { # Build menu from prod_group and category fields $CGI->{qmenu_toplevel_field} ||= 'prod_group'; $CGI->{qmenu_sublevel_field} ||= 'category'; my %opt = ( table => $CGI->{qmenu_products}, first_field => $CGI->{qmenu_toplevel_field}, second_field => $CGI->{qmenu_sublevel_field}, desc_field => $CGI->{qmenu_desc_field}, even_large => $CGI->{qmenu_even_large}, sku_field => $CGI->{qmenu_sku_field}, type => $CGI->{qmenu_load_type} || 'tree', no_leaves => $CGI->{qmenu_no_leaves}, ); $CGI->{qmenu_text} = $Tag->menu_load(\%opt); $CGI->{qmenu_name} = ''; $CGI->{qmenu_new} = 'Untitled'; } elsif ($CGI->{qmenu_cat}) { # Build menu from top&sub level tables if($CGI->{qmenu_sel_value} =~ /\S/) { $CGI->{qmenu_sel_value} =~ s/^\s+//; $CGI->{qmenu_sel_value} =~ s/\s+$//; } else { undef $CGI->{qmenu_sel_value}; } $CGI->{qmenu_toplevel} ||= 'area'; $CGI->{qmenu_sublevel} ||= 'cat'; my %opt = ( table => $CGI->{qmenu_toplevel}, sel => $CGI->{qmenu_sel_value}, cat_table => $CGI->{qmenu_sublevel}, even_large => $CGI->{qmenu_even_large}, type => 'cat_menu', ); $CGI->{qmenu_text} = $Tag->menu_load(\%opt); $CGI->{qmenu_name} = ''; $CGI->{qmenu_new} = 'Untitled'; } 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}; #Debug("qmenu text length=" . length($text)); #Debug("qmenu text value=$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, )); $Scratch->{qmenu_relocate} = 1; } else { $Tag->error({ name => 'Save menu', set => errmsg( "Failed to save menu '%s' to file %s.", $Tag->filter('urldecode', $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.", }); } } if($CGI->{qmenu_html_create} and $CGI->{qmenu_create}) { my $text = $CGI->{qmenu_html_create}; my $num_options; my $num_links; $num_options++ while $text =~ m{ $num_links) { while( $text =~ m{ ]* value\s*=\s*"(.*?)" [^>]* > ([^<>]*) }ixgs ) { my $url = $1; my $anchor = $2; my $sort = $start; $sort =~ s/./x/; my($href, $parms) = split /\?/, $url, 2; my %record = ( code => $start++, msort => $sort, page => $href, form => $parms, name => $anchor, ); push @out, join "\t", @record{@menufields}; } } else { 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; #Debug("menufields=" . join(",", @menufields)); } 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-code] [/loop] [/tmp] [output name=search_box] [form-session-id] [tmp delete_loc][area href=admin/file_transfer form=| initial_dir=include/menus |][/tmp] [L]Menu name[/L]
[output name=""] [if scratch qmenu_relocate] [if cgi return_page] [deliver location="[area href='[cgi return_page]']" type="text/html"] [/if] [/if] [warnings auto=1] [error all=1 text="

- %s

" joiner="
- "]
  [/restrict] [output name="top_of_form"] [form-session-id] [output name=top_buttons] [L]Save to new menu[/L] [output name=""]

  | [L]Show item info[/L] [L]Tree mode[/L] [L]Write tree to DB[/L] [L]Show numerical level[/L] [L]Collapse tree[/L] [L]Explode tree[/L]

  Test floatbox.

  [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] ### [L]Create menu from HTML[/L] [/if] [/loop-change 1] [/loop] |
  [tabbed-display panel-width="500" panel-height="100%" panel-shade=e tab-height=24 tab-width=150] [tabbed-panel [L]General[/L]]
  [L]Name[/L] |
  [L]Page[/L] |
  [L]Form values[/L] |
  [L]Detailed Description[/L] |
  [L]Options[/L] | [L]Label only[/L] [L]Break line[/L]
  [L]Inactive[/L] |
  [L]Menu Group[/L] |
  [/tabbed-panel] [tabbed-panel [L]Advanced[/L]]
  [/tabbed-panel] [/tabbed-display]

  [output name="bottom_buttons"] [output name="bottom_of_form"] [output name=""] @_UI_STD_FOOTER_@