Name

menu-load —

ATTRIBUTES

Attribute Pos. Req. Default Description
type
menu_fields
table
first_field
second_field
desc_field
description_field
key_field
even_large
sort_fields
no_leaves
sku_field
comb_field
sort_string
sort_order
cat_table
sel
html
interpolate     0 interpolate output?
hide     0 Hide the tag return value?

DESCRIPTION

BEHAVIOR

This tag does not appear to be affected by, or affect, the rest of Interchange.

EXAMPLES

No examples are available at this time. We do consider this a problem and will try to supply some.

NOTES

AVAILABILITY

menu-load is available in Interchange versions:

4.6.0-5.7.0 (git-head)

SOURCE

Interchange 5.7.0:

Source: code/UI_Tag/menu_load.coretag
Lines: 569


# Copyright 2002-2007 Interchange Development Group and others
# 
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.  See the LICENSE file for details.
# 
# $Id: menu_load.coretag,v 1.9 2007-03-30 23:40:54 pajamian Exp $

UserTag menu-load Order    type
UserTag menu-load addAttr
UserTag menu-load Version  $Revision: 1.9 $
UserTag menu-load Routine  <<EOR
sub old_link {
my ($row, $nrow) = @_;
#Debug("row link_type='$row->{link_type}'");
if($row->{link_type} eq 'external') {
  my $first;
  $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 "&", @out;
  }
  else {
  push @out, "co=yes";
  for(@items) {
    my ($col, $string) = split /\s*=\s*/, $_, 2;
    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}}
    if $row->{banner_image};
  push @out, qq{va=banner_text=$row->{banner_text}}
    if $row->{banner_text};
  for(@out) {
    s/(.*?=)(.*)/$1 . Vend::Util::hexify($2)/ges;
  }
  $arg = join $Global::UrlJoiner, @out;
  $nrow->{form} = $arg;
  }
}
elsif  ($row->{link_type} eq 'complex') {
  $nrow->{page} = 'search';
  $row->{search} =~ s/[\r\n+]/\n/g;
  $row->{search} .= qq{\nva=banner_text=$row->{banner_text}}
    if $row->{banner_text};
  $row->{search} .= qq{\nva=banner_image=$row->{banner_image}}
    if $row->{banner_image};
  my @items = grep /\S/, split /[\r\n]+/, $row->{search};
  for(@items) {
    s/(.*?=)(.*)/$1 . Vend::Util::hexify($2)/ges;
  }
  $nrow->{form} = join $Global::UrlJoiner, @items;
  $nrow->{form} =~ s/[\r\n]+/&/g;
}
return $nrow;
}

