t/table2-tr_ld.t

   1 # This might look like shell script, but it's actually -*- perl -*-
   2 # Test the 3 possible look_down calls to table2()
   3 #   a = default
   4 #   b = supplied array ref
   5 #   c = supplied code ref
   6
   7 use strict;
   8 use lib qw(t/ t/m/);
   9
  10
  11 use File::Slurp;
  12 use Test::More qw(no_plan);
  13
  14 use HTML::TreeBuilder;
  15 use HTML::Element::Library;
  16 use Scalar::Listify;
  17 use Test::XML;
  18
  19 use data::table2;
  20
  21
  22 my $o    = data::table2->new;
  23
  24 # a - default table_ld
  25
  26 my $root = 't/html/table2';
  27 my $tree = HTML::TreeBuilder->new_from_file("$root.html");
  28
  29
  30 my @tr = HTML::Element::Library::ref_or_ld(
  31   $tree,
  32   ['_tag' => 'tr']
  33  );
  34
  35 is (scalar @tr, 16, 'default ld_tr');
  36
  37 # b - arrayref tr_ld
  38
  39 $root = 't/html/table2-tr_ld-arrayref';
  40 $tree = HTML::TreeBuilder->new_from_file("$root.html");
  41
  42
  43 my $tr = HTML::Element::Library::ref_or_ld(
  44   $tree,
  45   [class => 'findMe']
  46  );
  47
  48 is_xml ($tr->as_XML, scalar File::Slurp::read_file("$root.exp"), $root);
  49
  50 # c - coderef tr_ld
  51 # removes windows listings before returning @tr
  52
  53 $root = 't/html/table2';
  54 $tree = HTML::TreeBuilder->new_from_file("$root.html");
  55
  56
  57 @tr = HTML::Element::Library::ref_or_ld(
  58   $tree,
  59   sub {
  60     my ($t) = @_;
  61     my @tr = $t->look_down('_tag' => 'tr');
  62     my @keep;
  63     for my $tr (@tr) {
  64
  65       my @td = $tr->look_down ('_tag' => 'td') ;
  66       my $detached;
  67       for my $td (@td) {
  68         if (grep { $_ =~ /Windows/ } $td->content_list) {
  69           $tr->detach();
  70           ++$detached;
  71           last;
  72         }
  73       }
  74       push @keep, $tr unless $detached;
  75     }
  76     @keep;
  77   }
  78  );
  79
  80 #warn $_->as_HTML, $/ for @tr;
  81
  82 is_xml ($tree->as_XML, scalar File::Slurp::read_file("$root-tr_ld-coderef.exp"), $root);