IRC-Formatting-HTML-0.29/0000755000175000017500000000000011513656750013706 5ustar leedoleedoIRC-Formatting-HTML-0.29/Makefile.PL0000644000175000017500000000117211406431616015652 0ustar leedoleedouse strict; use warnings; use ExtUtils::MakeMaker; WriteMakefile( NAME => 'IRC::Formatting::HTML', AUTHOR => 'Lee Aylward ', VERSION_FROM => 'lib/IRC/Formatting/HTML.pm', ABSTRACT_FROM => 'lib/IRC/Formatting/HTML.pm', ($ExtUtils::MakeMaker::VERSION >= 6.3002 ? ('LICENSE'=> 'perl') : ()), PL_FILES => {}, PREREQ_PM => { 'HTML::Parser' => 0, 'Test::More' => 0, }, dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', }, clean => { FILES => 'IRC-Formatting-HTML-*' }, ); IRC-Formatting-HTML-0.29/lib/0000755000175000017500000000000011513656750014454 5ustar leedoleedoIRC-Formatting-HTML-0.29/lib/IRC/0000755000175000017500000000000011513656750015071 5ustar leedoleedoIRC-Formatting-HTML-0.29/lib/IRC/Formatting/0000755000175000017500000000000011513656750017203 5ustar leedoleedoIRC-Formatting-HTML-0.29/lib/IRC/Formatting/HTML/0000755000175000017500000000000011513656750017747 5ustar leedoleedoIRC-Formatting-HTML-0.29/lib/IRC/Formatting/HTML/Common.pm0000644000175000017500000000467511513655353021547 0ustar leedoleedopackage IRC::Formatting::HTML::Common; use warnings; use strict; use Exporter 'import'; our @EXPORT = qw/$BOLD $COLOR $COLORM $RESET $INVERSE $UNDERLINE $COLOR_SEQUENCE $FORMAT_SEQUENCE @COLORS/; our @EXPORT_OK = qw/html_color_to_irc color_distance hex_color_to_dec rgb_str_to_dec style_tag/; our $BOLD = "\002", our $COLOR = "\003"; our $COLORM = qr/^$COLOR/; our $RESET = "\017"; our $INVERSE = "\026"; our $UNDERLINE = "\037"; our $COLOR_SEQUENCE = qr/([0-9]{1,2})(?:,([0-9]{1,2}))?/; my $COLOR_SEQUENCE_NC = qr/[0-9]{1,2}(?:,[0-9]{1,2})?/; our $FORMAT_SEQUENCE = qr/( $BOLD | $COLOR$COLOR_SEQUENCE_NC? | $RESET | $INVERSE | $UNDERLINE) /x; our @COLORS = ( qw/fff 000 008 080 f00 800 808 f80 ff0 0f0 088 0ff 00f f0f 888 ccc/ ); my @colors_dec = do { map {hex_color_to_dec($_)} @COLORS }; sub html_color_to_irc { my $color = shift; my $rgb; if ($color =~ /^#?[a-f0-9]+$/i) { $rgb = hex_color_to_dec($color); } elsif ($color =~ /^rgb/) { $rgb = rgb_str_to_dec($color); } return () unless $rgb; my ($closest, $dist) = (1, 500); for my $i (0 .. @colors_dec - 1) { my $_rgb = $colors_dec[$i]; my $_dist = color_distance($rgb, $_rgb); if ($_dist < $dist) { ($closest, $dist) = ($i, $_dist); } last if $dist == 0; } return sprintf "%02s", $closest; } sub color_distance { my ($a, $b) = @_; my $distance = 0; for (0 .. 2) { my $_a = $a->[$_]; my $_b = $b->[$_]; $distance += ($_b - $_a) ** 2; } return (int (sqrt($distance) * 10)) / 10; } sub rgb_str_to_dec { my $color = shift; if ($color =~ /^rgba? \s* \( \s* (\d+) \s* , \s* (\d+) \s* , \s* (\d+) \s* \)/xi) { return [$1, $2, $3]; } return (); } sub hex_color_to_dec { my $color = shift; if (substr($color, 0, 1) eq "#") { $color = substr $color, 1; } if (length $color == 3) { $color = join "", map {$_ x 2} split "", $color; } my @rgb = ($color =~ /([a-f0-9]{2})/gi); if (@rgb == 3) { return [ map {hex $_} @rgb ]; } return (); } sub style_tag { my $style = ""; return $style; } 1; IRC-Formatting-HTML-0.29/lib/IRC/Formatting/HTML/Input.pm0000644000175000017500000000655611421102240021372 0ustar leedoleedopackage IRC::Formatting::HTML::Input; use warnings; use strict; use IRC::Formatting::HTML::Common; use HTML::Parser (); my $p = HTML::Parser->new(api_version => 3, text_h => [\&_text, 'dtext'], start_h => [\&_tag_start, 'tagname, attr'], end_h => [\&_tag_end, 'tagname']); my $nbsp = chr(160); my @states; my $irctext = ""; sub parse { $irctext = ""; _reset(); my $html = shift; $html =~ s/\n//; $p->parse($html); $p->eof; $irctext =~ s/\n{2,}/\n/; $irctext =~ s/^\n+//; $irctext =~ s/\n+$//; return $irctext; } sub _reset { @states = ({ b => 0, i => 0, u => 0, fg => "", bg => "", }); } sub _text { my $text = shift; $text =~ s/$nbsp/ /g; $irctext .= $text if defined $text and length $text; } sub clone { my $state = $states[0]; return { b => $state->{b}, i => $state->{i}, u => $state->{u}, fg => $state->{fg}, bg => $state->{bg}, }; } sub _tag_start { my ($tag, $attr) = @_; my $state = clone(); if ($tag eq "br" or $tag eq "p" or $tag eq "div" or $tag =~ /^h[\dr]$/) { $irctext .= "\n"; } if ($attr->{style}) { if ($attr->{style} =~ /(?:^|;\s*)color:\s*([^;"]+)/) { my $color = IRC::Formatting::HTML::Common::html_color_to_irc($1); if ($color) { $state->{fg} = $color; $irctext .= $COLOR.$color; $irctext .=",$state->{bg}" if length $state->{bg}; } } if ($attr->{style} =~ /font-weight:\s*bold/) { $irctext .= $BOLD unless $state->{b}; $state->{b} = 1; } if ($attr->{style} =~ /font-style:\s*italic/) { $irctext .= $INVERSE unless $state->{i}; $state->{i} = 1; } if ($attr->{style} =~ /text-decoration:\s*underline/) { $irctext .= $UNDERLINE unless $state->{u}; $state->{u} = 1; } if ($attr->{style} =~ /background-color:\s*([^;"]+)/) { my $color = IRC::Formatting::HTML::Common::html_color_to_irc($1); if ($color) { $state->{bg} = $color; my $fg = length $state->{fg} ? $state->{fg} : "01"; $irctext .= $COLOR."$fg,$color"; } } } if ($attr->{color}) { my $color = IRC::Formatting::HTML::Common::html_color_to_irc($attr->{color}); if ($color) { $state->{fg} = $color; $irctext .= $COLOR.$color; $irctext .=",$state->{bg}" if length $state->{bg}; } } if ($tag eq "strong" or $tag eq "b" or $tag =~ /^h\d$/) { $irctext .= $BOLD unless $state->{b}; $state->{b} = 1; } elsif ($tag eq "em" or $tag eq "i") { $irctext .= $INVERSE unless $state->{i}; $state->{i} = 1; } elsif ($tag eq "u") { $irctext .= $UNDERLINE unless $state->{u}; $state->{u} = 1; } unshift @states, $state; } sub _tag_end { my $tag = shift; my $prev = shift @states; my $next = $states[0]; $irctext .= $BOLD if $next->{b} ne $prev->{b}; $irctext .= $INVERSE if $next->{i} ne $prev->{i}; $irctext .= $UNDERLINE if $next->{u} ne $prev->{u}; if ($next->{fg} ne $prev->{fg} or $next->{bg} ne $prev->{bg}) { $irctext .= $COLOR; my ($fg, $bg) = ("",""); if (length $next->{fg}) { $fg = $next->{fg}; } if (length $next->{bg}) { $bg = $next->{bg}; $fg = "01" unless length $fg; } $irctext .= $fg; $irctext .= ",$bg" if length $bg; } if ($tag eq "p" or $tag eq "div" or $tag =~ /^h[\dr]$/) { $irctext .= "\n"; } } 1 IRC-Formatting-HTML-0.29/lib/IRC/Formatting/HTML/Output.pm0000644000175000017500000000606611513655353021613 0ustar leedoleedopackage IRC::Formatting::HTML::Output; use warnings; use strict; use IRC::Formatting::HTML::Common; my ($b, $i, $u, $fg, $bg); my $italic_invert = 0; my $use_classes = 0; sub _parse_formatted_string { my $line = shift; _reset(); my @segments; my @chunks = ("", split($FORMAT_SEQUENCE, $line)); $line = ""; while (scalar(@chunks)) { my $format_sequence = shift(@chunks); my $text = shift(@chunks); _accumulate($format_sequence); next unless defined $text and length $text; $text =~ s/ {2}/  /g; if ($use_classes) { $line .= "$text"; } else { $line .= "$text"; } } return $line; } sub _reset { ($b, $i, $u) = (0, 0, 0); undef $fg; undef $bg; } sub _accumulate { my $format_sequence = shift; if ($format_sequence eq $BOLD) { $b = !$b; } elsif ($format_sequence eq $UNDERLINE) { $u = !$u; } elsif ($format_sequence eq $INVERSE) { $i = !$i; } elsif ($format_sequence eq $RESET) { _reset; } elsif ($format_sequence =~ $COLORM) { ($fg, $bg) = _extract_colors_from($format_sequence); } } sub _extract_colors_from { my $format_sequence = shift; $format_sequence = substr($format_sequence, 1); my ($_fg, $_bg) = ($format_sequence =~ $COLOR_SEQUENCE); if (! defined $_fg) { return undef, undef; } elsif (! defined $_bg) { return $_fg, $bg; } else { return $_fg, $_bg; } } sub _to_css { my $styles = ""; my ($_fg, $_bg); # italicize inverted text if that option is set if ($i) { if ($italic_invert) { $styles .= "font-style: italic;"; ($_fg, $_bg) = ($fg, $bg); } else { ($_fg, $_bg) = ($bg || 0, $fg || 1); } } else { ($_fg, $_bg) = ($fg, $bg); } $styles .= "color: #$COLORS[$_fg];" if defined $_fg and $COLORS[$_fg]; $styles .= "background-color: #$COLORS[$_bg];" if defined $_bg and $COLORS[$_bg]; $styles .= "font-weight: bold;" if $b; $styles .= "text-decoration: underline;" if $u; return $styles; } sub _to_classes { my @classes; my ($_fg, $_bg); # italicize inverted text if that option is set if ($i) { if ($italic_invert) { push @classes, "italic"; ($_fg, $_bg) = ($fg, $bg); } else { ($_fg, $_bg) = ($bg || 0, $fg || 1); } } else { ($_fg, $_bg) = ($fg, $bg); } push @classes, "fg-$COLORS[$_fg]" if defined $_fg and $COLORS[$_fg]; push @classes, "bg-$COLORS[$_bg]" if defined $_bg and $COLORS[$_bg]; push @classes, "bold" if $b; push @classes, "ul" if $u; return join " ", @classes; } sub parse { my ($string, $italic, $classes) = @_; $italic_invert = 1 if $italic; $use_classes = 1 if $classes; _encode_entities(\$string); my $text = join "\n", map {_parse_formatted_string($_)} split "\n", $string; $italic_invert = 0; $use_classes = 0; return $text; } sub _encode_entities { my $string = shift; return unless $string; $$string =~ s/&/&/g; $$string =~ s//>/g; $$string =~ s/"/"/g; } 1; IRC-Formatting-HTML-0.29/lib/IRC/Formatting/HTML.pm0000644000175000017500000000520211513656725020306 0ustar leedoleedopackage IRC::Formatting::HTML; use warnings; use strict; use IRC::Formatting::HTML::Output; use IRC::Formatting::HTML::Input; use Exporter qw/import/; =head1 NAME IRC::Formatting::HTML - Convert between HTML and IRC formatting =head1 VERSION Version 0.29 =cut our @EXPORT_OK = qw/irc_to_html html_to_irc/; our $VERSION = '0.29'; =head1 SYNOPSIS Convert raw IRC formatting to HTML use IRC::Formatting::HTML qw/irc_to_html html_to_irc/; ... my $irctext = "\002\0031,2Iron & Wine"; my $html = irc_to_html($irctext); print $html # the above will print: # Iron & Wine ... my $html = "Nicotine and gravy"; my $irctext = html_to_irc($html); print $html; # the above will print: # \002\026Nicotine and Gravy\002\026 =head1 FUNCTIONS =head2 irc_to_html irc_to_html($irctext, invert => "italic") Takes an irc formatted string and returns the HTML version. Takes an option to treat inverted text as italic text. =cut sub irc_to_html { my ($text, %options) = @_; my $italic = ($options{invert} and $options{invert} eq "italic"); my $classes = $options{classes}; return IRC::Formatting::HTML::Output::parse($text, $italic, $classes); } =head2 html_to_irc html_to_irc($html) Takes an HTML string and returns an irc formatted string =cut sub html_to_irc { return IRC::Formatting::HTML::Input::parse(shift); } =head1 AUTHOR Lee Aylward, Eleedo@cpan.orgE =head1 BUGS Please report any bugs or feature requests to C, or through the web interface at L. I will be notified, and then you'll automatically be notified of progress on your bug as I make changes. =head1 SUPPORT You can find documentation for this module with the perldoc command. perldoc IRC::Formatting::HTML You can also look for information at: =over 4 =item * RT: CPAN's request tracker L =item * AnnoCPAN: Annotated CPAN documentation L =item * CPAN Ratings L =item * Search CPAN L =back =head1 ACKNOWLEDGEMENTS This is a direct port of Sam Stephenson's ruby version. =head1 COPYRIGHT & LICENSE Copyright 2009 Lee Aylward, all rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut 1; # End of IRC::Formatting::HTML IRC-Formatting-HTML-0.29/Changes0000644000175000017500000000413611513656713015204 0ustar leedoleedoRevision history for IRC-Formatting-HTML 0.29 01/13/2011 Fixed an issue parsing color codes on some unicode strings 0.28 09/21/2010 Added an option to use CSS classes instead of inline CSS styles 0.27 07/28/2010 Added an option to treat inverted irc text as italic 0.26 07/15/2010 Handle color HTML attribute 0.25 07/15/2010 Handle block elements better 0.24 07/15/2010 Handle colors from HTML input More accurate html to irc conversion 0.23 06/26/2010 Fixed an issue with tokens that evaluate to false (e.g. "0") 0.22 06/19/2010 Handle   0.21 06/17/2010 Fixed consecutive formattings in irc_to_html 0.20 06/17/2010 Fixed docs Detect more bold and italic tags 0.19 06/16/2010 Removed "formatted_string_to_html", use irc_to_html instead Added html_to_irc export 0.18 04/19/2010 Add irc_to_html export Minor speedups 0.17 04/19/2010 Fix MANIFEST 0.16 04/19/2010 Drop Any::Moose dependency Use file scope for accumulated state 0.15 04/15/2010 Small fix to avoid warning 0.14 03/24/2010 Handle "0" and "" properly 0.13 02/24/2010 Remove HTML::Entities dependency 0.12 02/21/2010 Remove leftover IO::String use statement 0.11 02/21/2010 Verify that the color codes exist Stop using natatime to avoid growing memory 0.10 12/22/2009 Remove POD tests 0.09 12/06/2009 Use Any::Moose 0.08 10/09/2009 Properly apply the last patch 0.07 10/08/2009 Put the   entity after a space, so links don't get broken when followed by a double space 0.06 09/24/2009 Only replace regular spaces with HTML entities 0.05 08/21/2009 More POD cleanup 0.04 08/21/2009 Properly apply previous patch 0.03 08/16/2009 Fixed rendering bug for inverted text (thanks nop) 0.02 08/02/2009 Cleaned up POD 0.01 07/23/2009 First version IRC-Formatting-HTML-0.29/t/0000755000175000017500000000000011513656750014151 5ustar leedoleedoIRC-Formatting-HTML-0.29/t/03-input.t0000644000175000017500000000602611421102252015676 0ustar leedoleedo#!perl -T use Test::More; use IRC::Formatting::HTML qw/html_to_irc/; use IRC::Formatting::HTML::Common; my $nohtml = "No html here"; my $irc = html_to_irc($nohtml); is($irc, $nohtml); my $newline = "first line
second line
"; $irc = html_to_irc($newline); is ($irc, "first line\nsecond line"); my $bold = "Boldnotbold"; $irc = html_to_irc($bold); is($irc, $BOLD."Bold".$BOLD."notbold"); my $bolditalic = "Hjalp"; $irc = html_to_irc($bolditalic); is($irc, $BOLD.$INVERSE."Hjalp".$INVERSE.$BOLD); my $inverse = "Inverse"; $irc = html_to_irc($inverse); is($irc, $INVERSE."Inverse".$INVERSE); my $underline = "Underline"; $irc = html_to_irc($underline); is($irc, $UNDERLINE."Underline".$UNDERLINE); my $combo = "Combo formatting"; $irc = html_to_irc($combo); is($irc, $BOLD."Combo ".$INVERSE."formatting".$INVERSE.$BOLD); my $everything = "Everything"; $irc = html_to_irc($everything); is($irc, $BOLD.$INVERSE.$UNDERLINE."Everything".$UNDERLINE.$INVERSE.$BOLD); my $nbsp = " some text"; $irc = html_to_irc($nbsp); is($irc, " ".$BOLD."some text".$BOLD); my $colored = "some text heh"; $irc = html_to_irc($colored); is($irc, $COLOR."15some ".$COLOR."00text".$COLOR."15$COLOR heh"); my $big_color = 'Ars Technica Features:Browse our latest in-depth, full-length stories.'; $irc = html_to_irc($big_color); is $irc, $COLOR."01".$BOLD.$COLOR."07Ars Technica Features:".$COLOR."01Browse our latest in-depth, full-length stories.$BOLD$COLOR"; my $h2_newline = "

Headline

\n

what the what

"; $irc = html_to_irc($h2_newline); is $irc, $BOLD."Headline".$BOLD."\nwhat the what"; my $fonttag = 'test'; $irc = html_to_irc($fonttag); is $irc, $COLOR."04t".$COLOR.$COLOR."08e".$COLOR.$COLOR."09s".$COLOR.$COLOR."11t".$COLOR; my $false_char = "0 hello"; $irc = html_to_irc($false_char); is ($irc, "0 hello"); my $bgcolor = 'started following'; $irc = html_to_irc($bgcolor); is $irc, $COLOR."01,15started following".$COLOR; my $fg_bg_color = 'started following'; $irc = html_to_irc($fg_bg_color); is $irc, $COLOR."00".$COLOR."00,15started following".$COLOR."00".$COLOR; done_testing(); IRC-Formatting-HTML-0.29/t/02-empty.t0000644000175000017500000000035611363135564015715 0ustar leedoleedo#!perl -T use Test::More; use IRC::Formatting::HTML qw/irc_to_html/; my $empty = ""; my $html = irc_to_html($empty); ok($html eq ""); my $zero = "0"; $html = irc_to_html($zero); ok($html eq '0'); done_testing(); IRC-Formatting-HTML-0.29/t/01-output.t0000644000175000017500000000425211513655353016115 0ustar leedoleedo#!perl -T use Test::More; use IRC::Formatting::HTML qw/irc_to_html/; my $bold = "\002Bold"; my $html = irc_to_html($bold); ok($html eq 'Bold'); my $boldinverse = "\002\026Boldinverse\002\026"; $html = irc_to_html($boldinverse); is ($html, 'Boldinverse'); my $inverse = "\026Inverse"; $html = irc_to_html($inverse); ok($html eq 'Inverse'); my $italic = "\026Italic"; $html = irc_to_html($italic, invert => "italic"); is $html, 'Italic'; my $underline = "\037Underline"; $html = irc_to_html($underline); ok($html eq 'Underline'); my $color = "\0033,4Color"; $html = irc_to_html($color); ok($html eq 'Color'); my $italiccolor = "\026\0033,4Color"; $html = irc_to_html($italiccolor, invert => "italic"); is $html, 'Color'; my $everything = "$bold$inverse$underline$color"; $html = irc_to_html($everything); ok($html eq 'BoldInverseUnderlineColor'); my $everything_lines = join "\n", ($bold, $inverse, $underline, $color); $html = irc_to_html($everything_lines); ok($html eq join "\n", ('Bold', 'Inverse', 'Underline', 'Color')); $html = irc_to_html($everything_lines, classes => 1); ok($html eq join "\n", ('Bold', 'Inverse', 'Underline', 'Color')); done_testing(); IRC-Formatting-HTML-0.29/t/00-load.t0000644000175000017500000000025511232101306015450 0ustar leedoleedo#!perl -T use Test::More tests => 1; BEGIN { use_ok( 'IRC::Formatting::HTML' ); } diag( "Testing IRC::Formatting::HTML $IRC::Formatting::HTML::VERSION, Perl $], $^X" ); IRC-Formatting-HTML-0.29/README0000644000175000017500000000151111256713311014553 0ustar leedoleedoIRC-Formatting-HTML INSTALLATION To install this module, run the following commands: perl Makefile.PL make make test make install SUPPORT AND DOCUMENTATION After installing, you can find documentation for this module with the perldoc command. perldoc IRC::Formatting::HTML You can also look for information at: RT, CPAN's request tracker http://rt.cpan.org/NoAuth/Bugs.html?Dist=IRC-Formatting-HTML AnnoCPAN, Annotated CPAN documentation http://annocpan.org/dist/IRC-Formatting-HTML CPAN Ratings http://cpanratings.perl.org/d/IRC-Formatting-HTML Search CPAN http://search.cpan.org/dist/IRC-Formatting-HTML/ COPYRIGHT AND LICENCE Copyright (C) 2009 Lee Aylward This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. IRC-Formatting-HTML-0.29/META.yml0000644000175000017500000000110711513656750015156 0ustar leedoleedo--- #YAML:1.0 name: IRC-Formatting-HTML version: 0.29 abstract: Convert between HTML and IRC formatting author: - Lee Aylward license: perl distribution_type: module configure_requires: ExtUtils::MakeMaker: 0 build_requires: ExtUtils::MakeMaker: 0 requires: HTML::Parser: 0 Test::More: 0 no_index: directory: - t - inc generated_by: ExtUtils::MakeMaker version 6.56 meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 IRC-Formatting-HTML-0.29/MANIFEST0000644000175000017500000000053411513656750015041 0ustar leedoleedoChanges IRC-Formatting-HTML-0.20.tar.gz lib/IRC/Formatting/HTML.pm lib/IRC/Formatting/HTML/Common.pm lib/IRC/Formatting/HTML/Input.pm lib/IRC/Formatting/HTML/Output.pm Makefile.PL MANIFEST This list of files README t/00-load.t t/01-output.t t/02-empty.t t/03-input.t META.yml Module meta-data (added by MakeMaker)