sub {
my ($type, $opt) = @_;
#::logDebug("Called menu_load");
$type ||= $opt->{type} || 'tree';

my @menufields;
if($opt->{menu_fields}) {
  @menufields = grep /\S/, split /[\s,\0]+/, $opt->{menu_fields};
}
else {
  @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
  /;
}

my %menuinit = (
      code => 0,
      inactive => 0,
      msort => "'x'",
      );

my @out;

if ($type eq 'tree') {
  $opt->{table} ||= 'products';
  $opt->{first_field} ||= 'prod_group';
  $opt->{second_field} ||= 'category';
  $opt->{desc_field} ||= $opt->{description_field} || 'description';
#::logDebug("menu_load options=" . uneval($opt));
  PRODBUILD: {
    my $tab = $opt->{table};
    my $db = database_exists_ref($tab)
      or do {
        Vend::Tags->error({ set => errmsg(
                  "Failed to open %s table %s.",
                  'products',
                  $tab,
                  ),
                });
        last PRODBUILD;
      };
    my $tname = $db->name();
#::logDebug("LARGE=" . $db->config('LARGE'));
    $opt->{key_field} ||= $db->config('KEY');
    if(! $opt->{even_large} and $db->config('LARGE')) {
      Vend::Tags->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 @fields = (
            $opt->{key_field},
            $opt->{first_field},
            $opt->{second_field},
            $opt->{desc_field}
          );
    my $sfields = join ",", @fields;
    my $tfields = $opt->{sort_fields} || join ",", @fields[1..$#fields];
    my $q = qq{SELECT $sfields FROM $tname ORDER BY $tfields};
    my $ary = $db->query($q)
            or do {
              Vend::Tags->error({
                  set => errmsg(
                    "No results from %s table %s.",
                    'products',
                    $tname,
                  ),
                });
        last PRODBUILD;
      };
    my $prev_area = '';
    my $prev_cat = '';
    @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=$opt->{first_field}",
              "se=$area",
              "op=eq",
              "tf=$opt->{second_field},$opt->{desc_field}",
              ;
        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=$opt->{first_field}",
              "se=$area",
              "op=eq",
              "sf=$opt->{second_field}",
              "se=$cat",
              "op=eq",
              "tf=$opt->{desc_field}",
              ;

        push @rows, {
            %menuinit,
            msort => 1,
            page  => $url,
            inactive => 0,
            name => $cat,
            };
      }
      push @rows, {
        %menuinit,
        msort => 2,
        name => $desc,
        inactive => 0,
        page => $sku,
      } unless $opt->{no_leaves};
    }

    for(@rows) {
#::logDebug("pushing out --> " . $_->{name});
      push @out, join "\t", @{$_}{@menufields};
    }
  }
}
elsif ($type eq 'category_file') {
  $opt->{table} ||= 'category';
  $opt->{first_field} ||= 'prod_group';
  $opt->{second_field} ||= 'category';
#::logDebug("menu_load options=" . uneval($opt));
  CATBUILD: {
    my $tab = $opt->{table};
    my $db = database_exists_ref($tab)
      or do {
        Vend::Tags->error({ set => errmsg(
                  "Failed to open %s table %s.",
                  'products',
                  $tab,
                  ),
                });
        last CATBUILD;
      };
    my $tname = $db->name();
#::logDebug("LARGE=" . $db->config('LARGE'));
    $opt->{key_field} ||= $db->config('KEY');
    $opt->{sku_field} ||= 'sku';

    unless ( $db->column_exists($opt->{sku_field}) ) {
      Vend::Tags->error({ set => errmsg(
                  "%s database %s for tree write: %s",
                  'check',
                  $tab,
                  "sku field $opt->{key_field} does not exist",
                ),
              });
      last CATBUILD;

    }

    my @somefields = qw/mgroup page name description/;
    my @fields = (
            $opt->{key_field},
            $opt->{first_field},
            $opt->{second_field},
            );
    push @fields, $opt->{desc_field} if $opt->{desc_field};

    my $sfields = join ",", @fields;
    my $tfields = $opt->{sort_fields};
    if(! $tfields) {
      $tfields = "$opt->{first_field},$opt->{second_field}";
      $tfields .= ",$opt->{desc_field}" if $opt->{desc_field};
    }

    my $q = qq{SELECT $sfields FROM $tname ORDER BY $tfields};
#::logDebug("category_file menu_load query=$q");
    my $ary = $db->query($q)
            or do {
              Vend::Tags->error({
                  set => errmsg(
                    "No results from %s table %s.",
                    'products',
                    $tname,
                  ),
                });
        last CATBUILD;
      };
    my $prev_area = '';
    my $prev_cat = '';
    @out = join "\t", @menufields;
    my @rows;
    my $base_search = "scan/co=yes/fi=$tab/rf=$opt->{sku_field}";
    $base_search .= "/tf=$opt->{desc_field}" if $opt->{desc_field};

    for(@$ary) {
      my($sku, $area, $cat, $desc) = @$_;
      for(\$area, \$cat) {
        $$_ =~ s/\s+$//;
      }
      if($area ne $prev_area) {
        $prev_area = $area;
        $prev_cat = '';
        my $url = join '/',
              $base_search,
              "sf=$opt->{first_field}",
              "se=$area",
              "op=eq",
              "tf=$opt->{second_field}",
              ;
        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=$opt->{first_field}",
              "se=$area",
              "op=eq",
              "sf=$opt->{second_field}",
              "se=$cat",
              "op=eq",
              ;

        push @rows, {
            %menuinit,
            msort => 1,
            page  => $url,
            inactive => 0,
            name => $cat,
            };
      }
    }

    for(@rows) {
#::logDebug("pushing out --> " . $_->{name});
      push @out, join "\t", @{$_}{@menufields};
    }
  }
}
elsif ($type eq 'comb_category') {
  $opt->{table} ||= 'products';
  $opt->{comb_field} ||= 'comb_category';
  $opt->{sort_string} ||= "tf=$opt->{comb_field},$Vend::Cfg->{DescriptionField}";
  $opt->{sort_order} ||= $opt->{comb_field};


  COMB_BUILD: {
      my $tab = $opt->{table};
      my $comb_field = $opt->{comb_field};
      my $db = $Db{$tab}
          or do {
              $Tag->error({ set => errmsg(
                  "Failed to open %s table %s.",
                  'products',
                  $tab,
                  ),
              });
              last COMB_BUILD;
            };

#Debug("LARGE=" . $db->config('LARGE'));
      if(! $opt->{even_large} and $db->config('LARGE')) {
        $Tag->error({ set => errmsg(
                "%s database %s for tree write: %s",
                'check',
                $tab,
                'too large, must override',
                ),
        });
        last COMB_BUILD;
      }
      my @somefields = qw/mgroup page name description/;
      my $q = qq{
          SELECT $comb_field
          FROM $tab
          ORDER BY $comb_field
          };
      my $ary = $db->query($q)
            or do {
              $Tag->error({
                  set => errmsg(
                      "No results from %s table %s.",
                      'products',
                      $tab,
                    ),
                });
                last COMB_BUILD;
              };
      @out = join "\t", @menufields;
      my @rows;
      my @base_search = (  "bs=1", 
            "em=1", 
            "su=1", 
            "fi=$tab", 
            "st=db"
            );  
      my @levels;
      my %seen;

      $seen{$_->[0]}++ for @$ary;
      for(sort keys %seen) {
        my $comb_category = $_;
        $comb_category =~ s/\s+$//;

        my @parts = split /:/, $comb_category;
        my $combname = '';
        for( my $i = 0; $i < @parts; $i++) {
          my $level = $levels[$i] ||= {};
          my $name = $parts[$i];
          my $comb = join ":", @parts[0 .. $i];
          if(! $level->{$name}) {
            $level->{$name}++;

            my $searchterm = "se="; 
            $searchterm .= $Tag->filter('urlencode',$comb);
            my $form = join "&",
                  @base_search,
                  $opt->{sort_string},
                  "sf=$comb_field",
                  $searchterm
                  ;
            push @rows,   {
                  %menuinit,
                  msort  => $i,
                  page  => 'search',
                  inactive  => 0,
                  name  => $name,
                  form  => $form,
                };
          }
        }
      }


    for(@rows) {
#Debug("pushing out --> " . $_->{name});
      push @out, join "\t", @{$_}{@menufields};
    }
#return join("<br>",@out);
  }
}
elsif ($type eq 'cat_menu') {
  AREABUILD: {
    my $tab = $opt->{table} || 'area';
    my $ctab = $opt->{cat_table} || 'cat';
    my $db = database_exists_ref($tab)
      or do {
        Vend::Tags->error({ set => errmsg(
                  "Failed to open %s table %s.",
                  'area',
                  $tab,
                  ),
                });
        last AREABUILD;
      };
#Debug("LARGE=" . $db->config('LARGE'));
    my $q = qq{ SELECT * FROM $tab};
    $q .= qq{ WHERE sel = '$opt->{sel}'}
      if $opt->{sel};
    $q .= qq{ ORDER BY sort };
    my $ary = $db->query({ sql => $q, hashref => 1 } )
            or do {
              Vend::Tags->error({
                  set => errmsg(
                    "No results from %s table %s.",
                    'area',
                    $tab,
                  ),
                });
            last AREABUILD;
          };

    @out = join "\t", @menufields;

    my @rows;
    my $nc = '0000';
    my $cdb = database_exists_ref($ctab)
          or do {
            Vend::Tags->error({
                set => errmsg(
                  "No results from %s table %s.",
                  'category',
                  $tab,
                ),
              });
            last AREABUILD;
          };
    my $ctabname = $cdb->name();
    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 $ctabname
          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($_));
    }
  }
}
elsif($type eq 'html') {

  my $text = $opt->{html};
  my $start = '0001';
  @out = join "\t", @menufields;
  while($text =~ s{<a(\s+.*?)</a>}{}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{<.*?>}{};
    my $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};
  }

}
return '' unless @out;
return join "\n", @out, '';
}
EOR

AUTHORS

Interchange Development Group

SEE ALSO

DocBook! Interchange!