# 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.

UserTag menu-load Order type

UserTag menu-load addAttr

UserTag menu-load Version 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