site/cgi-bin/modules/BSE/Generate/Catalog.pm

   1 package BSE::Generate::Catalog;
   2
   3 our $VERSION = "1.004";
   4
   5 use strict;
   6 use Generate;
   7 use Products;
   8 use base 'BSE::Generate::Article';
   9 use BSE::Template;
  10 use Constants qw($CGI_URI $ADMIN_URI);
  11 use BSE::Regen qw(generate_button);
  12 use OtherParents;
  13 use DevHelp::HTML;
  14 use BSE::Arrows;
  15 use BSE::Util::Iterate;
  16 use BSE::CfgInfo qw(cfg_dist_image_uri);
  17
  18 sub _default_admin {
  19   my ($self, $article, $embedded) = @_;
  20
  21   my $req = $self->{request};
  22   my $html = <<HTML;
  23 <table>
  24 <tr>
  25 <td><form action="$CGI_URI/admin/add.pl">
  26 <input type=submit value="Edit Catalog">
  27 <input type=hidden name=id value="$article->{id}">
  28 </form></td>
  29 <td><form action="$ADMIN_URI">
  30 <input type=submit value="Admin menu">
  31 </form></td>
  32 HTML
  33   if ($req->user_can('edit_add_child', $article)) {
  34     $html .= <<HTML;
  35 <td><form action="$CGI_URI/admin/add.pl">
  36 <input type=hidden name="parentid" value="$article->{id}">
  37 <input type=hidden name="type" value="Product">
  38 <input type=submit value="Add product"></form></td>
  39 <td><form action="$CGI_URI/admin/add.pl">
  40 <input type=hidden name="parentid" value="$article->{id}">
  41 <input type=hidden name="type" value="Catalog">
  42 <input type=submit value="Add Sub-catalog"></form></td>
  43 HTML
  44   }
  45   $html .= <<HTML;
  46 <td><form action="$CGI_URI/admin/shopadmin.pl">
  47 <input type=hidden name="product_list" value=1>
  48 <input type=submit value="Full product list"></form></td>
  49 HTML
  50   if (generate_button()
  51       && $req->user_can(regen_article=>$article)) {
  52     $html .= <<HTML;
  53 <td><form action="$CGI_URI/admin/generate.pl">
  54 <input type=hidden name=id value="$article->{id}">
  55 <input type=submit value="Regenerate">
  56 </form></td>
  57 HTML
  58   }
  59   $html .= <<HTML;
  60 <td><form action="$CGI_URI/admin/admin.pl" target="_blank">
  61 <input type=submit value="Display">
  62 <input type=hidden name=id value="$article->{id}">
  63 <input type=hidden name=admin value="0"></form></td>
  64 </tr></table>
  65 HTML
  66   return $html;
  67 }
  68
  69 sub tag_moveallcat {
  70   my ($self, $allcats, $rindex, $article, $arg, $acts, $funcname, $templater) = @_;
  71
  72   return '' unless $self->{admin};
  73   return '' unless $self->{request};
  74   return ''
  75     unless $self->{request}->user_can(edit_reorder_children => $article);
  76   return '' unless @$allcats > 1;
  77
  78   my ($img_prefix, $urladd) =
  79     DevHelp::Tags->get_parms($arg, $acts, $templater);
  80   $img_prefix = '' unless defined $img_prefix;
  81   $urladd = '' unless defined $urladd;
  82
  83   my $can_move_up = $$rindex > 0;
  84   my $can_move_down = $$rindex < $#$allcats;
  85   return '' unless $can_move_up || $can_move_down;
  86   my $myid = $allcats->[$$rindex]{id};
  87   my $top = $self->{top} || $article;
  88   my $refreshto = "$CGI_URI/admin/admin.pl?id=$top->{id}$urladd";
  89   my $down_url = "";
  90   if ($can_move_down) {
  91     my $nextid = $allcats->[$$rindex+1]{id};
  92     $down_url = "$CGI_URI/admin/move.pl?stepparent=$article->{id}&d=swap&id=$myid&other=$nextid";
  93   }
  94   my $up_url = "";
  95   if ($can_move_up) {
  96     my $previd = $allcats->[$$rindex-1]{id};
  97     $up_url = "$CGI_URI/admin/move.pl?stepparent=$article->{id}&d=swap&id=$myid&other=$previd";
  98   }
  99   return make_arrows($self->{cfg}, $down_url, $up_url, $refreshto, $img_prefix);
 100 }
 101
 102 sub tag_ifAnyProductOptions {
 103   my ($self, $lookup, $arg) = @_;
 104
 105   $arg ||= "product";
 106
 107   my $entry = $lookup->{$arg}
 108     or die "** No such product $arg **";
 109   my ($rindex, $rdata) = @$entry;
 110   $$rindex >= 0 && $$rindex < @$rdata
 111     or die "** not in an iterator for $arg **";
 112   my @options = $rdata->[$$rindex]->option_descs($self->{cfg});
 113
 114   return scalar(@options);
 115 }
 116
 117 sub baseActs {
 118   my ($self, $articles, $acts, $article, $embedded) = @_;
 119
 120   my $products = Products->new;
 121   my @products = sort { $b->{displayOrder} <=> $a->{displayOrder} }
 122     grep $_->{listed} && $_->{parentid} == $article->{id}, $products->all;
 123   my $product_index = -1;
 124   my @subcats = sort { $b->{displayOrder} <=> $a->{displayOrder} }
 125     grep $_->{listed} && UNIVERSAL::isa($_->{generator}, 'BSE::Generate::Catalog'),
 126     $articles->getBy(parentid => $article->{id});
 127   my $other_parents = OtherParents->new;
 128   my ($year, $month, $day) = (localtime)[5,4,3];
 129   my $today = sprintf("%04d-%02d-%02d 00:00:00ZZZ", $year+1900, $month+1, $day);
 130   my @stepprods = $article->visible_stepkids;
 131   my $stepprod_index;
 132   my @allkids = $article->all_visible_kids;
 133   # make sure we have all of the inheritance info
 134   my %generate = map { $_->{generator} => 1 } @allkids;
 135   for my $gen (keys %generate) {
 136     (my $file = $gen . ".pm") =~ s!::!/!g;
 137     require $file;
 138   }
 139   my @allprods = grep UNIVERSAL::isa($_->{generator}, 'BSE::Generate::Product'),
 140     @allkids;
 141   for (@allprods) {
 142     unless ($_->isa('Product')) {
 143       $_ = Products->getByPkey($_->{id});
 144     }
 145   }
 146   my @allcats = grep UNIVERSAL::isa($_->{generator}, 'BSE::Generate::Catalog'),
 147     @allkids;
 148
 149   # for article ifUnderThreshold handler
 150   $self->{kids}{$article->{id}}{allprods} = \@allprods;
 151   $self->{kids}{$article->{id}}{allcats} = \@allcats;
 152
 153   my $allprod_index;
 154   my $catalog_index = -1;
 155   my $allcat_index;
 156   my %named_product_iterators =
 157     (
 158      product => [ \$product_index, \@products ],
 159      allprod => [ \$allprod_index, \@allprods ],
 160     );
 161   my $it = BSE::Util::Iterate->new;
 162   my $cfg = $self->{cfg};
 163   my $art_it = BSE::Util::Iterate::Article->new(cfg => $cfg);
 164   my $image_uri = cfg_dist_image_uri();
 165   my %work =
 166     (
 167      $self->SUPER::baseActs($articles, $acts, $article, $embedded),
 168      #article => sub { escape_html($article->{$_[0]}) },
 169      $art_it->make_iterator(undef, 'product', 'products', \@products,
 170                         \$product_index),
 171      admin => [ tag_admin => $self, $article, 'catalog', $embedded ],
 172      # for rearranging order in admin mode
 173      moveDown=>
 174      sub {
 175        if ($self->{admin} && $product_index < $#products) {
 176          my $html = <<HTML;
 177  <a href="$CGI_URI/admin/move.pl?id=$products[$product_index]{id}&amp;d=down"><img src="$image_uri/admin/move_down.gif" width="17" height="13" border="0" alt="Move Down" align="absbottom" /></a>
 178 HTML
 179          chop $html;
 180          return $html;
 181        }
 182        else {
 183          return '';
 184        }
 185      },
 186      moveUp=>
 187      sub {
 188        if ($self->{admin} && $product_index > 0) {
 189          my $html = <<HTML;
 190  <a href="$CGI_URI/admin/move.pl?id=$products[$product_index]{id}&amp;d=up"><img src="$image_uri/admin/move_up.gif" width="17" height="13" border="0" alt="Move Up" align="absbottom" /></a>
 191 HTML
 192          chop $html;
 193          return $html;
 194        }
 195        else {
 196          return '';
 197        }
 198      },
 199      $art_it->make_iterator(undef, 'allprod', 'allprods', \@allprods,
 200                         \$allprod_index),
 201      moveallprod =>
 202      sub {
 203        my ($arg, $acts, $funcname, $templater) = @_;
 204
 205        return '' unless $self->{admin};
 206        return '' unless $self->{request};
 207        return ''
 208          unless $self->{request}->user_can(edit_reorder_children => $article);
 209        return '' unless @allprods > 1;
 210
 211        my ($img_prefix, $urladd) =
 212          DevHelp::Tags->get_parms($arg, $acts, $templater);
 213        $img_prefix = '' unless defined $img_prefix;
 214        $urladd = '' unless defined $urladd;
 215
 216        my $can_move_up = $allprod_index > 0;
 217        my $can_move_down = $allprod_index < $#allprods;
 218        return '' unless $can_move_up || $can_move_down;
 219        my $blank = qq(<img src="$image_uri/trans_pixel.gif" width="17" height="13" border="0" align="absbotton" alt="" />);
 220        my $myid = $allprods[$allprod_index]{id};
 221        my $top = $self->{top} || $article;
 222        my $refreshto = "$CGI_URI/admin/admin.pl?id=$top->{id}$urladd";
 223        my $down_url = "";
 224        if ($can_move_down) {
 225          my $nextid = $allprods[$allprod_index+1]{id};
 226          $down_url = "$CGI_URI/admin/move.pl?stepparent=$article->{id}&d=swap&id=$myid&other=$nextid";
 227        }
 228        my $up_url = "";
 229        if ($can_move_up) {
 230          my $previd = $allprods[$allprod_index-1]{id};
 231          $up_url = "$CGI_URI/admin/move.pl?stepparent=$article->{id}&d=swap&id=$myid&other=$previd";
 232        }
 233
 234        return make_arrows($self->{cfg}, $down_url, $up_url, $refreshto, $img_prefix);
 235      },
 236      ifAnyProds => scalar(@allprods),
 237      $art_it->make_iterator(undef, 'stepprod', 'stepprods', \@stepprods,
 238                         \$stepprod_index),
 239      ifStepProds => sub { @stepprods },
 240      $art_it->make_iterator(undef, 'catalog', 'catalogs', \@subcats,
 241                         \$catalog_index),
 242      ifSubcats => sub { @subcats },
 243      $art_it->make_iterator(undef, 'allcat', 'allcats', \@allcats, \$allcat_index),
 244      moveallcat =>
 245      [ \&tag_moveallcat, $self, \@allcats, \$allcat_index, $article ],
 246      ifAnyProductOptions =>
 247      [ tag_ifAnyProductOptions => $self, \%named_product_iterators ],
 248     );
 249   my $oldurl = $work{url};
 250   my $urlbase = $self->{cfg}->entryVar('site', 'url');
 251   $work{url} =
 252     sub {
 253       my $value = $oldurl->(@_);
 254       return $value if $value =~ /^<:/; # handle "can't do it"
 255       unless ($value =~ /^\w+:/) {
 256         # put in the base site url
 257         $value = $urlbase . $value;
 258       }
 259       return $value;
 260     };
 261
 262   return %work;
 263 }
 264
 265 1;
 266
 267 __END__
 268
 269 =head1 NAME
 270
 271   BSE::Generate::Catalog - page generator class for catalog pages
 272
 273 =head1 DESCRIPTION
 274
 275   This class is used to generate catalog pages for BSE.  It derives
 276   from L<BSE::Generate::Article>, and inherits it's tags.
 277
 278 =head1 TAGS
 279
 280 =over 4
 281
 282 =item iterator ... products
 283
 284 Iterates over the products within this catalog.
 285
 286 =item product I<field>
 287
 288 The given attribute of the product.
 289
 290 =item ifProducts
 291
 292 Conditional tag, true if there are any normal child products.
 293
 294 =item iterator ... allprods
 295
 296 Iterates over the products and step products of this catalog, setting
 297 the allprod tag for each item.
 298
 299 =item allprod I<field>
 300
 301 The given attribute of the product.
 302
 303 =item ifAnyProds
 304
 305 Conditional tag, true if there are any normal or step products.
 306
 307 =item iterator ... stepprods
 308
 309 Iterates over any step products of this catalog, setting the
 310 I<stepprod> tag to the current step product.  Does not iterate over
 311 normal child products.
 312
 313 =item stepprod I<field>
 314
 315 The given attribute of the current step product.
 316
 317 =item ifStepProds
 318
 319 Conditional tag, true if there are any step products.
 320
 321 =item iterator ... catalogs
 322
 323 Iterates over any sub-catalogs.
 324
 325 =item catalog I<field>
 326
 327 The given field of the current catalog.
 328
 329 =item ifSubcats
 330
 331 Conditional tag, true if there are any subcatalogs.
 332
 333 =item admin
 334
 335 Generates administrative tools (in admin mode).
 336
 337 =back
 338
 339 =head1 BUGS
 340
 341 Still contains some code from before we derived from
 342 BSE::Generate::Article, so there is some obsolete code still present.
 343
 344 =cut