Subversion Repositories DevTools

Rev

Rev 4386 | Show entire file | Ignore whitespace | Details | Blame | Last modification | View Log | RSS feed

Rev 4386 Rev 5542
Line 11... Line 11...
11
package Pod::Html;
11
package Pod::Html;
12
use strict;
12
use strict;
13
require Exporter;
13
require Exporter;
14
 
14
 
15
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
15
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
16
$VERSION = "1.0801";
16
$VERSION = 1.0901;
17
@ISA = qw(Exporter);
17
@ISA = qw(Exporter);
18
@EXPORT = qw(pod2html htmlify);
18
@EXPORT = qw(pod2html htmlify);
19
@EXPORT_OK = qw(anchorify);
19
@EXPORT_OK = qw(anchorify);
20
 
20
 
21
use Carp;
21
use Carp;
Line 254... Line 254...
254
my $HiddenDirs;
254
my $HiddenDirs;
255
my $Verbose;
255
my $Verbose;
256
my $Doindex;
256
my $Doindex;
257
 
257
 
258
my $Backlink;
258
my $Backlink;
259
my($Listlevel, @Listend);
259
my($Listlevel, @Listtype);
260
my $After_Lpar;
260
my $ListNewTerm;
261
use vars qw($Ignore);  # need to localize it later.
261
use vars qw($Ignore);  # need to localize it later.
262
 
262
 
263
my(%Items_Named, @Items_Seen);
263
my(%Items_Named, @Items_Seen);
264
my($Title, $Header);
264
my($Title, $Header);
265
 
265
 
Line 314... Line 314...
314
    $Quiet = 0;                 # not quiet by default
314
    $Quiet = 0;                 # not quiet by default
315
    $Verbose = 0;               # not verbose by default
315
    $Verbose = 0;               # not verbose by default
316
    $Doindex = 1;               # non-zero if we should generate an index
316
    $Doindex = 1;               # non-zero if we should generate an index
317
    $Backlink = '';             # text for "back to top" links
317
    $Backlink = '';             # text for "back to top" links
318
    $Listlevel = 0;             # current list depth
318
    $Listlevel = 0;             # current list depth
319
    @Listend = ();              # the text to use to end the list.
319
    @Listtype = ();     # list types for open lists
320
    $After_Lpar = 0;            # set to true after a par in an =item
320
    $ListNewTerm = 0;       # indicates new term in definition list; used
-
 
321
                    # to correctly open/close <dd> tags
321
    $Ignore = 1;                # whether or not to format text.  we don't
322
    $Ignore = 1;                # whether or not to format text.  we don't
322
                                #   format text until we hit our first pod
323
                                #   format text until we hit our first pod
323
                                #   directive.
324
                                #   directive.
324
 
325
 
325
    @Items_Seen = ();           # for multiples of the same item in perlfunc
326
    @Items_Seen = ();           # for multiples of the same item in perlfunc
Line 535... Line 536...
535
 
536
 
536
END_OF_INDEX
537
END_OF_INDEX
537
 
538
 
538
    # now convert this file
539
    # now convert this file
539
    my $after_item;             # set to true after an =item
540
    my $after_item;             # set to true after an =item
540
    my $need_dd = 0;
-
 
541
    warn "Converting input file $Podfile\n" if $Verbose;
541
    warn "Converting input file $Podfile\n" if $Verbose;
