MojoMojo::Formatter::IRCLog - format part of content as an IRC log

MojoMojo documentation Contained in the MojoMojo distribution.

Index

Code Index:

NAME

Top

MojoMojo::Formatter::IRCLog - format part of content as an IRC log

DESCRIPTION

Top

This formatter will format content between {{irc}} and {{end}} as an IRC log

METHODS

Top

format_content_order

Format order can be 1-99. The IRC log formatter runs on 14, just before the main formatter.

format_content

Calls the formatter. Takes a ref to the content as well as the context object.

SEE ALSO

Top

MojoMojo and Module::Pluggable::Ordered.

AUTHORS

Top

Martijn van Beers <martijn@eekeek.org>

LICENSE

Top

This library is free software. You can redistribute it and/or modify it under the same terms as Perl itself.

MojoMojo documentation Contained in the MojoMojo distribution. 
package MojoMojo::Formatter::IRCLog;

use parent qw/MojoMojo::Formatter/;


sub format_content_order { 14 }


sub format_content {
    my ( $class, $content ) = @_;
    my ( $in_log, %nicks, $longline, @newlines );

    my @lines = split( /\n/, $$content );
    $$content = "";
    my $start_re=$class->gen_re(qr/irc/);
    my $end_re=$class->gen_re(qr/end/);

    foreach my $line (@lines) {
        if ($in_log) {
            if ( $line =~ $end_re ) {
                $in_log = 0;
                if ($longline) {
                    $longline .= "</dd>";
                    push( @newlines, $longline );
                    $longline = "";
                }
                push @newlines, $line;
            }
            elsif ( $line =~ /^[\d:]*\s*<[+\%\@ ]?(.*?)>\s*(.*)/ ) {
                if ($longline) {
                    $longline .= "</dd>";
                    push( @newlines, $longline );
                    $longline = "";
                }
                $nicks{$1} = 1;
                $longline = "<dt>$1</dt>\n<dd>$2";
            }
            else {
                $line =~ s/^\s*/ /;
                $longline .= $line;
            }
        }
        else {
            if ( $line =~ $start_re ) {
                push @newlines, $line;
                $in_log = 1;
            }
            else {
                push( @newlines, $line );
            }
        }
    }
    foreach my $line (@newlines) {
        if ($in_log) {
            if ( $line =~ $end_re ) {
                $in_log = 0;

                # end the dl and the section not handled by textile
                $$content .= "</dl>\n==\n";
            }
            else {
                my $count = 0;
                my @colours=( 'navy', 'green' , 'maroon', 'blue', 'lime', 'red', 'silver', 'gray', 'teal', 'olive', 'purple', 'fuchsia'  );
                my $counter;
                foreach my $nick ( keys %nicks ) {
                    $colour=$colours[$counter++];
                    $count += ( $line =~ s!(<d.>)$nick(</d.>)!$1<font color="$colour">[[$nick]]</font>$2!g );
                }
                $$content .= "$line\n";
            }
        }
        else {
            if ( $line =~ $start_re ) {
                $in_log = 1;

                # start a definition list in a section not handled by
                # textile
                $$content .= "==\n<dl>\n";
            }
            else {
                $$content .= "$line\n";
            }
        }
    }
}


1;