cpan/Pod-Simple/t/puller.t

   1 use strict;
   2 use warnings;
   3 use Test::More tests => 135;
   4
   5 #use Pod::Simple::Debug (5);
   6
   7 #sub Pod::Simple::MANY_LINES () {1}
   8 #sub Pod::Simple::PullParser::DEBUG () {1}
   9
  10
  11 use Pod::Simple::PullParser;
  12
  13 sub pump_it_up {
  14   my $p = Pod::Simple::PullParser->new;
  15   $p->set_source( \( $_[0] ) );
  16   my(@t, $t);
  17   while($t = $p->get_token) { push @t, $t }
  18   print "# Count of tokens: ", scalar(@t), "\n";
  19   print "#  I.e., {", join("\n#       + ",
  20     map ref($_) . ": " . $_->dump, @t), "} \n";
  21   return @t;
  22 }
  23
  24 my @t;
  25
  26 #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  27
  28 @t = pump_it_up(qq{\n\nProk\n\n=head1 Things\n\n=cut\n\nBzorch\n\n});
  29
  30 if(not(
  31   is scalar( grep { ref $_ and $_->can('type') } @t), 5
  32 )) {
  33   fail "Wrong token count. Failing subsequent tests.\n";
  34   for ( 2 .. 12 ) {fail}
  35 } else {
  36   is $t[0]->type, 'start';
  37   is $t[1]->type, 'start';
  38   is $t[2]->type, 'text';
  39   is $t[3]->type, 'end';
  40   is $t[4]->type, 'end';
  41
  42   is $t[0]->tagname, 'Document';
  43   is $t[1]->tagname, 'head1';
  44   is $t[2]->text,    'Things';
  45   is $t[3]->tagname, 'head1';
  46   is $t[4]->tagname, 'Document';
  47
  48   is $t[0]->attr('start_line'), '5';
  49   is $t[1]->attr('start_line'), '5';
  50 }
  51
  52
  53
  54 #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  55 @t = pump_it_up(
  56     qq{Woowoo\n\n=over\n\n=item *\n\nStuff L<HTML::TokeParser>\n\n}
  57   . qq{=item *\n\nThings I<like that>\n\n=back\n\n=cut\n\n}
  58 );
  59
  60 if(
  61   not( is scalar( grep { ref $_ and $_->can('type') } @t) => 16 )
  62 ) {
  63   fail "Wrong token count. Failing subsequent tests.\n";
  64   for ( 1 .. 32 ) {ok 0}
  65 } else {
  66   is $t[ 0]->type, 'start';
  67   is $t[ 1]->type, 'start';
  68   is $t[ 2]->type, 'start';
  69   is $t[ 3]->type, 'text';
  70   is $t[ 4]->type, 'start';
  71   is $t[ 5]->type, 'text';
  72   is $t[ 6]->type, 'end';
  73   is $t[ 7]->type, 'end';
  74
  75   is $t[ 8]->type, 'start';
  76   is $t[ 9]->type, 'text';
  77   is $t[10]->type, 'start';
  78   is $t[11]->type, 'text';
  79   is $t[12]->type, 'end';
  80   is $t[13]->type, 'end';
  81   is $t[14]->type, 'end';
  82   is $t[15]->type, 'end';
  83
  84
  85
  86   is $t[ 0]->tagname, 'Document';
  87   is $t[ 1]->tagname, 'over-bullet';
  88   is $t[ 2]->tagname, 'item-bullet';
  89   is $t[ 3]->text, 'Stuff ';
  90   is $t[ 4]->tagname, 'L';
  91   is $t[ 5]->text, 'HTML::TokeParser';
  92   is $t[ 6]->tagname, 'L';
  93   is $t[ 7]->tagname, 'item-bullet';
  94
  95   is $t[ 8]->tagname, 'item-bullet';
  96   is $t[ 9]->text, 'Things ';
  97   is $t[10]->tagname, 'I';
  98   is $t[11]->text, 'like that';
  99   is $t[12]->tagname, 'I';
 100   is $t[13]->tagname, 'item-bullet';
 101   is $t[14]->tagname, 'over-bullet';
 102   is $t[15]->tagname, 'Document';
 103
 104   is $t[4]->attr("type"), "pod";
 105 }
 106
 107
 108 #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 109 {
 110 print "# Testing unget_token\n";
 111
 112 my $p = Pod::Simple::PullParser->new;
 113 $p->set_source( \qq{\nBzorch\n\n=pod\n\nLala\n\n\=cut\n} );
 114
 115 ok 1;
 116 my $t;
 117 $t = $p->get_token;
 118 is $t && $t->type, 'start';
 119 is $t && $t->tagname, 'Document';
 120 print "# ungetting ($t).\n";
 121 $p->unget_token($t);
 122 ok 1;
 123
 124 $t = $p->get_token;
 125 is $t && $t->type, 'start';
 126 is $t && $t->tagname, 'Document';
 127 my @to_save = ($t);
 128
 129 $t = $p->get_token;
 130 is $t && $t->type, 'start';
 131 is $t && $t->tagname, 'Para';
 132 push @to_save, $t;
 133
 134 print "# ungetting (@to_save).\n";
 135 $p->unget_token(@to_save);
 136 splice @to_save;
 137
 138
 139 $t = $p->get_token;
 140 is $t && $t->type, 'start';
 141 is $t && $t->tagname, 'Document';
 142
 143 $t = $p->get_token;
 144 is $t && $t->type, 'start';
 145 is $t && $t->tagname, 'Para';
 146
 147 ok 1;
 148
 149 }
 150
 151
 152 #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 153
 154 {
 155 print "# Testing pullparsing from an arrayref\n";
 156 my $p = Pod::Simple::PullParser->new;
 157 ok 1;
 158 $p->set_source( ['','Bzorch', '','=pod', '', 'Lala', 'zaza', '', '=cut'] );
 159 ok 1;
 160 my( @t, $t );
 161 while($t = $p->get_token) {
 162   print "# Got a token: ", $t->dump, "\n#\n";
 163   push @t, $t;
 164 }
 165 is scalar(@t), 5; # count of tokens
 166 is $t[0]->type, 'start';
 167 is $t[1]->type, 'start';
 168 is $t[2]->type, 'text';
 169 is $t[3]->type, 'end';
 170 is $t[4]->type, 'end';
 171
 172 is $t[0]->tagname, 'Document';
 173 is $t[1]->tagname, 'Para';
 174 is $t[2]->text,    'Lala zaza';
 175 is $t[3]->tagname, 'Para';
 176 is $t[4]->tagname, 'Document';
 177
 178 }
 179
 180 #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 181
 182 {
 183 print "# Testing pullparsing from an arrayref with terminal newlines\n";
 184 my $p = Pod::Simple::PullParser->new;
 185 ok 1;
 186 $p->set_source( [ map "$_\n",
 187   '','Bzorch', '','=pod', '', 'Lala', 'zaza', '', '=cut'] );
 188 ok 1;
 189 my( @t, $t );
 190 while($t = $p->get_token) {
 191   print "# Got a token: ", $t->dump, "\n#\n";
 192   push @t, $t;
 193 }
 194 is scalar(@t), 5; # count of tokens
 195 is $t[0]->type, 'start';
 196 is $t[1]->type, 'start';
 197 is $t[2]->type, 'text';
 198 is $t[3]->type, 'end';
 199 is $t[4]->type, 'end';
 200
 201 is $t[0]->tagname, 'Document';
 202 is $t[1]->tagname, 'Para';
 203 is $t[2]->text,    'Lala zaza';
 204 is $t[3]->tagname, 'Para';
 205 is $t[4]->tagname, 'Document';
 206
 207 }
 208
 209 #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 210 our $temp_pod = "temp_$$.pod";
 211 END { unlink "$temp_pod" }
 212 {
 213 print "# Testing pullparsing from a file\n";
 214 my $p = Pod::Simple::PullParser->new;
 215 ok 1;
 216 open(OUT, ">$temp_pod") || die "Can't write-open $temp_pod: $!";
 217 print OUT
 218  map "$_\n",
 219   '','Bzorch', '','=pod', '', 'Lala', 'zaza', '', '=cut'
 220 ;
 221 close(OUT);
 222 ok 1;
 223 sleep 1;
 224
 225 $p->set_source("$temp_pod");
 226
 227 my( @t, $t );
 228 while($t = $p->get_token) {
 229   print "# Got a token: ", $t->dump, "\n#\n";
 230   push @t, $t;
 231   print "#  That's token number ", scalar(@t), "\n";
 232 }
 233 is scalar(@t), 5; # count of tokens
 234 is $t[0]->type, 'start';
 235 is $t[1]->type, 'start';
 236 is $t[2]->type, 'text';
 237 is $t[3]->type, 'end';
 238 is $t[4]->type, 'end';
 239
 240 is $t[0]->tagname, 'Document';
 241 is $t[1]->tagname, 'Para';
 242 is $t[2]->text,    'Lala zaza';
 243 is $t[3]->tagname, 'Para';
 244 is $t[4]->tagname, 'Document';
 245
 246 }
 247
 248 # ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
 249
 250 {
 251 print "# Testing pullparsing from a glob\n";
 252 my $p = Pod::Simple::PullParser->new;
 253 ok 1;
 254 open(IN, "<$temp_pod") || die "Can't read-open $temp_pod: $!";
 255 $p->set_source(*IN);
 256
 257 my( @t, $t );
 258 while($t = $p->get_token) {
 259   print "# Got a token: ", $t->dump, "\n#\n";
 260   push @t, $t;
 261   print "#  That's token number ", scalar(@t), "\n";
 262 }
 263 is scalar(@t), 5; # count of tokens
 264 is $t[0]->type, 'start';
 265 is $t[1]->type, 'start';
 266 is $t[2]->type, 'text';
 267 is $t[3]->type, 'end';
 268 is $t[4]->type, 'end';
 269
 270 is $t[0]->tagname, 'Document';
 271 is $t[1]->tagname, 'Para';
 272 is $t[2]->text,    'Lala zaza';
 273 is $t[3]->tagname, 'Para';
 274 is $t[4]->tagname, 'Document';
 275 close(IN);
 276
 277 }
 278
 279 # ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
 280
 281 {
 282 print "# Testing pullparsing from a globref\n";
 283 my $p = Pod::Simple::PullParser->new;
 284 ok 1;
 285 open(IN, "<$temp_pod") || die "Can't read-open $temp_pod: $!";
 286 $p->set_source(\*IN);
 287
 288 my( @t, $t );
 289 while($t = $p->get_token) {
 290   print "# Got a token: ", $t->dump, "\n#\n";
 291   push @t, $t;
 292   print "#  That's token number ", scalar(@t), "\n";
 293 }
 294 is scalar(@t), 5; # count of tokens
 295 is $t[0]->type, 'start';
 296 is $t[1]->type, 'start';
 297 is $t[2]->type, 'text';
 298 is $t[3]->type, 'end';
 299 is $t[4]->type, 'end';
 300
 301 is $t[0]->tagname, 'Document';
 302 is $t[1]->tagname, 'Para';
 303 is $t[2]->text,    'Lala zaza';
 304 is $t[3]->tagname, 'Para';
 305 is $t[4]->tagname, 'Document';
 306 close(IN);
 307
 308 }
 309
 310 # ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
 311
 312 {
 313 print "# Testing pullparsing from a filehandle\n";
 314 my $p = Pod::Simple::PullParser->new;
 315 ok 1;
 316 open(IN, "<$temp_pod") || die "Can't read-open $temp_pod: $!";
 317 $p->set_source(*IN{IO});
 318
 319 my( @t, $t );
 320 while($t = $p->get_token) {
 321   print "# Got a token: ", $t->dump, "\n#\n";
 322   push @t, $t;
 323   print "#  That's token number ", scalar(@t), "\n";
 324 }
 325 is scalar(@t), 5; # count of tokens
 326 is $t[0]->type, 'start';
 327 is $t[1]->type, 'start';
 328 is $t[2]->type, 'text';
 329 is $t[3]->type, 'end';
 330 is $t[4]->type, 'end';
 331
 332 is $t[0]->tagname, 'Document';
 333 is $t[1]->tagname, 'Para';
 334 is $t[2]->text,    'Lala zaza';
 335 is $t[3]->tagname, 'Para';
 336 is $t[4]->tagname, 'Document';
 337 close(IN);
 338
 339 }