code/UI_Tag/menu_load.coretag

   1 # Copyright 2002-2007 Interchange Development Group and others
   2 #
   3 # This program is free software; you can redistribute it and/or modify
   4 # it under the terms of the GNU General Public License as published by
   5 # the Free Software Foundation; either version 2 of the License, or
   6 # (at your option) any later version.  See the LICENSE file for details.
   7 #
   8 # $Id: menu_load.coretag,v 1.9 2007-03-30 23:40:54 pajamian Exp $
   9
  10 UserTag menu-load Order    type
  11 UserTag menu-load addAttr
  12 UserTag menu-load Version  $Revision: 1.9 $
  13 UserTag menu-load Routine  <<EOR
  14 sub old_link {
  15   my ($row, $nrow) = @_;
  16 #Debug("row link_type='$row->{link_type}'");
  17   if($row->{link_type} eq 'external') {
  18           my $first;
  19           $first = $row->{url};
  20           $first =~ s/\s+$//;
  21           $first =~ s/^\s+//;
  22           $nrow->{page} = $first;
  23   }
  24   elsif ($row->{link_type} eq 'internal') {
  25           my ($page, $form) = split /\s+/, $row->{url}, 2;
  26           $nrow->{page} = $page;
  27           $nrow->{form} = $form;
  28   }
  29   elsif ($row->{link_type} eq 'simple') {
  30           my (@items) = split /\s*[\n,]\s*/, $row->{selector};
  31           my @out;
  32           my $fi = $row->{tab};
  33           my $sp = $row->{page};
  34           my $arg = '';
  35           $nrow->{page} = 'search';
  36           push @out, "fi=$fi" if $fi;
  37           push @out, "sp=$sp" if $sp;
  38           push @out, "st=db";
  39
  40           if(! @items) {
  41                   push @out, "ra=yes";
  42                   $nrow->{form} = join "&", @out;
  43           }
  44           else {
  45                 push @out, "co=yes";
  46                 for(@items) {
  47                         my ($col, $string) = split /\s*=\s*/, $_, 2;
  48                         push @out, "sf=$col";
  49                         push @out, "se=$string";
  50                 }
  51                 push @out, $row->{search}
  52                         if $row->{search} =~ /^\s*\w\w=/;
  53
  54                 push @out, qq{va=banner_image=$row->{banner_image}}
  55                         if $row->{banner_image};
  56                 push @out, qq{va=banner_text=$row->{banner_text}}
  57                         if $row->{banner_text};
  58                 for(@out) {
  59                         s/(.*?=)(.*)/$1 . Vend::Util::hexify($2)/ges;
  60                 }
  61                 $arg = join $Global::UrlJoiner, @out;
  62                 $nrow->{form} = $arg;
  63           }
  64   }
  65   elsif ($row->{link_type} eq 'complex') {
  66           $nrow->{page} = 'search';
  67           $row->{search} =~ s/[\r\n+]/\n/g;
  68           $row->{search} .= qq{\nva=banner_text=$row->{banner_text}}
  69                 if $row->{banner_text};
  70           $row->{search} .= qq{\nva=banner_image=$row->{banner_image}}
  71                 if $row->{banner_image};
  72           my @items = grep /\S/, split /[\r\n]+/, $row->{search};
  73                 for(@items) {
  74                         s/(.*?=)(.*)/$1 . Vend::Util::hexify($2)/ges;
  75                 }
  76           $nrow->{form} = join $Global::UrlJoiner, @items;
  77           $nrow->{form} =~ s/[\r\n]+/&/g;
  78   }
  79   return $nrow;
  80 }
  81
  82 sub {
  83         my ($type, $opt) = @_;
  84 #::logDebug("Called menu_load");
  85         $type ||= $opt->{type} || 'tree';
  86
  87         my @menufields;
  88         if($opt->{menu_fields}) {
  89                 @menufields = grep /\S/, split /[\s,\0]+/, $opt->{menu_fields};
  90         }
  91         else {
  92                 @menufields = qw/
  93                         code mgroup msort next_line indicator exclude_on depends_on page
  94                         form name super inactive description help_name img_dn img_up
  95                         img_sel img_icon url member
  96                 /;
  97         }
  98
  99         my %menuinit = (
 100                                 code => 0,
 101                                 inactive => 0,
 102                                 msort => "'x'",
 103                                 );
 104
 105         my @out;
 106
 107         if ($type eq 'tree') {
 108                 $opt->{table} ||= 'products';
 109                 $opt->{first_field} ||= 'prod_group';
 110                 $opt->{second_field} ||= 'category';
 111                 $opt->{desc_field} ||= $opt->{description_field} || 'description';
 112 #::logDebug("menu_load options=" . uneval($opt));
 113                 PRODBUILD: {
 114                         my $tab = $opt->{table};
 115                         my $db = database_exists_ref($tab)
 116                                 or do {
 117                                         Vend::Tags->error({ set => errmsg(
 118                                                                                 "Failed to open %s table %s.",
 119                                                                                 'products',
 120                                                                                 $tab,
 121                                                                                 ),
 122                                                                         });
 123                                         last PRODBUILD;
 124                                 };
 125                         my $tname = $db->name();
 126 #::logDebug("LARGE=" . $db->config('LARGE'));
 127                         $opt->{key_field} ||= $db->config('KEY');
 128                         if(! $opt->{even_large} and $db->config('LARGE')) {
 129                                 Vend::Tags->error({ set => errmsg(
 130                                                                                 "%s database %s for tree write: %s",
 131                                                                                 'check',
 132                                                                                 $tab,
 133                                                                                 'too large, must override',
 134                                                                         ),
 135                                                                 });
 136                                 last PRODBUILD;
 137                         }
 138                         my @somefields = qw/mgroup page name description/;
 139                         my @fields = (
 140                                                         $opt->{key_field},
 141                                                         $opt->{first_field},
 142                                                         $opt->{second_field},
 143                                                         $opt->{desc_field}
 144                                                 );
 145                         my $sfields = join ",", @fields;
 146                         my $tfields = $opt->{sort_fields} || join ",", @fields[1..$#fields];
 147                         my $q = qq{SELECT $sfields FROM $tname ORDER BY $tfields};
 148                         my $ary = $db->query($q)
 149                                                         or do {
 150                                                                 Vend::Tags->error({
 151                                                                                 set => errmsg(
 152                                                                                         "No results from %s table %s.",
 153                                                                                         'products',
 154                                                                                         $tname,
 155                                                                                 ),
 156                                                                         });
 157                                         last PRODBUILD;
 158                                 };
 159                         my $prev_area = '';
 160                         my $prev_cat = '';
 161                         @out = join "\t", @menufields;
 162                         my @rows;
 163                         my $base_search = "scan/co=yes/fi=$tab";
 164
 165                         for(@$ary) {
 166                                 my($sku, $area, $cat, $desc) = @$_;
 167                                 for( \$sku, \$area, \$cat, \$desc) {
 168                                         $$_ =~ s/\s+$//;
 169                                 }
 170                                 if($area ne $prev_area) {
 171                                         $prev_area = $area;
 172                                         $prev_cat = '';
 173                                         my $url = join '/',
 174                                                                 $base_search,
 175                                                                 "sf=$opt->{first_field}",
 176                                                                 "se=$area",
 177                                                                 "op=eq",
 178                                                                 "tf=$opt->{second_field},$opt->{desc_field}",
 179                                                                 ;
 180                                         push @rows, {
 181                                                         %menuinit,
 182                                                         msort => 0,
 183                                                         page    => $url,
 184                                                         inactive => 0,
 185                                                         name => $area,
 186                                                         };
 187                                 }
 188                                 if($cat ne $prev_cat) {
 189                                         $prev_cat = $cat;
 190                                         my $url = join '/',
 191                                                                 $base_search,
 192                                                                 "sf=$opt->{first_field}",
 193                                                                 "se=$area",
 194                                                                 "op=eq",
 195                                                                 "sf=$opt->{second_field}",
 196                                                                 "se=$cat",
 197                                                                 "op=eq",
 198                                                                 "tf=$opt->{desc_field}",
 199                                                                 ;
 200
 201                                         push @rows, {
 202                                                         %menuinit,
 203                                                         msort => 1,
 204                                                         page    => $url,
 205                                                         inactive => 0,
 206                                                         name => $cat,
 207                                                         };
 208                                 }
 209                                 push @rows, {
 210                                         %menuinit,
 211                                         msort => 2,
 212                                         name => $desc,
 213                                         inactive => 0,
 214                                         page => $sku,
 215                                 } unless $opt->{no_leaves};
 216                         }
 217
 218                         for(@rows) {
 219 #::logDebug("pushing out --> " . $_->{name});
 220                                 push @out, join "\t", @{$_}{@menufields};
 221                         }
 222                 }
 223         }
 224         elsif ($type eq 'category_file') {
 225                 $opt->{table} ||= 'category';
 226                 $opt->{first_field} ||= 'prod_group';
 227                 $opt->{second_field} ||= 'category';
 228 #::logDebug("menu_load options=" . uneval($opt));
 229                 CATBUILD: {
 230                         my $tab = $opt->{table};
 231                         my $db = database_exists_ref($tab)
 232                                 or do {
 233                                         Vend::Tags->error({ set => errmsg(
 234                                                                                 "Failed to open %s table %s.",
 235                                                                                 'products',
 236                                                                                 $tab,
 237                                                                                 ),
 238                                                                         });
 239                                         last CATBUILD;
 240                                 };
 241                         my $tname = $db->name();
 242 #::logDebug("LARGE=" . $db->config('LARGE'));
 243                         $opt->{key_field} ||= $db->config('KEY');
 244                         $opt->{sku_field} ||= 'sku';
 245
 246                         unless ( $db->column_exists($opt->{sku_field}) ) {
 247                                 Vend::Tags->error({ set => errmsg(
 248                                                                                 "%s database %s for tree write: %s",
 249                                                                                 'check',
 250                                                                                 $tab,
 251                                                                                 "sku field $opt->{key_field} does not exist",
 252                                                                         ),
 253                                                                 });
 254                                 last CATBUILD;
 255
 256                         }
 257
 258                         my @somefields = qw/mgroup page name description/;
 259                         my @fields = (
 260                                                         $opt->{key_field},
 261                                                         $opt->{first_field},
 262                                                         $opt->{second_field},
 263                                                         );
 264                         push @fields, $opt->{desc_field} if $opt->{desc_field};
 265
 266                         my $sfields = join ",", @fields;
 267                         my $tfields = $opt->{sort_fields};
 268                         if(! $tfields) {
 269                                 $tfields = "$opt->{first_field},$opt->{second_field}";
 270                                 $tfields .= ",$opt->{desc_field}" if $opt->{desc_field};
 271                         }
 272
 273                         my $q = qq{SELECT $sfields FROM $tname ORDER BY $tfields};
 274 #::logDebug("category_file menu_load query=$q");
 275                         my $ary = $db->query($q)
 276                                                         or do {
 277                                                                 Vend::Tags->error({
 278                                                                                 set => errmsg(
 279                                                                                         "No results from %s table %s.",
 280                                                                                         'products',
 281                                                                                         $tname,
 282                                                                                 ),
 283                                                                         });
 284                                         last CATBUILD;
 285                                 };
 286                         my $prev_area = '';
 287                         my $prev_cat = '';
 288                         @out = join "\t", @menufields;
 289                         my @rows;
 290                         my $base_search = "scan/co=yes/fi=$tab/rf=$opt->{sku_field}";
 291                         $base_search .= "/tf=$opt->{desc_field}" if $opt->{desc_field};
 292
 293                         for(@$ary) {
 294                                 my($sku, $area, $cat, $desc) = @$_;
 295                                 for(\$area, \$cat) {
 296                                         $$_ =~ s/\s+$//;
 297                                 }
 298                                 if($area ne $prev_area) {
 299                                         $prev_area = $area;
 300                                         $prev_cat = '';
 301                                         my $url = join '/',
 302                                                                 $base_search,
 303                                                                 "sf=$opt->{first_field}",
 304                                                                 "se=$area",
 305                                                                 "op=eq",
 306                                                                 "tf=$opt->{second_field}",
 307                                                                 ;
 308                                         push @rows, {
 309                                                         %menuinit,
 310                                                         msort => 0,
 311                                                         page    => $url,
 312                                                         inactive => 0,
 313                                                         name => $area,
 314                                                         };
 315                                 }
 316                                 if($cat ne $prev_cat) {
 317                                         $prev_cat = $cat;
 318                                         my $url = join '/',
 319                                                                 $base_search,
 320                                                                 "sf=$opt->{first_field}",
 321                                                                 "se=$area",
 322                                                                 "op=eq",
 323                                                                 "sf=$opt->{second_field}",
 324                                                                 "se=$cat",
 325                                                                 "op=eq",
 326                                                                 ;
 327
 328                                         push @rows, {
 329                                                         %menuinit,
 330                                                         msort => 1,
 331                                                         page    => $url,
 332                                                         inactive => 0,
 333                                                         name => $cat,
 334                                                         };
 335                                 }
 336                         }
 337
 338                         for(@rows) {
 339 #::logDebug("pushing out --> " . $_->{name});
 340                                 push @out, join "\t", @{$_}{@menufields};
 341                         }
 342                 }
 343         }
 344         elsif ($type eq 'comb_category') {
 345                 $opt->{table} ||= 'products';
 346                 $opt->{comb_field} ||= 'comb_category';
 347                 $opt->{sort_string} ||= "tf=$opt->{comb_field},$Vend::Cfg->{DescriptionField}";
 348                 $opt->{sort_order} ||= $opt->{comb_field};
 349
 350
 351                 COMB_BUILD: {
 352                                 my $tab = $opt->{table};
 353                                 my $comb_field = $opt->{comb_field};
 354                                 my $db = $Db{$tab}
 355                                                 or do {
 356                                                                 $Tag->error({ set => errmsg(
 357                                                                                 "Failed to open %s table %s.",
 358                                                                                 'products',
 359                                                                                 $tab,
 360                                                                                 ),
 361                                                                 });
 362                                                                 last COMB_BUILD;
 363                                                         };
 364
 365 #Debug("LARGE=" . $db->config('LARGE'));
 366                                 if(! $opt->{even_large} and $db->config('LARGE')) {
 367                                         $Tag->error({ set => errmsg(
 368                                                                         "%s database %s for tree write: %s",
 369                                                                         'check',
 370                                                                         $tab,
 371                                                                         'too large, must override',
 372                                                                         ),
 373                                         });
 374                                         last COMB_BUILD;
 375                                 }
 376                                 my @somefields = qw/mgroup page name description/;
 377                                 my $q = qq{
 378                                                 SELECT $comb_field
 379                                                 FROM $tab
 380                                                 ORDER BY $comb_field
 381                                                 };
 382                                 my $ary = $db->query($q)
 383                                                         or do {
 384                                                                 $Tag->error({
 385                                                                                 set => errmsg(
 386                                                                                                 "No results from %s table %s.",
 387                                                                                                 'products',
 388                                                                                                 $tab,
 389                                                                                         ),
 390                                                                         });
 391                                                                         last COMB_BUILD;
 392                                                                 };
 393                                 @out = join "\t", @menufields;
 394                                 my @rows;
 395                                 my @base_search = (     "bs=1",
 396                                                         "em=1",
 397                                                         "su=1",
 398                                                         "fi=$tab",
 399                                                         "st=db"
 400                                                         );
 401                                 my @levels;
 402                                 my %seen;
 403
 404                                 $seen{$_->[0]}++ for @$ary;
 405                                 for(sort keys %seen) {
 406                                         my $comb_category = $_;
 407                                         $comb_category =~ s/\s+$//;
 408
 409                                         my @parts = split /:/, $comb_category;
 410                                         my $combname = '';
 411                                         for( my $i = 0; $i < @parts; $i++) {
 412                                                 my $level = $levels[$i] ||= {};
 413                                                 my $name = $parts[$i];
 414                                                 my $comb = join ":", @parts[0 .. $i];
 415                                                 if(! $level->{$name}) {
 416                                                         $level->{$name}++;
 417
 418                                                         my $searchterm = "se=";
 419                                                         $searchterm .= $Tag->filter('urlencode',$comb);
 420                                                         my $form = join "&",
 421                                                                                 @base_search,
 422                                                                                 $opt->{sort_string},
 423                                                                                 "sf=$comb_field",
 424                                                                                 $searchterm
 425                                                                                 ;
 426                                                         push @rows,     {
 427                                                                                 %menuinit,
 428                                                                                 msort   => $i,
 429                                                                                 page    => 'search',
 430                                                                                 inactive        => 0,
 431                                                                                 name    => $name,
 432                                                                                 form    => $form,
 433                                                                         };
 434                                                 }
 435                                         }
 436                                 }
 437
 438
 439                         for(@rows) {
 440 #Debug("pushing out --> " . $_->{name});
 441                                 push @out, join "\t", @{$_}{@menufields};
 442                         }
 443 #return join("<br>",@out);
 444                 }
 445         }
 446         elsif ($type eq 'cat_menu') {
 447                 AREABUILD: {
 448                         my $tab = $opt->{table} || 'area';
 449                         my $ctab = $opt->{cat_table} || 'cat';
 450                         my $db = database_exists_ref($tab)
 451                                 or do {
 452                                         Vend::Tags->error({ set => errmsg(
 453                                                                                 "Failed to open %s table %s.",
 454                                                                                 'area',
 455                                                                                 $tab,
 456                                                                                 ),
 457                                                                         });
 458                                         last AREABUILD;
 459                                 };
 460 #Debug("LARGE=" . $db->config('LARGE'));
 461                         my $q = qq{ SELECT * FROM $tab};
 462                         $q .= qq{ WHERE sel = '$opt->{sel}'}
 463                                 if $opt->{sel};
 464                         $q .= qq{ ORDER BY sort };
 465                         my $ary = $db->query({ sql => $q, hashref => 1 } )
 466                                                         or do {
 467                                                                 Vend::Tags->error({
 468                                                                                 set => errmsg(
 469                                                                                         "No results from %s table %s.",
 470                                                                                         'area',
 471                                                                                         $tab,
 472                                                                                 ),
 473                                                                         });
 474                                                         last AREABUILD;
 475                                                 };
 476
 477                         @out = join "\t", @menufields;
 478
 479                         my @rows;
 480                         my $nc = '0000';
 481                         my $cdb = database_exists_ref($ctab)
 482                                                 or do {
 483                                                         Vend::Tags->error({
 484                                                                         set => errmsg(
 485                                                                                 "No results from %s table %s.",
 486                                                                                 'category',
 487                                                                                 $tab,
 488                                                                         ),
 489                                                                 });
 490                                                         last AREABUILD;
 491                                                 };
 492                         my $ctabname = $cdb->name();
 493                         foreach my $row (@$ary) {
 494                                 my $code = $row->{code};
 495                                 my $nrow = {
 496                                         code => $nc++,
 497                                         name => $row->{name},
 498                                         img_icon => $row->{image},
 499                                         msort => 0,
 500                                         mgroup => $row->{set_selector},
 501                                 };
 502                                 old_link($row, $nrow);
 503                                 my $sq = qq{
 504                                                 SELECT * FROM $ctabname
 505                                                 WHERE sel = '$code'
 506                                                 OR    sel like '$code %'
 507                                                 OR    sel like '% $code'
 508                                                 OR    sel like '% $code %'
 509                                                 ORDER BY sort
 510                                                 };
 511 #Debug("subquery=$sq");
 512                                 push @rows, $nrow;
 513                                 my $sary = $cdb->query({ sql => $sq, hashref => 1 });
 514 #Debug("subquery returned: " . uneval($sary));
 515                                 for my $crow (@$sary) {
 516                                   my $nsub = {
 517                                           code => $nc++,
 518                                           name => $crow->{name},
 519                                           img_icon => $crow->{image},
 520                                           msort => 1,
 521                                           mgroup => $crow->{sel},
 522                                   };
 523                                   old_link($crow, $nsub);
 524                                   push @rows, $nsub;
 525                                 }
 526                         }
 527                         for(@rows) {
 528 #Debug("pushing out --> " . $_->{name});
 529                                 push @out, join "\t", @{$_}{@menufields};
 530 #Debug("pushing out --> row=" . uneval($_));
 531                         }
 532                 }
 533         }
 534         elsif($type eq 'html') {
 535
 536                 my $text = $opt->{html};
 537                 my $start = '0001';
 538                 @out = join "\t", @menufields;
 539                 while($text =~ s{<a(\s+.*?)</a>}{}is) {
 540                         my $blob = $1;
 541                         my $desc = '';
 542                         $blob =~ m{^[^>]*\s+title=(['"]?)(.*?)\1}
 543                                 and $desc = $2;
 544                         $blob =~ s{^.*?\shref\s*=\s*(["'])?(.*?)\1}{}is
 545                                 or next;
 546                         my $link = $2;
 547                         $blob =~ s/.*?>//;
 548                         1 while $blob =~ s{<.*?>}{};
 549                         my $anchor = $blob;
 550                         my $sort = $start;
 551                         $sort =~ s/./x/;
 552                         my($href, $parms) = split /\?/, $link, 2;
 553                         my %record = (
 554                                 code => $start++,
 555                                 msort => $sort,
 556                                 page => $href,
 557                                 form => $parms,
 558                                 name => $anchor,
 559                                 description => $desc,
 560                         );
 561
 562                         push @out, join "\t", @record{@menufields};
 563                 }
 564
 565         }
 566         return '' unless @out;
 567         return join "\n", @out, '';
 568 }
 569 EOR