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