| Filename | /home/doy/perl5/perlbrew/perls/perl-5.10.1/lib/site_perl/5.10.1/HTML/Stream.pm |
| Statements | Executed 50 statements in 9.17ms |
| Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
|---|---|---|---|---|---|
| 1 | 1 | 1 | 65µs | 284µs | HTML::Stream::BEGIN@421 |
| 1 | 1 | 1 | 62µs | 127µs | HTML::Stream::FileHandle::BEGIN@1388 |
| 1 | 1 | 1 | 57µs | 76µs | HTML::Stream::FileHandle::BEGIN@1387 |
| 1 | 1 | 1 | 40µs | 56µs | HTML::Stream::Latin1::BEGIN@1434 |
| 1 | 1 | 1 | 39µs | 125µs | HTML::Stream::BEGIN@422 |
| 1 | 1 | 1 | 38µs | 487µs | HTML::Stream::BEGIN@424 |
| 1 | 1 | 1 | 37µs | 54µs | HTML::Stream::BEGIN@423 |
| 1 | 1 | 1 | 36µs | 158µs | HTML::Stream::Latin1::BEGIN@1435 |
| 0 | 0 | 0 | 0s | 0s | HTML::Stream::AUTOLOAD |
| 0 | 0 | 0 | 0s | 0s | HTML::Stream::DESTROY |
| 0 | 0 | 0 | 0s | 0s | HTML::Stream::FileHandle::new |
| 0 | 0 | 0 | 0s | 0s | HTML::Stream::FileHandle::print |
| 0 | 0 | 0 | 0s | 0s | HTML::Stream::Latin1::new |
| 0 | 0 | 0 | 0s | 0s | HTML::Stream::accept_tag |
| 0 | 0 | 0 | 0s | 0s | HTML::Stream::auto_escape |
| 0 | 0 | 0 | 0s | 0s | HTML::Stream::auto_format |
| 0 | 0 | 0 | 0s | 0s | HTML::Stream::autoescape |
| 0 | 0 | 0 | 0s | 0s | HTML::Stream::build_tag |
| 0 | 0 | 0 | 0s | 0s | HTML::Stream::comment |
| 0 | 0 | 0 | 0s | 0s | HTML::Stream::ent |
| 0 | 0 | 0 | 0s | 0s | HTML::Stream::escape_all |
| 0 | 0 | 0 | 0s | 0s | HTML::Stream::escape_latin_1 |
| 0 | 0 | 0 | 0s | 0s | HTML::Stream::escape_non_ent |
| 0 | 0 | 0 | 0s | 0s | HTML::Stream::escape_none |
| 0 | 0 | 0 | 0s | 0s | HTML::Stream::html_escape |
| 0 | 0 | 0 | 0s | 0s | HTML::Stream::html_tag |
| 0 | 0 | 0 | 0s | 0s | HTML::Stream::html_unescape |
| 0 | 0 | 0 | 0s | 0s | HTML::Stream::html_unmarkup |
| 0 | 0 | 0 | 0s | 0s | HTML::Stream::io |
| 0 | 0 | 0 | 0s | 0s | HTML::Stream::new |
| 0 | 0 | 0 | 0s | 0s | HTML::Stream::nl |
| 0 | 0 | 0 | 0s | 0s | HTML::Stream::output |
| 0 | 0 | 0 | 0s | 0s | HTML::Stream::private_tags |
| 0 | 0 | 0 | 0s | 0s | HTML::Stream::set_tag |
| 0 | 0 | 0 | 0s | 0s | HTML::Stream::tag |
| 0 | 0 | 0 | 0s | 0s | HTML::Stream::tags |
| 0 | 0 | 0 | 0s | 0s | HTML::Stream::text |
| 0 | 0 | 0 | 0s | 0s | HTML::Stream::text_nbsp |
| Line | State ments |
Time on line |
Calls | Time in subs |
Code |
|---|---|---|---|---|---|
| 1 | package HTML::Stream; | ||||
| 2 | |||||
| 3 | =head1 NAME | ||||
| 4 | |||||
| - - | |||||
| 421 | 3 | 120µs | 2 | 504µs | # spent 284µs (65+220) within HTML::Stream::BEGIN@421 which was called:
# once (65µs+220µs) by Markdent::Role::HTMLStream::BEGIN@9 at line 421 # spent 284µs making 1 call to HTML::Stream::BEGIN@421
# spent 220µs making 1 call to Exporter::import |
| 422 | 3 | 94µs | 2 | 211µs | # spent 125µs (39+86) within HTML::Stream::BEGIN@422 which was called:
# once (39µs+86µs) by Markdent::Role::HTMLStream::BEGIN@9 at line 422 # spent 125µs making 1 call to HTML::Stream::BEGIN@422
# spent 86µs making 1 call to Exporter::import |
| 423 | 3 | 108µs | 2 | 70µs | # spent 54µs (37+16) within HTML::Stream::BEGIN@423 which was called:
# once (37µs+16µs) by Markdent::Role::HTMLStream::BEGIN@9 at line 423 # spent 54µs making 1 call to HTML::Stream::BEGIN@423
# spent 16µs making 1 call to strict::import |
| 424 | 3 | 7.36ms | 2 | 935µs | # spent 487µs (38+449) within HTML::Stream::BEGIN@424 which was called:
# once (38µs+449µs) by Markdent::Role::HTMLStream::BEGIN@9 at line 424 # spent 487µs making 1 call to HTML::Stream::BEGIN@424
# spent 448µs making 1 call to vars::import |
| 425 | |||||
| 426 | # Exporting... | ||||
| 427 | 1 | 32µs | @ISA = qw(Exporter); | ||
| 428 | 1 | 10µs | %EXPORT_TAGS = ( | ||
| 429 | 'funcs' => [qw(html_escape html_unescape html_unmarkup html_tag)] | ||||
| 430 | ); | ||||
| 431 | 1 | 14µs | 1 | 7.63ms | Exporter::export_ok_tags('funcs'); # spent 7.63ms making 1 call to Exporter::export_ok_tags |
| 432 | |||||
| 433 | # The package version, both in 1.23 style *and* usable by MakeMaker: | ||||
| 434 | 1 | 6µs | $VERSION = substr q$Revision: 1.60$, 10; | ||
| 435 | |||||
| - - | |||||
| 438 | #------------------------------ | ||||
| 439 | # | ||||
| 440 | # GLOBALS | ||||
| 441 | # | ||||
| 442 | #------------------------------ | ||||
| 443 | |||||
| 444 | # Allow dashes to become slashes? | ||||
| 445 | 1 | 2µs | $DASH_TO_SLASH = 1; | ||
| 446 | |||||
| 447 | # HTML escape sequences. This bit was stolen from html_escape() in CGI::Base. | ||||
| 448 | 1 | 11µs | my %Escape = ( | ||
| 449 | '&' => 'amp', | ||||
| 450 | '>' => 'gt', | ||||
| 451 | '<' => 'lt', | ||||
| 452 | '"' => 'quot', | ||||
| 453 | ); | ||||
| 454 | 1 | 2µs | my %Unescape; | ||
| 455 | 3 | 43µs | {my ($k, $v); $Unescape{$v} = $k while (($k, $v) = each %Escape);} | ||
| 456 | |||||
| 457 | # Flags for streams: | ||||
| 458 | 1 | 2µs | my $F_NEWLINE = 0x01; # is autonewlining allowed? | ||
| 459 | |||||
| - - | |||||
| 462 | #------------------------------ | ||||
| 463 | # | ||||
| 464 | # PRIVATE UTILITIES | ||||
| 465 | # | ||||
| 466 | #------------------------------ | ||||
| 467 | |||||
| 468 | #------------------------------ | ||||
| 469 | # escape_all TEXT | ||||
| 470 | # | ||||
| 471 | # Given a TEXT string, turn the text into valid HTML by interpolating the | ||||
| 472 | # appropriate escape sequences for all troublesome characters | ||||
| 473 | # (angles, double-quotes, ampersands, and 8-bit characters). | ||||
| 474 | # | ||||
| 475 | # Uses the decimal-value syntax for 8-bit characters). | ||||
| 476 | |||||
| 477 | sub escape_all { | ||||
| 478 | my $text = shift; | ||||
| 479 | $text =~ s/([<>"&])/\&$Escape{$1};/mg; | ||||
| 480 | $text =~ s/([\x80-\xFF])/'&#'.unpack('C',$1).';'/eg; | ||||
| 481 | $text; | ||||
| 482 | } | ||||
| 483 | |||||
| 484 | #------------------------------ | ||||
| 485 | # escape_latin_1 TEXT | ||||
| 486 | # | ||||
| 487 | # Given a TEXT string, turn the text into valid HTML by interpolating the | ||||
| 488 | # appropriate escape sequences for all troublesome characters | ||||
| 489 | # (angles, double-quotes, ampersands, and 8-bit characters). | ||||
| 490 | # | ||||
| 491 | # Uses the Latin-1 entities for 8-bit characters. | ||||
| 492 | |||||
| 493 | sub escape_latin_1 { | ||||
| 494 | my $text = shift; | ||||
| 495 | HTML::Entities::encode($text); # can't use $_[0]! encode is destructive! | ||||
| 496 | $text; | ||||
| 497 | } | ||||
| 498 | |||||
| 499 | #------------------------------ | ||||
| 500 | # escape_non_ent TEXT | ||||
| 501 | # | ||||
| 502 | # Given a TEXT string, turn the text into valid HTML by interpolating the | ||||
| 503 | # appropriate escape sequences for angles, double-quotes, and 8-bit | ||||
| 504 | # characters only (i.e., ampersands are left alone). | ||||
| 505 | |||||
| 506 | sub escape_non_ent { | ||||
| 507 | my $text = shift; | ||||
| 508 | $text =~ s/([<>"])/\&$Escape{$1};/mg; | ||||
| 509 | $text =~ s/([\x80-\xFF])/'&#'.unpack('C',$1).';'/eg; | ||||
| 510 | $text; | ||||
| 511 | } | ||||
| 512 | |||||
| 513 | #------------------------------ | ||||
| 514 | # escape_none TEXT | ||||
| 515 | # | ||||
| 516 | # No-op, provided for very simple compatibility. Just returns TEXT. | ||||
| 517 | |||||
| 518 | sub escape_none { | ||||
| 519 | $_[0]; | ||||
| 520 | } | ||||
| 521 | |||||
| 522 | #------------------------------ | ||||
| 523 | # build_tag ESCAPEFUNC, \@TAGINFO | ||||
| 524 | # | ||||
| 525 | # I<Internal use only!> Build an HTML tag using the given ESCAPEFUNC. | ||||
| 526 | # As an efficiency hack, only the values are HTML-escaped currently: | ||||
| 527 | # it is assumed that the tag and parameters will already be safe. | ||||
| 528 | |||||
| 529 | sub build_tag { | ||||
| 530 | my $esc = shift; # escape function | ||||
| 531 | my $taginfo = shift; # tag info | ||||
| 532 | |||||
| 533 | # Start off, converting "_x" to "/x": | ||||
| 534 | my $tag = shift @$taginfo; | ||||
| 535 | $tag =~ s|^_|/|; | ||||
| 536 | my $s = '<' . $tag; | ||||
| 537 | |||||
| 538 | # Add parameters, if any: | ||||
| 539 | while (@$taginfo) { | ||||
| 540 | my $k = shift @$taginfo; | ||||
| 541 | my $v = shift @$taginfo; | ||||
| 542 | $s .= " $k"; | ||||
| 543 | defined($v) and ((($s .= '="') .= &$esc($v)) .= '"'); | ||||
| 544 | } | ||||
| 545 | $s .= '>'; | ||||
| 546 | } | ||||
| 547 | |||||
| 548 | |||||
| 549 | #------------------------------ | ||||
| 550 | |||||
| - - | |||||
| 553 | =head2 Functions | ||||
| 554 | |||||
| - - | |||||
| 559 | #------------------------------ | ||||
| 560 | |||||
| 561 | |||||
| 562 | #------------------------------ | ||||
| 563 | |||||
| 564 | =item html_escape TEXT | ||||
| 565 | |||||
| - - | |||||
| 577 | sub html_escape { | ||||
| 578 | my $text = shift; | ||||
| 579 | $text =~ s/([<>"&])/\&$Escape{$1};/mg; | ||||
| 580 | $text =~ s/([\x80-\xFF])/'&#'.unpack('C',$1).';'/eg; | ||||
| 581 | $text; | ||||
| 582 | } | ||||
| 583 | |||||
| 584 | #------------------------------ | ||||
| 585 | |||||
| 586 | =item html_tag TAG [, PARAM=>VALUE, ...] | ||||
| 587 | |||||
| - - | |||||
| 597 | sub html_tag { | ||||
| 598 | build_tag(\&html_escape, \@_); # warning! using ref to @_! | ||||
| 599 | } | ||||
| 600 | |||||
| 601 | #------------------------------ | ||||
| 602 | |||||
| 603 | =item html_unescape TEXT | ||||
| 604 | |||||
| - - | |||||
| 615 | sub html_unescape { | ||||
| 616 | my ($text) = @_; | ||||
| 617 | |||||
| 618 | # Remove <tag> sequences. KLUDGE! I'll code a better way later. | ||||
| 619 | $text =~ s/\<[^>]+\>//g; | ||||
| 620 | $text =~ s/\&([a-z]+);/($Unescape{$1}||'')/gie; | ||||
| 621 | $text =~ s/\&\#(\d+);/pack("C",$1)/gie; | ||||
| 622 | return $text; | ||||
| 623 | } | ||||
| 624 | |||||
| 625 | #------------------------------ | ||||
| 626 | |||||
| 627 | =item html_unmarkup TEXT | ||||
| 628 | |||||
| - - | |||||
| 636 | sub html_unmarkup { | ||||
| 637 | my ($text) = @_; | ||||
| 638 | |||||
| 639 | # Remove <tag> sequences. KLUDGE! I'll code a better way later. | ||||
| 640 | $text =~ s/\<[^>]+\>//g; | ||||
| 641 | return $text; | ||||
| 642 | } | ||||
| 643 | |||||
| - - | |||||
| 646 | #------------------------------ | ||||
| 647 | |||||
| 648 | =back | ||||
| 649 | |||||
| - - | |||||
| 656 | #------------------------------ | ||||
| 657 | |||||
| 658 | # Special mapping from names to utility functions (more stable than symtable): | ||||
| 659 | 1 | 13µs | my %AutoEscapeSubs = | ||
| 660 | ('ALL' => \&HTML::Stream::escape_all, | ||||
| 661 | 'LATIN_1' => \&HTML::Stream::escape_latin_1, | ||||
| 662 | 'NON_ENT' => \&HTML::Stream::escape_non_ent, | ||||
| 663 | ); | ||||
| 664 | |||||
| 665 | |||||
| 666 | #------------------------------ | ||||
| 667 | |||||
| 668 | =item new [PRINTABLE] | ||||
| 669 | |||||
| - - | |||||
| 679 | sub new { | ||||
| 680 | my $class = shift; | ||||
| 681 | my $out = shift || select; # defaults to current output stream | ||||
| 682 | |||||
| 683 | # If it looks like an unblessed filehandle, bless it: | ||||
| 684 | if (!ref($out) || ref($out) eq 'GLOB') { | ||||
| 685 | $out = new HTML::Stream::FileHandle $out; | ||||
| 686 | } | ||||
| 687 | |||||
| 688 | # Create the object: | ||||
| 689 | my $self = { | ||||
| 690 | OUT => $out, | ||||
| 691 | Esc => \&escape_all, | ||||
| 692 | Tags => \%Tags, # reference to the master table | ||||
| 693 | Flags => $F_NEWLINE, # autonewline | ||||
| 694 | }; | ||||
| 695 | bless $self, $class; | ||||
| 696 | } | ||||
| 697 | |||||
| 698 | #------------------------------ | ||||
| 699 | # DESTROY | ||||
| 700 | # | ||||
| 701 | # Destructor. Does I<not> close the filehandle! | ||||
| 702 | |||||
| 703 | sub DESTROY { 1 } | ||||
| 704 | |||||
| 705 | #------------------------------ | ||||
| 706 | # autoescape - DEPRECATED as of 1.31 due to bad name choice | ||||
| 707 | # | ||||
| 708 | sub autoescape { | ||||
| 709 | my $self = shift; | ||||
| 710 | warn "HTML::Stream's autoescape() method is deprecated.\n", | ||||
| 711 | "Please use the identical (and more nicely named) auto_escape().\n"; | ||||
| 712 | $self->auto_escape(@_); | ||||
| 713 | } | ||||
| 714 | |||||
| 715 | #------------------------------ | ||||
| 716 | |||||
| 717 | =item auto_escape [NAME|SUBREF] | ||||
| 718 | |||||
| - - | |||||
| 774 | sub auto_escape { | ||||
| 775 | my $self = shift; | ||||
| 776 | |||||
| 777 | # Grab existing value: | ||||
| 778 | my $oldesc = $self->{Esc}; | ||||
| 779 | |||||
| 780 | # If arguments were given, they specify the new value: | ||||
| 781 | if (@_) { | ||||
| 782 | my $newesc = shift; | ||||
| 783 | if (ref($newesc) ne 'CODE') { # must be a string: map it to a subref | ||||
| 784 | require HTML::Entities if ($newesc eq 'LATIN_1'); | ||||
| 785 | $newesc = $AutoEscapeSubs{uc($newesc)} or | ||||
| 786 | croak "never heard of auto-escape option '$newesc'"; | ||||
| 787 | } | ||||
| 788 | $self->{Esc} = $newesc; | ||||
| 789 | } | ||||
| 790 | |||||
| 791 | # Return old value: | ||||
| 792 | $oldesc; | ||||
| 793 | } | ||||
| 794 | |||||
| 795 | #------------------------------ | ||||
| 796 | |||||
| 797 | =item auto_format ONOFF | ||||
| 798 | |||||
| - - | |||||
| 809 | sub auto_format { | ||||
| 810 | my ($self, $onoff) = @_; | ||||
| 811 | ($self->{Flags} &= (~1 << 0)) |= ($onoff << 0); | ||||
| 812 | $self; | ||||
| 813 | } | ||||
| 814 | |||||
| 815 | #------------------------------ | ||||
| 816 | |||||
| 817 | =item comment COMMENT | ||||
| 818 | |||||
| - - | |||||
| 825 | sub comment { | ||||
| 826 | my $self = shift; | ||||
| 827 | $self->{OUT}->print('<!-- ', &{$self->{Esc}}(join('',@_)), " -->\n"); | ||||
| 828 | $self; | ||||
| 829 | } | ||||
| 830 | |||||
| 831 | #------------------------------ | ||||
| 832 | |||||
| 833 | =item ent ENTITY | ||||
| 834 | |||||
| - - | |||||
| 849 | sub ent { | ||||
| 850 | my ($self, $entity) = @_; | ||||
| 851 | $self->{OUT}->print("\&$entity;"); | ||||
| 852 | $self; | ||||
| 853 | } | ||||
| 854 | 1 | 6µs | *e = \&ent; | ||
| 855 | |||||
| 856 | |||||
| 857 | #------------------------------ | ||||
| 858 | |||||
| 859 | =item io | ||||
| 860 | |||||
| - - | |||||
| 869 | sub io { | ||||
| 870 | shift->{OUT}; | ||||
| 871 | } | ||||
| 872 | |||||
| 873 | |||||
| 874 | #------------------------------ | ||||
| 875 | |||||
| 876 | =item nl [COUNT] | ||||
| 877 | |||||
| - - | |||||
| 883 | sub nl { | ||||
| 884 | my ($self, $count) = @_; | ||||
| 885 | $self->{OUT}->print("\n" x (defined($count) ? $count : 1)); | ||||
| 886 | $self; | ||||
| 887 | } | ||||
| 888 | |||||
| 889 | #------------------------------ | ||||
| 890 | |||||
| 891 | =item tag TAGNAME [, PARAM=>VALUE, ...] | ||||
| 892 | |||||
| - - | |||||
| 899 | sub tag { | ||||
| 900 | my $self = shift; | ||||
| 901 | $self->{OUT}->print(build_tag($self->{Esc}, \@_)); | ||||
| 902 | $self; | ||||
| 903 | } | ||||
| 904 | |||||
| 905 | #------------------------------ | ||||
| 906 | |||||
| 907 | =item text TEXT... | ||||
| 908 | |||||
| - - | |||||
| 918 | sub text { | ||||
| 919 | my $self = shift; | ||||
| 920 | $self->{OUT}->print(&{$self->{Esc}}(join('',@_))); | ||||
| 921 | $self; | ||||
| 922 | } | ||||
| 923 | 1 | 4µs | *t = \&text; | ||
| 924 | |||||
| 925 | #------------------------------ | ||||
| 926 | |||||
| 927 | =item text_nbsp TEXT... | ||||
| 928 | |||||
| - - | |||||
| 940 | sub text_nbsp { | ||||
| 941 | my $self = shift; | ||||
| 942 | my $txt = &{$self->{Esc}}(join('',@_)); | ||||
| 943 | $txt =~ s/ / /g; | ||||
| 944 | $self->{OUT}->print($txt); | ||||
| 945 | $self; | ||||
| 946 | } | ||||
| 947 | 1 | 4µs | *nbsp_text = \&text_nbsp; # deprecated, but supplied for John :-) | ||
| 948 | |||||
| 949 | |||||
| 950 | #------------------------------ | ||||
| 951 | |||||
| 952 | =back | ||||
| 953 | |||||
| - - | |||||
| 960 | #------------------------------ | ||||
| 961 | |||||
| 962 | #------------------------------ | ||||
| 963 | |||||
| 964 | =item output ITEM,...,ITEM | ||||
| 965 | |||||
| - - | |||||
| 975 | sub output { | ||||
| 976 | my $self = shift; | ||||
| 977 | my $out = $self->{OUT}; | ||||
| 978 | my $esc = $self->{Esc}; | ||||
| 979 | foreach (@_) { | ||||
| 980 | if (ref($_) eq 'ARRAY') { # E.g., $_ is [A, HREF=>$url] | ||||
| 981 | $out->print(&build_tag($esc, $_)); | ||||
| 982 | } | ||||
| 983 | elsif (!ref($_)) { # E.g., $_ is "Some text" | ||||
| 984 | $out->print(&$esc($_)); | ||||
| 985 | } | ||||
| 986 | else { | ||||
| 987 | confess "bad argument to output: $_"; | ||||
| 988 | } | ||||
| 989 | } | ||||
| 990 | $self; # heh... why not... | ||||
| 991 | } | ||||
| 992 | |||||
| 993 | |||||
| 994 | #------------------------------ | ||||
| 995 | |||||
| 996 | =back | ||||
| 997 | |||||
| - - | |||||
| 1004 | #------------------------------ | ||||
| 1005 | |||||
| 1006 | #------------------------------ | ||||
| 1007 | # %Tags | ||||
| 1008 | #------------------------------ | ||||
| 1009 | # The default known HTML tags. The value if each is CURRENTLY a set of flags: | ||||
| 1010 | # | ||||
| 1011 | # 0x01 newline before <TAG> | ||||
| 1012 | # 0x02 newline after <TAG> | ||||
| 1013 | # 0x04 newline before </TAG> | ||||
| 1014 | # 0x08 newline after </TAG> | ||||
| 1015 | # | ||||
| 1016 | # This can be summarized as: | ||||
| 1017 | |||||
| 1018 | 1 | 3µs | my $TP = 1 | 0 | 0 | 0; | ||
| 1019 | 1 | 2µs | my $TBR = 0 | 2 | 0 | 0; | ||
| 1020 | 1 | 2µs | my $TFONT = 0 | 0 | 0 | 0; # fontlike | ||
| 1021 | 1 | 2µs | my $TOUTER = 1 | 0 | 0 | 8; | ||
| 1022 | 1 | 2µs | my $TBOTH = 0 | 2 | 0 | 8; | ||
| 1023 | 1 | 2µs | my $TLIST = 0 | 2 | 0 | 8; | ||
| 1024 | 1 | 2µs | my $TELEM = 0 | 0 | 0 | 8; | ||
| 1025 | 1 | 2µs | my $TTITLE = 0 | 0 | 0 | 8; | ||
| 1026 | 1 | 2µs | my $TSOLO = 0 | 2 | 0 | 0; | ||
| 1027 | |||||
| 1028 | 1 | 261µs | %Tags = | ||
| 1029 | ( | ||||
| 1030 | A => 0, | ||||
| 1031 | ABBR => 0, | ||||
| 1032 | ACRONYM => 0, | ||||
| 1033 | ADDRESS => $TBOTH, | ||||
| 1034 | APPLET => $TBOTH, | ||||
| 1035 | AREA => $TELEM, | ||||
| 1036 | B => 0, | ||||
| 1037 | BASE => 0, | ||||
| 1038 | BASEFONT => $TBOTH, | ||||
| 1039 | BDO => $TBOTH, | ||||
| 1040 | BIG => 0, | ||||
| 1041 | BGSOUND => $TELEM, | ||||
| 1042 | BLINK => 0, | ||||
| 1043 | BLOCKQUOTE => $TBOTH, | ||||
| 1044 | BODY => $TBOTH, | ||||
| 1045 | BUTTON => $TP, | ||||
| 1046 | BR => $TBR, | ||||
| 1047 | CAPTION => $TTITLE, | ||||
| 1048 | CENTER => $TBOTH, | ||||
| 1049 | CITE => 0, | ||||
| 1050 | CODE => 0, | ||||
| 1051 | COMMENT => $TBOTH, | ||||
| 1052 | COLGROUP => $TP, | ||||
| 1053 | COL => $TP, | ||||
| 1054 | DEL => 0, | ||||
| 1055 | DFN => 0, | ||||
| 1056 | DD => $TLIST, | ||||
| 1057 | DIR => $TLIST, | ||||
| 1058 | DIV => $TP, | ||||
| 1059 | DL => $TELEM, | ||||
| 1060 | DT => $TELEM, | ||||
| 1061 | EM => 0, | ||||
| 1062 | EMBED => $TBOTH, | ||||
| 1063 | FONT => 0, | ||||
| 1064 | FORM => $TBOTH, | ||||
| 1065 | FIELDSET => $TBOTH, | ||||
| 1066 | FRAME => $TBOTH, | ||||
| 1067 | FRAMESET => $TBOTH, | ||||
| 1068 | H1 => $TTITLE, | ||||
| 1069 | H2 => $TTITLE, | ||||
| 1070 | H3 => $TTITLE, | ||||
| 1071 | H4 => $TTITLE, | ||||
| 1072 | H5 => $TTITLE, | ||||
| 1073 | H6 => $TTITLE, | ||||
| 1074 | HEAD => $TBOTH, | ||||
| 1075 | HR => $TBOTH, | ||||
| 1076 | HTML => $TBOTH, | ||||
| 1077 | I => 0, | ||||
| 1078 | IFRAME => $TBOTH, | ||||
| 1079 | IMG => 0, | ||||
| 1080 | INPUT => 0, | ||||
| 1081 | INS => 0, | ||||
| 1082 | ISINDEX => 0, | ||||
| 1083 | KEYGEN => $TBOTH, | ||||
| 1084 | KBD => 0, | ||||
| 1085 | LABEL => $TP, | ||||
| 1086 | LEGEND => $TP, | ||||
| 1087 | LI => $TELEM, | ||||
| 1088 | LINK => 0, | ||||
| 1089 | LISTING => $TBOTH, | ||||
| 1090 | MAP => $TBOTH, | ||||
| 1091 | MARQUEE => $TTITLE, | ||||
| 1092 | MENU => $TLIST, | ||||
| 1093 | META => $TSOLO, | ||||
| 1094 | NEXTID => $TBOTH, | ||||
| 1095 | NOBR => $TFONT, | ||||
| 1096 | NOEMBED => $TBOTH, | ||||
| 1097 | NOFRAME => $TBOTH, | ||||
| 1098 | NOFRAMES => $TBOTH, | ||||
| 1099 | NOSCRIPT => $TBOTH, | ||||
| 1100 | OBJECT => 0, | ||||
| 1101 | OL => $TLIST, | ||||
| 1102 | OPTION => $TELEM, | ||||
| 1103 | OPTGROUP => $TELEM, | ||||
| 1104 | P => $TP, | ||||
| 1105 | PARAM => $TP, | ||||
| 1106 | PLAINTEXT => $TBOTH, | ||||
| 1107 | PRE => $TOUTER, | ||||
| 1108 | Q => 0, | ||||
| 1109 | SAMP => 0, | ||||
| 1110 | SCRIPT => $TBOTH, | ||||
| 1111 | SELECT => $TBOTH, | ||||
| 1112 | SERVER => $TBOTH, | ||||
| 1113 | SMALL => 0, | ||||
| 1114 | SPAN => 0, | ||||
| 1115 | STRONG => 0, | ||||
| 1116 | STRIKE => 0, | ||||
| 1117 | STYLE => 0, | ||||
| 1118 | SUB => 0, | ||||
| 1119 | SUP => 0, | ||||
| 1120 | TABLE => $TBOTH, | ||||
| 1121 | TBODY => $TP, | ||||
| 1122 | TD => 0, | ||||
| 1123 | TEXTAREA => 0, | ||||
| 1124 | TFOOT => $TP, | ||||
| 1125 | TH => 0, | ||||
| 1126 | THEAD => $TP, | ||||
| 1127 | TITLE => $TTITLE, | ||||
| 1128 | TR => $TOUTER, | ||||
| 1129 | TT => 0, | ||||
| 1130 | U => 0, | ||||
| 1131 | UL => $TLIST, | ||||
| 1132 | VAR => 0, | ||||
| 1133 | WBR => 0, | ||||
| 1134 | XMP => 0, | ||||
| 1135 | ); | ||||
| 1136 | |||||
| 1137 | |||||
| 1138 | #------------------------------ | ||||
| 1139 | |||||
| 1140 | =item accept_tag TAG | ||||
| 1141 | |||||
| - - | |||||
| 1164 | sub accept_tag { | ||||
| 1165 | my ($self, $tag) = @_; | ||||
| 1166 | my $class = (ref($self) ? ref($self) : $self); # force it, for now | ||||
| 1167 | $class->set_tag($tag); | ||||
| 1168 | } | ||||
| 1169 | |||||
| 1170 | |||||
| 1171 | #------------------------------ | ||||
| 1172 | |||||
| 1173 | =item private_tags | ||||
| 1174 | |||||
| - - | |||||
| 1201 | sub private_tags { | ||||
| 1202 | my $self = shift; | ||||
| 1203 | my %newtags = %Tags; | ||||
| 1204 | $self->{Tags} = \%newtags; | ||||
| 1205 | $self; | ||||
| 1206 | } | ||||
| 1207 | |||||
| 1208 | #------------------------------ | ||||
| 1209 | |||||
| 1210 | =item set_tag TAG, [TAGINFO...] | ||||
| 1211 | |||||
| - - | |||||
| 1280 | sub set_tag { | ||||
| 1281 | my ($self, $tag, %params) = @_; | ||||
| 1282 | $tag = uc($tag); # it's GOT to be uppercase!!! | ||||
| 1283 | |||||
| 1284 | # Force it to BE in the MASTER tag table, regardless: | ||||
| 1285 | defined($Tags{$tag}) or $Tags{$tag} = 0; # default value | ||||
| 1286 | |||||
| 1287 | # Determine what table we ALTER, and force membership in that table: | ||||
| 1288 | my $tags = (ref($self) ? $self->{Tags} : \%Tags); | ||||
| 1289 | defined($tags->{$tag}) or $tags->{$tag} = 0; # default value | ||||
| 1290 | |||||
| 1291 | # Now, set selected characteristics in that table: | ||||
| 1292 | if (defined($params{Newlines})) { | ||||
| 1293 | $tags->{$tag} = ($params{Newlines} || 0); | ||||
| 1294 | } | ||||
| 1295 | $self; | ||||
| 1296 | } | ||||
| 1297 | |||||
| 1298 | #------------------------------ | ||||
| 1299 | |||||
| 1300 | =item tags | ||||
| 1301 | |||||
| - - | |||||
| 1308 | sub tags { | ||||
| 1309 | my $self = shift; | ||||
| 1310 | return (keys %{ref($self) ? $self->{Tags} : \%Tags}); | ||||
| 1311 | } | ||||
| 1312 | |||||
| 1313 | |||||
| 1314 | #------------------------------ | ||||
| 1315 | # AUTOLOAD | ||||
| 1316 | # | ||||
| 1317 | # The custom autoloader, for the chocolate interface. | ||||
| 1318 | # | ||||
| 1319 | # B<WARNING:> I have no idea if the mechanism I use to put the | ||||
| 1320 | # functions in this module (HTML::Stream) is perlitically correct. | ||||
| 1321 | |||||
| 1322 | sub AUTOLOAD { | ||||
| 1323 | my $funcname = $AUTOLOAD; | ||||
| 1324 | $funcname =~ s/.*:://; # get rid of package name | ||||
| 1325 | my $tag; | ||||
| 1326 | ($tag = $funcname) =~ s/^_//; # get rid of leading "_" | ||||
| 1327 | |||||
| 1328 | # If it's a tag method that's been approved in the master table... | ||||
| 1329 | if (defined($Tags{$tag})) { | ||||
| 1330 | |||||
| 1331 | # A begin-tag, like "IMG"... | ||||
| 1332 | if ($funcname !~ /^_/) { | ||||
| 1333 | eval <<EOF; | ||||
| 1334 | sub HTML::Stream::$funcname { | ||||
| 1335 | my \$self = shift; | ||||
| 1336 | \$self->{OUT}->print("\n") if (\$self->{Tags}{'$tag'} & 1 and | ||||
| 1337 | \$self->{Flags} & $F_NEWLINE); | ||||
| 1338 | \$self->{OUT}->print(html_tag('$tag',\@_)); | ||||
| 1339 | \$self->{OUT}->print("\n") if (\$self->{Tags}{'$tag'} & 2 and | ||||
| 1340 | \$self->{Flags} & $F_NEWLINE); | ||||
| 1341 | \$self; | ||||
| 1342 | } | ||||
| 1343 | EOF | ||||
| 1344 | } | ||||
| 1345 | # An end-tag, like "_IMG"... | ||||
| 1346 | else { | ||||
| 1347 | eval <<EOF; | ||||
| 1348 | sub HTML::Stream::$funcname { | ||||
| 1349 | my \$self = shift; | ||||
| 1350 | \$self->{OUT}->print("\n") if (\$self->{Tags}{'$tag'} & 4 and | ||||
| 1351 | \$self->{Flags} & $F_NEWLINE); | ||||
| 1352 | \$self->{OUT}->print("</$tag>"); | ||||
| 1353 | \$self->{OUT}->print("\n") if (\$self->{Tags}{'$tag'} & 8 and | ||||
| 1354 | \$self->{Flags} & $F_NEWLINE); | ||||
| 1355 | \$self; | ||||
| 1356 | } | ||||
| 1357 | EOF | ||||
| 1358 | } | ||||
| 1359 | if ($@) { $@ =~ s/ at .*\n//; croak $@ } # die! | ||||
| 1360 | my $fn = "HTML::Stream::$funcname"; # KLUDGE: is this right??? | ||||
| 1361 | goto &$fn; | ||||
| 1362 | } | ||||
| 1363 | |||||
| 1364 | # If it's NOT a tag method... | ||||
| 1365 | else { | ||||
| 1366 | # probably should call the *real* autoloader in the future... | ||||
| 1367 | croak "Sorry: $AUTOLOAD is neither defined or loadable"; | ||||
| 1368 | } | ||||
| 1369 | goto &$AUTOLOAD; | ||||
| 1370 | } | ||||
| 1371 | |||||
| 1372 | |||||
| 1373 | =back | ||||
| 1374 | |||||
| - - | |||||
| 1380 | # = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = | ||||
| 1381 | # = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = | ||||
| 1382 | |||||
| 1383 | # A small, private package for turning FileHandles into safe printables: | ||||
| 1384 | |||||
| 1385 | package HTML::Stream::FileHandle; | ||||
| 1386 | |||||
| 1387 | 3 | 105µs | 2 | 96µs | # spent 76µs (57+20) within HTML::Stream::FileHandle::BEGIN@1387 which was called:
# once (57µs+20µs) by Markdent::Role::HTMLStream::BEGIN@9 at line 1387 # spent 76µs making 1 call to HTML::Stream::FileHandle::BEGIN@1387
# spent 20µs making 1 call to strict::import |
| 1388 | 3 | 387µs | 2 | 193µs | # spent 127µs (62+65) within HTML::Stream::FileHandle::BEGIN@1388 which was called:
# once (62µs+65µs) by Markdent::Role::HTMLStream::BEGIN@9 at line 1388 # spent 127µs making 1 call to HTML::Stream::FileHandle::BEGIN@1388
# spent 66µs making 1 call to strict::unimport |
| 1389 | |||||
| 1390 | sub new { | ||||
| 1391 | my ($class, $raw) = @_; | ||||
| 1392 | bless \$raw, $class; | ||||
| 1393 | } | ||||
| 1394 | sub print { | ||||
| 1395 | my $self = shift; | ||||
| 1396 | print { $$self } @_; | ||||
| 1397 | } | ||||
| 1398 | |||||
| 1399 | |||||
| 1400 | # = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = | ||||
| 1401 | # = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = | ||||
| 1402 | |||||
| 1403 | =head2 HTML::Stream::Latin1 | ||||
| 1404 | |||||
| - - | |||||
| 1432 | package HTML::Stream::Latin1; | ||||
| 1433 | |||||
| 1434 | 3 | 103µs | 2 | 71µs | # spent 56µs (40+15) within HTML::Stream::Latin1::BEGIN@1434 which was called:
# once (40µs+15µs) by Markdent::Role::HTMLStream::BEGIN@9 at line 1434 # spent 56µs making 1 call to HTML::Stream::Latin1::BEGIN@1434
# spent 15µs making 1 call to strict::import |
| 1435 | 3 | 331µs | 2 | 280µs | # spent 158µs (36+122) within HTML::Stream::Latin1::BEGIN@1435 which was called:
# once (36µs+122µs) by Markdent::Role::HTMLStream::BEGIN@9 at line 1435 # spent 158µs making 1 call to HTML::Stream::Latin1::BEGIN@1435
# spent 122µs making 1 call to vars::import |
| 1436 | 1 | 139µs | @ISA = qw(HTML::Stream); | ||
| 1437 | |||||
| 1438 | # Constructor: | ||||
| 1439 | sub new { | ||||
| 1440 | my $class = shift; | ||||
| 1441 | my $self = HTML::Stream->new(@_); | ||||
| 1442 | $self->auto_escape('LATIN_1'); | ||||
| 1443 | bless $self, $class; | ||||
| 1444 | } | ||||
| 1445 | |||||
| 1446 | |||||
| 1447 | __END__ |