542
    foreach my $i (0..$#poddata){
542
    foreach my $i (0..$#poddata){
543
        $_ = $poddata[$i];
543
        $_ = $poddata[$i];
544
        $Paragraph = $i+1;
544
        $Paragraph = $i+1;
545
        if (/^(=.*)/s) {        # is it a pod directive?
545
        if (/^(=.*)/s) {        # is it a pod directive?
546
            $Ignore = 0;
546
            $Ignore = 0;
547
            $after_item = 0;
547
            $after_item = 0;
548
            $need_dd = 0;
-
 
549
            $_ = $1;
548
            $_ = $1;
550
            if (/^=begin\s+(\S+)\s*(.*)/si) {   # =begin
549
            if (/^=begin\s+(\S+)\s*(.*)/si) {   # =begin
551
                process_begin($1, $2);
550
                process_begin($1, $2);
552
            } elsif (/^=end\s+(\S+)\s*(.*)/si) {# =end
551
            } elsif (/^=end\s+(\S+)\s*(.*)/si) {# =end
553
                process_end($1, $2);
552
                process_end($1, $2);
Line 559... Line 558...
559
                next if @Begin_Stack && $Begin_Stack[-1] ne 'html';
558
                next if @Begin_Stack && $Begin_Stack[-1] ne 'html';
560
 
559
 
561
                if (/^=(head[1-6])\s+(.*\S)/s) {        # =head[1-6] heading
560
                if (/^=(head[1-6])\s+(.*\S)/s) {        # =head[1-6] heading
562
                    process_head( $1, $2, $Doindex && $index );
561
                    process_head( $1, $2, $Doindex && $index );
563
                } elsif (/^=item\s*(.*\S)?/sm) {        # =item text
562
                } elsif (/^=item\s*(.*\S)?/sm) {        # =item text
564
                    $need_dd = process_item( $1 );
563
            process_item( $1 );
565
                    $after_item = 1;
564
                    $after_item = 1;
566
                } elsif (/^=over\s*(.*)/) {             # =over N
565
                } elsif (/^=over\s*(.*)/) {             # =over N
567
                    process_over();
566
                    process_over();
568
                } elsif (/^=back/) {                    # =back
567
                } elsif (/^=back/) {                    # =back
569
                    process_back($need_dd);
568
            process_back();
570
                } elsif (/^=for\s+(\S+)\s*(.*)/si) {    # =for
569
                } elsif (/^=for\s+(\S+)\s*(.*)/si) {    # =for
571
                    process_for($1,$2);
570
                    process_for($1,$2);
572
                } else {
571
                } else {
573
                    /^=(\S*)\s*/;
572
                    /^=(\S*)\s*/;
574
                    warn "$0: $Podfile: unknown pod directive '$1' in "
573
                    warn "$0: $Podfile: unknown pod directive '$1' in "
Line 579... Line 578...
579
        }
578
        }
580
        else {
579
        else {
581
            next if $Ignore;
580
            next if $Ignore;
582
            next if @Begin_Stack && $Begin_Stack[-1] ne 'html';
581
            next if @Begin_Stack && $Begin_Stack[-1] ne 'html';
583
            print HTML and next if @Begin_Stack && $Begin_Stack[-1] eq 'html';
582
            print HTML and next if @Begin_Stack && $Begin_Stack[-1] eq 'html';
584
            print HTML "<dd>\n" if $need_dd;
-
 
585
            my $text = $_;
583
            my $text = $_;
-
 
584
 
-
 
585
        # Open tag for definition list as we have something to put in it
-
 
586
        if( $ListNewTerm ){
-
 
587
        print HTML "<dd>\n";
-
 
588
        $ListNewTerm = 0;
-
 
589
        }
-
 
590
 
586
            if( $text =~ /\A\s+/ ){
591
        if( $text =~ /\A\s+/ ){
587
                process_pre( \$text );
592
        process_pre( \$text );
588
                print HTML "<pre>\n$text</pre>\n";
593
            print HTML "<pre>\n$text</pre>\n";
589
 
594
 
590
            } else {
595
            } else {
591
                process_text( \$text );
596
                process_text( \$text );
592
 
597
 
593
                # experimental: check for a paragraph where all lines
598
                # experimental: check for a paragraph where all lines
Line 610... Line 615...
610
                        }
615
                        }
611
                    }
616
                    }
612
                }
617
                }
613
                ## end of experimental
618
                ## end of experimental
614
 
619
 
615
                if( $after_item ){
-
 
616
                    $After_Lpar = 1;
-
 
617
                }
-
 
618
 
-
 
619
        if ( $set_p_class )
620
        if ( $set_p_class )
620
        {
621
        {
621
                print HTML "<p class=\"$set_p_class\">$text</p>\n";
622
                print HTML "<p class=\"$set_p_class\">$text</p>\n";
622
            $set_p_class = 0;
623
            $set_p_class = 0;
623
        }
624
        }
624
        else
625
        else
625
        {
626
        {
626
                    print HTML "<p>$text</p>\n";
627
                    print HTML "<p>$text</p>\n";
627
        }
628
        }
628
            }
629
            }
629
            print HTML "</dd>\n" if $need_dd;
-
 
630
            $after_item = 0;
630
            $after_item = 0;
631
        }
631
        }
632
    }
632
    }
633
 
633
 
634
    # finish off any pending directives
634
    # finish off any pending directives
