Catalyst::Plugin::Acme::Scramble - tset the budnos of lieibiglty and dstraneotme how we pcvreiee wdors wtih yuor Ctyslaat apicapltion

Catalyst-Plugin-Acme-Scramble documentation

Contained in the Catalyst-Plugin-Acme-Scramble distribution.

Index

NAME
VERSION
SYNOPSIS
AUTHOR
BUGS
SUPPORT
TODO
SEE ALSO
COPYRIGHT & LICENSE

Code Index:

package Catalyst::Plugin::Acme::Scramble
EOF

NAME

Catalyst::Plugin::Acme::Scramble - tset the budnos of lieibiglty and dstraneotme how we pcvreiee wdors wtih yuor Ctyslaat apicapltion

VERSION

Version 0.03

SYNOPSIS

 use Catalyst qw/
                 Your::Regular::Plugins
                 Acme::Scramble
                /;

 # And observe the corrected output of your application

Implements a potent meme about how easily we can read scrambled text if the first and last letters remain constant. Operates on text/plain and text/html served by your Catalyst application.

AUTHOR

Ashley Pond V, ashley at cpan.org.

BUGS

I love bugs! Hymenoptera, dictyoptera, coleoptera, all of them.

Expects valid nesting. May sometimes interfere with tags that should be literal, like <script> and <style>, when it's not present.

SUPPORT

You can find documentation for this module with the perldoc command.

    perldoc Catalyst::Plugin::Acme::Scramble

You can also look for information at:

* AnnoCPAN: Annotated CPAN documentation: http://annocpan.org/dist/Catalyst-Plugin-Acme-Scramble
* CPAN Ratings: http://cpanratings.perl.org/d/Catalyst-Plugin-Acme-Scramble
* RT: CPAN's request tracker: http://rt.cpan.org/NoAuth/Bugs.html?Dist=Catalyst-Plugin-Acme-Scramble
* Search CPAN: http://search.cpan.org/dist/Catalyst-Plugin-Acme-Scramble

TODO

Support application/xhtml+xml? If it's served that way, or even as any XML, we could use an XML parser and just scramble the #text parts.

SEE ALSO

Catalyst, Catalyst::Runtime.

COPYRIGHT & LICENSE

Copyright 2006 Ashley Pond V, all rights reserved.

This program is free software; you can redistribute it and modify it under the same terms as Perl itself.

Catalyst-Plugin-Acme-Scramble documentation

Contained in the Catalyst-Plugin-Acme-Scramble distribution.

package Catalyst::Plugin::Acme::Scramble;

use strict;

our $VERSION = '0.03';

my $skip = qr/script|style|map|area/;

sub finalize {
    my $c = shift;

    return $c->NEXT::finalize unless $c->response->body
        and
        $c->response->content_type =~ m,^text/(plain|html),;

    if ( $1 eq 'plain' )
    {
        _scramble_block( \$c->response->{body} );
    }
    else
    {
        require HTML::TokeParser;
        my $p = HTML::TokeParser->new( \$c->response->{body} );
        my $repaired = '';
        my @queue;

        while ( my $t = $p->get_token() )
        {
            push @queue, $t->[1] if $t->[0] eq 'S'; # assumes well-formed
            pop @queue if $t->[0] eq 'E';
            if ( 
                 $t->[0] eq 'T'
                 and
                 not $t->[2]
                 and
                 not grep /$skip/, @queue )
            {
                my $txt = $t->[1];
                _scramble_block(\$txt);
                $repaired .= $txt;
            }
            else
            {
                $repaired .= ( $t->[0] eq 'T' ) ? $t->[1] : $t->[-1];
            }
        }
        $c->response->{body} = $repaired;
    }

    $c->NEXT::finalize;
}

sub _scramble_block {
    my $text = shift;

    ${$text} =~ s{
                                    ( (?:(?<=[^[:alpha:]])|(?<=\A))
                                        (?<!&)(?-x)(?<!&#)(?x)
                                        (?:
                                              ['[:alpha:]]+ | (?<!-)-(?!-)
                                          )+
                                        (?=[^[:alpha:]]|\z)
                                      )
                                    }
                                  {_scramble_word($1)}gex;
}

sub _scramble_word {
    my $word = shift || return '';
    my @piece = split //, $word;
    shuffle(@piece[1..$#piece-1])
        if @piece > 2;
    join('', @piece);
}

sub shuffle {
    for ( my $i = @_; --$i; ) {
        my $j = int(rand($i+1));
        @_[$i,$j] = @_[$j,$i];
    }
}

1; # End of Catalyst::Plugin::Acme::Scramble