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