Line 1177... Line 1177...
1177
    foreach $i (0..$#poddata) {
1177
    foreach $i (0..$#poddata) {
1178
        my $txt = depod( $poddata[$i] );
1178
        my $txt = depod( $poddata[$i] );
1179
        $txt =~ s~^\n~~;
1179
        $txt =~ s~^\n~~;
1180
        # figure out what kind of item it is.
1180
        # figure out what kind of item it is.
1181
        # Build string for referencing this item.
1181
        # Build string for referencing this item.
1182
        if ( $txt =~ /\A=item\s+\*\s*(.*)\Z/s ) { # bullet
1182
    if ( $txt =~ /\A=item\s+\*\s*(.*)\Z/s ) { # bulleted list
1183
            next unless $1;
1183
            next unless $1;
1184
            $item = $1;
1184
            $item = $1;
1185
        } elsif( $txt =~ /\A=item\s+(?>\d+\.?)\s*(.*)\Z/s ) { # numbered list
1185
        } elsif( $txt =~ /\A=item\s+(?>\d+\.?)\s*(.*)\Z/s ) { # numbered list
1186
            $item = $1;
1186
            $item = $1;
1187
        } elsif( $txt =~ /\A=item\s+(.*)\Z/s ) { # plain item
1187
    } elsif( $txt =~ /\A=item\s+(.*)\Z/s ) { # definition list
1188
            $item = $1;
1188
            $item = $1;
1189
        } elsif( $txt =~ /\A=head[234]\s+(.*)\Z/s ) { # plain item
1189
        } elsif( $txt =~ /\A=head[234]\s+(.*)\Z/s ) { # plain item
1190
            $item = $1;
1190
            $item = $1;
1191
        } else {
1191
        } else {
1192
            next;
1192
            next;
Line 1224... Line 1224...
1224
 
1224
 
1225
    # figure out the level of the =head
1225
    # figure out the level of the =head
1226
    $tag =~ /head([1-6])/;
1226
    $tag =~ /head([1-6])/;
1227
    my $level = $1;
1227
    my $level = $1;
1228
 
1228
 
1229
    if( $Listlevel ){
1229
    
1230
        warn "$0: $Podfile: unterminated list at =head in paragraph $Paragraph.  ignoring.\n" unless $Quiet;
-
 
1231
        while( $Listlevel ){
-
 
1232
            process_back();
1230
        finish_list();
1233
        }
-
 
1234
    }
-
 
1235
 
1231
 
1236
    print HTML "<p>\n";
1232
    print HTML "<p>\n";
1237
    if( $level == 1 && ! $Top ){
1233
    if( $level == 1 && ! $Top ){
1238
      print HTML "<a href=\"#__index__\"><small>$Backlink</small></a>\n"
1234
      print HTML "<a href=\"#__index__\"><small>$Backlink</small></a>\n"
1239
        if $hasindex and $Backlink;
1235
        if $hasindex and $Backlink;
Line 1272... Line 1268...
1272
    }
1268
    }
1273
    print HTML "</strong>\n";
1269
    print HTML "</strong>\n";
1274
    undef( $EmittedItem );
1270
    undef( $EmittedItem );
1275
}
1271
}
1276
 
1272
 
1277
sub emit_li {
1273
sub new_listitem {
1278
    my( $tag ) = @_;
1274
    my( $tag ) = @_;
-
 
1275
    # Open tag for definition list as we have something to put in it
-
 
1276
    if( ($tag ne 'dl') && ($ListNewTerm) ){
-
 
1277
    print HTML "<dd>\n";
-
 
1278
    $ListNewTerm = 0;
-
 
1279
    }
-
 
1280
 
1279
    if( $Items_Seen[$Listlevel]++ == 0 ){
1281
    if( $Items_Seen[$Listlevel]++ == 0 ){
-
 
1282
    # start of new list
1280
        push( @Listend, "</$tag>" );
1283
    push( @Listtype, "$tag" );
-
 
1284
    print HTML "<$tag>\n";
-
 
1285
    } else {
-
 
1286
    # if this is not the first item, close the previous one
-
 
1287
    if ( $tag eq 'dl' ){
-
 
1288
        print HTML "</dd>\n" unless $ListNewTerm;
-
 
1289
    } else {
1281
        print HTML "<$tag>\n";
1290
        print HTML "</li>\n";
1282
    }
1291
    }
-
 
1292
    }
1283
    my $emitted = $tag eq 'dl' ? 'dt' : 'li';
1293
    my $opentag = $tag eq 'dl' ? 'dt' : 'li';
1284
    print HTML "<$emitted>";
1294
    print HTML "<$opentag>";
1285
    return $emitted;
-
 
1286
}
1295
}
1287
 
1296
 
1288
#
1297
#
1289
# process_item - convert a pod item tag and convert it to HTML format.
1298
# process_item - convert a pod item tag and convert it to HTML format.
1290
#
1299
#
1291
sub process_item {
1300
sub process_item {
1292
    my( $otext ) = @_;
1301
    my( $otext ) = @_;
1293
    my $need_dd = 0; # set to 1 if we need a <dd></dd> after an item
-
 
1294
 
1302
 
1295
    # lots of documents start a list without doing an =over.  this is
1303
    # lots of documents start a list without doing an =over.  this is
1296
    # bad!  but, the proper thing to do seems to be to just assume
1304
    # bad!  but, the proper thing to do seems to be to just assume
1297
    # they did do an =over.  so warn them once and then continue.
1305
    # they did do an =over.  so warn them once and then continue.
1298
    if( $Listlevel == 0 ){
1306
    if( $Listlevel == 0 ){
1299
        warn "$0: $Podfile: unexpected =item directive in paragraph $Paragraph.  ignoring.\n" unless $Quiet;
1307
        warn "$0: $Podfile: unexpected =item directive in paragraph $Paragraph.  ignoring.\n" unless $Quiet;
1300
        process_over();
1308
        process_over();
1301
    }
1309
    }
1302
 
1310
 
1303
    # formatting: insert a paragraph if preceding item has >1 paragraph
-
 
1304
    if( $After_Lpar ){
-
 
1305
        print HTML $need_dd ? "</dd>\n" : "</li>\n" if $After_Lpar;
-
 
1306
        $After_Lpar = 0;
-
 
1307
    }
-
 
1308
 
-
 
1309
    # remove formatting instructions from the text
1311
    # remove formatting instructions from the text
1310
    my $text = depod( $otext );
1312
    my $text = depod( $otext );
1311
 
1313
 
1312
    my $emitted; # the tag actually emitted, used for closing
-
 
1313
 
-
 
1314
    # all the list variants:
1314
    # all the list variants:
1315
    if( $text =~ /\A\*/ ){ # bullet
1315
    if( $text =~ /\A\*/ ){ # bullet
1316
        $emitted = emit_li( 'ul' );
1316
        new_listitem( 'ul' );
1317
        if ($text =~ /\A\*\s+(\S.*)\Z/s ) { # with additional text
1317
        if ($text =~ /\A\*\s+(\S.*)\Z/s ) { # with additional text
1318
            my $tag = $1;
1318
            my $tag = $1;
1319
            $otext =~ s/\A\*\s+//;
1319
            $otext =~ s/\A\*\s+//;
1320
            emit_item_tag( $otext, $tag, 1 );
1320
            emit_item_tag( $otext, $tag, 1 );
-
 
1321
            print HTML "\n";
1321
        }
1322
        }
1322
 
1323
 
1323
    } elsif( $text =~ /\A\d+/ ){ # numbered list
1324
    } elsif( $text =~ /\A\d+/ ){ # numbered list
1324
        $emitted = emit_li( 'ol' );
1325
        new_listitem( 'ol' );
1325
        if ($text =~ /\A(?>\d+\.?)\s*(\S.*)\Z/s ) { # with additional text
1326
        if ($text =~ /\A(?>\d+\.?)\s*(\S.*)\Z/s ) { # with additional text
1326
            my $tag = $1;
1327
            my $tag = $1;
1327
            $otext =~ s/\A\d+\.?\s*//;
1328
            $otext =~ s/\A\d+\.?\s*//;
1328
            emit_item_tag( $otext, $tag, 1 );
1329
            emit_item_tag( $otext, $tag, 1 );
-
 
1330
            print HTML "\n";
1329
        }
1331
        }
1330
 
1332
 
1331
    } else {                    # definition list
1333
    } else {            # definition list
-
 
1334
        # new_listitem takes care of opening the <dt> tag
1332
        $emitted = emit_li( 'dl' );
1335
        new_listitem( 'dl' );
1333
        if ($text =~ /\A(.+)\Z/s ){ # should have text
1336
        if ($text =~ /\A(.+)\Z/s ){ # should have text
1334
            emit_item_tag( $otext, $text, 1 );
1337
            emit_item_tag( $otext, $text, 1 );
-
 
1338
        # write the definition term and close <dt> tag
-
 
1339
        print HTML "</dt>\n";
1335
        }
1340
        }
-
 
1341
        # trigger opening a <dd> tag for the actual definition; will not
-
 
1342
        # happen if next paragraph is also a definition term (=item)
1336
        $need_dd = 1;
1343
        $ListNewTerm = 1;
1337
    }
1344
    }
1338
    print HTML "\n";
1345
    print HTML "\n";
1339
    return $need_dd;
-
 
1340
}
1346
}
1341
 
1347
 
1342
#
1348
#
1343
# process_over - process a pod over tag and start a corresponding HTML list.
1349
# process_over - process a pod over tag and start a corresponding HTML list.
1344
#
1350
#
1345
sub process_over {
1351
sub process_over {
1346
    # start a new list
1352
    # start a new list
1347
    $Listlevel++;
1353
    $Listlevel++;
1348
    push( @Items_Seen, 0 );
1354
    push( @Items_Seen, 0 );
1349
    $After_Lpar = 0;
-
 
1350
}
1355
}
1351
 
1356
 
1352
#
1357
#
1353
# process_back - process a pod back tag and convert it to HTML format.
1358
# process_back - process a pod back tag and convert it to HTML format.
1354
#
1359
#
1355
sub process_back {
1360
sub process_back {
1356
    my $need_dd = shift;
-
 
1357
    if( $Listlevel == 0 ){
1361
    if( $Listlevel == 0 ){
1358
        warn "$0: $Podfile: unexpected =back directive in paragraph $Paragraph.  ignoring.\n" unless $Quiet;
1362
    warn "$0: $Podfile: unexpected =back directive in paragraph $Paragraph.  ignoring.\n" unless $Quiet;
1359
        return;
1363
    return;
1360
    }
1364
    }
1361
 
1365
 
1362
    # close off the list.  note, I check to see if $Listend[$Listlevel] is
1366
    # close off the list.  note, I check to see if $Listtype[$Listlevel] is
1363
    # defined because an =item directive may have never appeared and thus
1367
    # defined because an =item directive may have never appeared and thus
1364
    # $Listend[$Listlevel] may have never been initialized.
1368
    # $Listtype[$Listlevel] may have never been initialized.
1365
    $Listlevel--;
1369
    $Listlevel--;
1366
    if( defined $Listend[$Listlevel] ){
1370
    if( defined $Listtype[$Listlevel] ){
1367
        print HTML $need_dd ? "</dd>\n" : "</li>\n" if $After_Lpar;
1371
        if ( $Listtype[$Listlevel] eq 'dl' ){
1368
        print HTML $Listend[$Listlevel];
1372
            print HTML "</dd>\n" unless $ListNewTerm;
-
 
1373
        } else {
1369
        print HTML "\n";
1374
            print HTML "</li>\n";
-
 
1375
        }
-
 
1376
        print HTML "</$Listtype[$Listlevel]>\n";
1370
        pop( @Listend );
1377
        pop( @Listtype );
-
 
1378
        $ListNewTerm = 0;
1371
    }
1379
    }
1372
    $After_Lpar = 0;
-
 
1373
 
1380
 
1374
    # clean up item count
1381
    # clean up item count
1375
    pop( @Items_Seen );
1382
    pop( @Items_Seen );
1376
}
1383
}
1377
 
1384
 
Line 2184... Line 2191...
2184
#
2191
#
2185
# finish_list - finish off any pending HTML lists.  this should be called
2192
# finish_list - finish off any pending HTML lists.  this should be called
2186
# after the entire pod file has been read and converted.
2193
# after the entire pod file has been read and converted.
2187
#
2194
#
2188
sub finish_list {
2195
sub finish_list {
-
 
2196
    if( $Listlevel ){
-
 
2197
    warn "$0: $Podfile: unterminated list(s) at =head in paragraph $Paragraph.  ignoring.\n" unless $Quiet;
2189
    while ($Listlevel > 0) {
2198
    while( $Listlevel ){
2190
        print HTML "</dl>\n";
2199
            process_back();
2191
        $Listlevel--;
2200
        }
2192
    }
2201
    }
2193
}
2202
}
2194
 
2203
 
2195
#
2204
#
2196
# htmlify - converts a pod section specification to a suitable section
2205
# htmlify - converts a pod section specification to a suitable section