Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Fetching contributors…

Cannot retrieve contributors at this time

570 lines (537 sloc) 13.907 kb
# 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
Jump to Line
Something went wrong with that request. Please try again.