t/050-local/050-dyncat.t

   1 #!perl -w
   2 use strict;
   3 use BSE::Test ();
   4 use Test::More tests => 101;
   5 use File::Spec;
   6 use FindBin;
   7 my $cgidir = File::Spec->catdir(BSE::Test::base_dir, 'cgi-bin');
   8 ok(chdir $cgidir, "switch to CGI directory");
   9 push @INC, 'modules';
  10 require BSE::Cfg;
  11 my $cfg = BSE::Cfg->new;
  12 # create some articles to test with
  13 require BSE::TB::Articles;
  14 require BSE::TB::Products;
  15 require BSE::TB::ProductOptions;
  16 require BSE::TB::ProductOptionValues;
  17 require BSE::API;
  18 require BSE::Dynamic::Catalog;
  19 require BSE::Request::Test;
  20 use Carp qw(confess);
  21
  22 $SIG{__DIE__} = sub { confess @_ };
  23
  24 $| = 1;
  25
  26 my %cgi =
  27   (
  28    test1 => "one",
  29    test2 => [ qw/two three/ ],
  30    test3 => "Size: Medium",
  31    test4 => [ "Size: Medium", "Colour: Red" ],
  32    test5 => "Size:Medium/Colour:Red/Style:Pretty",
  33    test6 => "/Size:Medium//Colour:Red/",
  34    pp => 5,
  35    p => 2,
  36   );
  37 my $req = BSE::Request::Test->new(cfg => $cfg, params => \%cgi);
  38 my $gen = BSE::Dynamic::Catalog->new($req);
  39 BSE::API->import(qw/bse_make_catalog bse_make_product bse_add_step_child/);
  40
  41 sub dyn_template_test($$$$);
  42
  43 my $parent = bse_make_catalog
  44   (
  45    cfg => $cfg,
  46    title => "test & catalog",
  47    body => "Test catalog for catalog tests",
  48    force_dynamic => 1,
  49   );
  50
  51 ok($parent, "made a catalog");
  52 is($parent->{generator}, "BSE::Generate::Catalog", "check generator");
  53
  54 sleep 1;
  55 my $parent2 = bse_make_catalog
  56   (
  57    cfg => $cfg,
  58    title => "second test catalog",
  59    body => "second test catalog"
  60   );
  61
  62 ok($parent2, "got second catalog");
  63 isnt($parent->{displayOrder}, $parent2->{displayOrder},
  64      "make sure we get unique display orders");
  65
  66 my $parent3 = bse_make_catalog
  67   (
  68    cfg => $cfg,
  69    parentid => $parent->{id},
  70    title => "third test catalog",
  71    body => "third test catalog"
  72   );
  73
  74 # add some products
  75 my @prods;
  76 my %prods;
  77 my $price = 1000;
  78 my %prod_order;
  79 for my $title (qw/prod1 prod2 prod3 prod4 prod5 prod6 prod7 prod8 prod9 prod10/) {
  80   my $prod = bse_make_product
  81     (
  82      cfg => $cfg,
  83      parentid => $parent->{id},
  84      title => $title,
  85      retailPrice => $price,
  86      body => $title,
  87      product_code => $title
  88     );
  89   ok($prod, "make product $title/$prod->{id}");
  90   unshift @prods, $prod;
  91   $prods{$prod->title} = $prod;
  92   $prod_order{$prod->{displayOrder}} = 1;
  93   $price += 500;
  94 }
  95
  96 # give the last an option
  97 my $order = time();
  98 my $opt = BSE::TB::ProductOptions->make
  99   (
 100    product_id => $prods[2]->id,
 101    name => "Test Option",
 102    display_order => $order++,
 103   );
 104 BSE::TB::ProductOptionValues->make
 105   (
 106    product_option_id => $opt->id,
 107    value => "Alpha",
 108    display_order => $order++,
 109   );
 110 BSE::TB::ProductOptionValues->make
 111   (
 112    product_option_id => $opt->id,
 113    value => "Beta",
 114    display_order => $order++,
 115   );
 116
 117 is(scalar keys %prod_order, 10, "make sure display orders unique");
 118
 119 my $prod4 = bse_make_product
 120   (
 121    cfg => $cfg,
 122    parentid => $parent2->{id},
 123    title => "other catalog prod",
 124    retailPrice => $price,
 125    body => "other catalog prod",
 126    product_code => "other catalog prod"
 127   );
 128 ok($prod4, "made prod in other catalog");
 129
 130 my $prod_step_link = bse_add_step_child
 131   (
 132    cfg => $cfg,
 133    parent => $parent,
 134    child => $prod4
 135   );
 136 ok($prod_step_link, "made the product step link");
 137
 138 bse_add_step_child
 139   (
 140    cfg => $cfg,
 141    parent => $parent,
 142    child => $parent2
 143   );
 144
 145 {
 146   my %tags =
 147     (
 148      prod1 => [ "Size: Small", "Colour: Red", "ABC" ],
 149      prod2 => [ "Size: Small", "Colour: Blue" ],
 150      prod3 => [ "Size: Small", "Colour: Green", "ABC" ],
 151      prod4 => [ "Size: Medium", "Colour: Red" ],
 152      prod5 => [ "Size: Medium", "Colour: Blue", "Colour: Purple" ],
 153      prod6 => [ "Size: Medium", "Colour: Green" ],
 154      prod7 => [ "Size: Medium", "Colour: Black" ],
 155      prod8 => [ "Size: Large", "Colour: Red" ],
 156      prod9 => [ "Size: Large", "Colour: Blue" ],
 157      prod10 => [ "Size: Large", "Colour: Green", "XYZ" ],
 158     );
 159   # set some tags
 160   for my $key (sort keys %tags) {
 161     my $error;
 162     ok($prods{$key}->set_tags($tags{$key}, \$error),
 163        "set tags on $key")
 164       or print("# error: $error");
 165
 166     my @set = sort @{$tags{$key}};
 167     my @tags = sort $prods{$key}->tags;
 168     is_deeply(\@set, \@tags, "check tags set for $key");
 169   }
 170
 171   my $error;
 172   $parent->set_tags([ "Brand: Foo", "Class: Network" ], \$error);
 173 }
 174
 175 dyn_template_test "dynallprods", $parent, <<TEMPLATE, <<EXPECTED;
 176 <:iterator begin dynallprods:><:
 177 dynallprod id:><:ifDynAnyProductOptions:> options<:or:><:eif:>
 178 <:iterator end dynallprods:>
 179 TEMPLATE
 180 $prod4->{id}
 181 $prods[0]{id}
 182 $prods[1]{id}
 183 $prods[2]{id} options
 184 $prods[3]{id}
 185 $prods[4]{id}
 186 $prods[5]{id}
 187 $prods[6]{id}
 188 $prods[7]{id}
 189 $prods[8]{id}
 190 $prods[9]{id}
 191
 192 EXPECTED
 193
 194 dyn_template_test "article tags", $parent, <<TEMPLATE, <<EXPECTED;
 195 <:dynarticle tags:>
 196 TEMPLATE
 197 Brand: Foo/Class: Network
 198 EXPECTED
 199
 200 dyn_template_test "dynallprods tag filter", $parent, <<TEMPLATE, <<EXPECTED;
 201 <:iterator begin dynallprods tags: "Size: Small" :><:
 202 dynallprod title:>
 203 <:iterator end dynallprods:>
 204 TEMPLATE
 205 prod3
 206 prod2
 207 prod1
 208
 209 EXPECTED
 210
 211 dyn_template_test "dynallprods tag filter cgi", $parent, <<TEMPLATE, <<EXPECTED;
 212 <:iterator begin dynallprods tags: [lcgi test3] :><:
 213 dynallprod title:>
 214 <:iterator end dynallprods:>
 215 TEMPLATE
 216 prod7
 217 prod6
 218 prod5
 219 prod4
 220
 221 EXPECTED
 222
 223 dyn_template_test "dynallprods tag filter", $parent, <<TEMPLATE, <<EXPECTED;
 224 <:iterator begin dynunused_tagcats dynallprods tags: "Size: Small" :><:
 225 ifDynunused_tagcat nocat:><:or:><:
 226 dynunused_tagcat name:>:
 227 <:eif
 228 :><:iterator begin dynunused_tags:> <:dynunused_tag val:> (<:dynunused_tag count:>)
 229 <:iterator end dynunused_tags:><:iterator end dynunused_tagcats :>
 230 TEMPLATE
 231  ABC (2)
 232 Colour:
 233  Blue (1)
 234  Green (1)
 235  Red (1)
 236
 237 EXPECTED
 238
 239 dyn_template_test "unused tags no highlander", $parent, <<TEMPLATE, <<EXPECTED;
 240 <:iterator begin dynunused_tagcats dynallprods tags: "Colour: Blue" :><:
 241 ifDynunused_tagcat nocat:><:or:><:
 242 dynunused_tagcat name:>:
 243 <:eif
 244 :><:iterator begin dynunused_tags:> <:dynunused_tag val:> (<:dynunused_tag count:>)
 245 <:iterator end dynunused_tags:><:iterator end dynunused_tagcats :>
 246 TEMPLATE
 247 Colour:
 248  Purple (1)
 249 Size:
 250  Large (1)
 251  Medium (1)
 252  Small (1)
 253
 254 EXPECTED
 255
 256 dyn_template_test "unused tags highlander", $parent, <<TEMPLATE, <<EXPECTED;
 257 <:iterator begin dynunused_tagcats dynallprods onlyone tags: "Colour: Blue" :><:
 258 ifDynunused_tagcat nocat:><:or:><:
 259 dynunused_tagcat name:>:
 260 <:eif
 261 :><:iterator begin dynunused_tags:> <:dynunused_tag val:> (<:dynunused_tag count:>)
 262 <:iterator end dynunused_tags:><:iterator end dynunused_tagcats :>
 263 TEMPLATE
 264 Size:
 265  Large (1)
 266  Medium (1)
 267  Small (1)
 268
 269 EXPECTED
 270
 271 dyn_template_test "unused tags unfiltered", $parent, <<TEMPLATE, <<EXPECTED;
 272 <:iterator begin dynunused_tagcats dynallprods tags: "" :><:
 273 ifDynunused_tagcat nocat:><:or:><:
 274 dynunused_tagcat name:>:
 275 <:eif
 276 :><:iterator begin dynunused_tags:> <:dynunused_tag val:> (<:dynunused_tag count:>)
 277 <:iterator end dynunused_tags:><:iterator end dynunused_tagcats :>
 278 TEMPLATE
 279  ABC (2)
 280  XYZ (1)
 281 Colour:
 282  Black (1)
 283  Blue (3)
 284  Green (3)
 285  Purple (1)
 286  Red (3)
 287 Size:
 288  Large (3)
 289  Medium (4)
 290  Small (3)
 291
 292 EXPECTED
 293
 294 dyn_template_test "unused tags cat filtered", $parent, <<TEMPLATE, <<EXPECTED;
 295 <:iterator begin dynunused_tagcats dynallprods category:"Colour" tags: "" :><:
 296 ifDynunused_tagcat nocat:><:or:><:
 297 dynunused_tagcat name:>:
 298 <:eif
 299 :><:iterator begin dynunused_tags:> <:dynunused_tag val:> (<:dynunused_tag count:>)
 300 <:iterator end dynunused_tags:><:iterator end dynunused_tagcats :>
 301 TEMPLATE
 302 Colour:
 303  Black (1)
 304  Blue (3)
 305  Green (3)
 306  Purple (1)
 307  Red (3)
 308
 309 EXPECTED
 310
 311 dyn_template_test "unused tags new style", $parent, <<TEMPLATE, <<EXPECTED;
 312 <:.set ptags = dynarticle.collection_with_tags(
 313   "all_visible_products",
 314   [],
 315   {
 316     "noobjects":1
 317   }
 318   ) -:>
 319 <:# = bse.dumper(ptags) -:>
 320 <:.set ptagcats = bse.categorize_tags(ptags.extratags, [],
 321   {
 322    "onlycat":"Colour",
 323    "counts":ptags.counts
 324   }) -:>
 325 <:.for cat in ptagcats -:>
 326 <:= cat.name:>:
 327 <:.for val in cat.vals -:>
 328 <:= " " _ val.val :> (<:= val.count :>)
 329 <:.end for-:>
 330 <:.end for:>
 331 TEMPLATE
 332 Colour:
 333  Black (1)
 334  Blue (3)
 335  Green (3)
 336  Purple (1)
 337  Red (3)
 338
 339 EXPECTED
 340
 341 dyn_template_test "dyntags", $parent, <<TEMPLATE, <<EXPECTED;
 342 <:iterator begin dyntags "Size:  Small/Colour: Red/XYZ" :><:
 343 dyntag name:>|<:dyntag cat:>|<:dyntag val:>|
 344 <:iterator end dyntags :>
 345 <:iterator begin dyntags [lcgi test5] :><:
 346 dyntag name:>|<:dyntag cat:>|<:dyntag val:>|
 347 <:iterator end dyntags :>
 348 <:iterator begin dyntags [lcgi test6] :><:
 349 dyntag name:>|<:dyntag cat:>|<:dyntag val:>|
 350 <:iterator end dyntags :>
 351 TEMPLATE
 352 Size: Small|Size|Small|
 353 Colour: Red|Colour|Red|
 354 XYZ||XYZ|
 355
 356 Size: Medium|Size|Medium|
 357 Colour: Red|Colour|Red|
 358 Style: Pretty|Style|Pretty|
 359
 360 Size: Medium|Size|Medium|
 361 Colour: Red|Colour|Red|
 362
 363 EXPECTED
 364
 365 dyn_template_test "dynallcats", $parent, <<TEMPLATE, <<EXPECTED;
 366 <:iterator begin dynallcats:><:
 367 dynallcat id:>
 368 <:iterator end dynallcats:>
 369 TEMPLATE
 370 $parent2->{id}
 371 $parent3->{id}
 372
 373 EXPECTED
 374
 375 dyn_template_test "empty dyncart", $parent, <<TEMPLATE, <<EXPECTED;
 376 <:iterator begin dyncart:><:
 377 dyncartitem title:> <:money dyncartitem price:>
 378 <:iterator end dyncart:>
 379 Total: <:money dyncarttotalcost:>
 380 TEMPLATE
 381
 382 Total: 0.00
 383 EXPECTED
 384
 385 # fake an item in the cart
 386 $req->session->{cart} =
 387   [
 388    {
 389     productId => $prods{prod3}{id},
 390     units => 1,
 391     price => scalar $prods{prod3}->price(),
 392     title => scalar $prods{prod3}->title,
 393    }
 394   ];
 395
 396 dyn_template_test "nonempty dyncart", $parent, <<TEMPLATE, <<EXPECTED;
 397 <:iterator begin dyncart:><:
 398 dyncartitem title:> <:money dyncartitem price:>
 399 <:iterator end dyncart:>
 400 Total: <:money dyncarttotalcost:>
 401 TEMPLATE
 402 prod3 20.00
 403
 404 Total: 20.00
 405 EXPECTED
 406
 407 dyn_template_test "cgi", $parent, <<TEMPLATE, <<EXPECTED;
 408 ><:cgi unknown:><
 409 ><:cgi test1:><
 410 ><:cgi test2:><
 411 TEMPLATE
 412 ><
 413 >one<
 414 >two three<
 415 EXPECTED
 416
 417 dyn_template_test "lcgi", $parent, <<TEMPLATE, <<EXPECTED;
 418 ><:lcgi unknown:><
 419 ><:lcgi test1:><
 420 ><:lcgi test2:><
 421 ><:lcgi "," test1:><
 422 ><:lcgi "," test2:><
 423 ><:lcgi ")(" test2:><
 424 TEMPLATE
 425 ><
 426 >one<
 427 >two/three<
 428 >one<
 429 >two,three<
 430 >two)(three<
 431 EXPECTED
 432
 433 dyn_template_test "deltag", $parent, <<TEMPLATE, <<EXPECTED;
 434 ><:deltag "Size: Medium" [lcgi test4]:><
 435 ><:deltag "Size:Medium" [lcgi test4]:><
 436 ><:deltag "Size:Medium/Colour:Red" [lcgi test5]:><
 437 ><:deltag "Size:Medium" [lcgi test5]:><
 438 <:iterator begin dyntags [lcgi test5]
 439 :><:dyntag name:> - <:deltag [dyntag name] [lcgi test5]:>
 440 <:iterator end dyntags:>
 441 TEMPLATE
 442 >Colour: Red<
 443 >Colour: Red<
 444 >Style: Pretty<
 445 >Colour: Red/Style: Pretty<
 446 Size: Medium - Colour: Red/Style: Pretty
 447 Colour: Red - Size: Medium/Style: Pretty
 448 Style: Pretty - Size: Medium/Colour: Red
 449
 450 EXPECTED
 451
 452 dyn_template_test "ifTagIn", $parent, <<TEMPLATE, <<EXPECTED;
 453 <:ifTagIn "Size:medium" [lcgi test5]:>1<:or:>0<:eif:>
 454 <:ifTagIn "Size: Huge" [lcgi test5]:>1<:or:>0<:eif:>
 455 <:ifTagIn "Size: Medium" [lcgi test5]:>1<:or:>0<:eif:>
 456 <:ifTagIn "DEF" [lcgi test5]:>1<:or:>0<:eif:>
 457 TEMPLATE
 458 1
 459 0
 460 1
 461 0
 462 EXPECTED
 463
 464 dyn_template_test "paged default", $parent, <<TEMPLATE, <<EXPECTED;
 465 <:iterator begin dynallprods paged: :><:iterator end dynallprods:>
 466 Current page: <:dynallprods_page:>
 467 Page count: <:dynallprods_pagecount:>
 468 Next page: <:dynallprods_nextpage:>
 469 Previous page: <:dynallprods_prevpage:>
 470 Total count: <:dynallprod_totalcount:>
 471 Count: <:dynallprod_count paged: :>
 472 First number this page: <:dynallprods_firstnumber:>
 473 Last number this page: <:dynallprods_lastnumber:>
 474 Perpage: <:dynallprods_perpage:>
 475 Pages: <:iterator begin dynallprods_pagec
 476 :><:dynallprod_pagec page
 477 :><:ifDynallprod_pagec current:>c<:or:><:eif
 478 :><:ifDynallprod_pagec first:>f<:or:><:eif
 479 :><:ifDynallprod_pagec last:>l<:or:><:eif
 480 :><:ifDynallprod_pagec next:>n<:dynallprod_pagec next:><:or:><:eif
 481 :><:ifDynallprod_pagec prev:>p<:dynallprod_pagec prev:><:or:><:eif:> <:iterator end dynallprods_pagec
 482 :>
 483 <:iterator begin dynallprods paged:
 484 :><:dynallprod_number:> <:dynallprod title:>
 485 <:iterator end dynallprods:>
 486 TEMPLATE
 487
 488 Current page: 2
 489 Page count: 3
 490 Next page: 3
 491 Previous page: 1
 492 Total count: 11
 493 Count: 5
 494 First number this page: 6
 495 Last number this page: 10
 496 Perpage: 5
 497 Pages: 1fn2 2cn3p1 3lp2
 498 6 prod6
 499 7 prod5
 500 8 prod4
 501 9 prod3
 502 10 prod2
 503
 504 EXPECTED
 505
 506 dyn_template_test "template vars", $parent, <<TEMPLATE, <<EXPECTED;
 507 Article Title: [<:= article.title |html :>]
 508 Top Title: [<:= top.title |html :>]
 509 Embedded: [<:= embedded | html :>]
 510 Dynamic: [<:= dynamic | html :>]
 511 TEMPLATE
 512 Article Title: [test &amp; catalog]
 513 Top Title: [test &amp; catalog]
 514 Embedded: [0]
 515 Dynamic: [1]
 516 EXPECTED
 517
 518 dyn_template_test "unknown vars", $parent, <<TEMPLATE, <<EXPECTED;
 519 <:= unknown_var :>
 520 TEMPLATE
 521 * Variable 'unknown_var' not set
 522  *
 523 EXPECTED
 524
 525 $prod4->remove($cfg);
 526 for my $prod (@prods) {
 527   $prod->remove($cfg);
 528 }
 529 $parent3->remove($cfg);
 530 $parent2->remove($cfg);
 531 $parent->remove($cfg);
 532
 533 # produces three test results
 534 sub dyn_template_test($$$$) {
 535   my ($tag, $article, $template, $expected) = @_;
 536
 537   #diag "Template >$template<";
 538   my $gen =
 539     eval {
 540       my $gen_class = $article->{generator};
 541       $gen_class =~ s/.*\W//;
 542       $gen_class = "BSE::Dynamic::".$gen_class;
 543       (my $filename = $gen_class) =~ s!::!/!g;
 544       $filename .= ".pm";
 545       require $filename;
 546       $gen_class->new($req);
 547     };
 548   ok($gen, "$tag: created generator $article->{generator}");
 549   diag $@ unless $gen;
 550
 551   # get the template - always regen it
 552   my $work_template = _generate_dyn_template($article, $template);
 553
 554   my $result;
 555  SKIP: {
 556     skip "$tag: couldn't make generator", 1 unless $gen;
 557     eval {
 558       $result =
 559         $gen->generate($article, $work_template);
 560     };
 561     ok($result, "$tag: generate content");
 562     diag $@ unless $result;
 563   }
 564  SKIP: {
 565      skip "$tag: couldn't gen content", 1 unless $result;
 566      is($result->{content}, $expected, "$tag: comparing");
 567    }
 568 }
 569
 570 sub _generate_dyn_template {
 571   my ($article, $template) = @_;
 572
 573   my $articles = 'BSE::TB::Articles';
 574   my $genname = $article->{generator};
 575   eval "use $genname";
 576   $@ && die $@;
 577   my $gen = $genname->new(articles=>$articles, cfg=>$cfg, top=>$article);
 578
 579   return $gen->generate_low($template, $article, $articles, 0);
 580 }