package JavaScript::Packer;

use 5.008;
use warnings;
use strict;
use Carp;

BEGIN {
    if ( $^V lt 'v5.10.0' ) {
        require re;
        re->import( 'eval' );
    }
}

use vars qw/$VERSION $MINIFY_VARS $SHRINK_VARS $BASE62_VARS $DICTIONARY $DATA $COMMENTS $WHITESPACE $CLEAN $TRIM/;

# =========================================================================== #

$VERSION = '0.0401';

$MINIFY_VARS = {
    'ESCAPE_BRACKETS'   => qr~\(\?(-?[pmixs]+:|[:=!><])|\[[^\]]+\]~,
    'ESCAPE_CHARS'      => qr~\\.~,
    'BRACKETS'          => qr~\(~,
    'BACK_REF'          => qr~\\(\d+)~
};

$SHRINK_VARS = {
    'ENCODED_DATA'  => qr~\x01(\d+)\x01~,
    'BLOCK'         => qr/(((catch|do|if|while|with|function)\b[^~{};]*(\(\s*[^{};]*\s*\))\s*)?(\{[^{}]*\}))/,
    'BRACKETS'      => qr/\{[^{}]*\}|\[[^\[\]]*\]|\([^\(\)]*\)|~[^~]+~/,
    'ENCODED_BLOCK' => qr/~#?(\d+)~/,
    'IDENTIFIER'    => qr~[a-zA-Z_\x24][a-zA-Z_0-9\\x24]*~,
    'SCOPED'        => qr/~#(\d+)~/,
    'VAR'           => qr~\bvar\b~,
    'VARS'          => qr~\b(?:var|function)\s+((?>[a-zA-Z0-9_\x24]+))~,
    'PREFIX'        => qr~\x02~,
    'SHRUNK'        => qr~\x02\d+\b~
};

$BASE62_VARS = {
    'WORDS'     => qr~(\b[0-9a-zA-Z]\b|(?>[a-zA-Z0-9_]{2,}))~,
    'ENCODE10'  => 'String',
    'ENCODE36'  => 'function(c){return c.toString(36)}',
    'ENCODE62'  => q~function(c){return(c<62?'':e(parseInt(c/62)))+((c=c%62)>35?String.fromCharCode(c+29):c.toString(36))}~,
    'UNPACK'    => q~eval(function(p,a,c,k,e,r){e=%s;if('0'.replace(0,e)==0){while(c--)r[e(c)]=k[c];k=[function(e){return r[e]||e}];e=function(){return'%s'};c=1};while(c--)if(k[c])p=p.replace(new RegExp('\\\\b'+e(c)+'\\\\b','g'),k[c]);return p}('%s',%s,%d,'%s'.split('|'),0,{}))~
};

$DICTIONARY = {
    'STRING1'       => qr~"(?>(?:(?>[^"\\]+)|\\.|\\")*)"~,
    'STRING2'       => qr~'(?>(?:(?>[^'\\]+)|\\.|\\')*)'~,
    'REGEXP'        => qr~\/(\\[\/\\]|[^*\/])(\\.|[^\/\n\\])*\/[gim]*~,
    'OPERATOR'      => qr'return|typeof|[\[(\^=,{}:;&|!*?]',
    'CONDITIONAL'   => qr~\/\*\@\w*|\w*\@\*\/|\/\/\@\w*|\@(?>\w+)~,
    'COMMENT1'      => qr~\/\/(\@)?([^\n]*)?\n~,
    'COMMENT2'      => qr~\/\*[^*]*\*+(?:[^\/][^*]*\*+)*\/~
};

$DATA = [
    {
        'regexp'        => $DICTIONARY->{'STRING1'},
        'replacement'   => sub { return shift; }
    },
    {
        'regexp'        => $DICTIONARY->{'STRING2'},
        'replacement'   => sub { return shift; }
    },
    {
        'regexp'        => $DICTIONARY->{'CONDITIONAL'},
        'replacement'   => sub { return shift; }
    },
    {
        'regexp'        => '(' . $DICTIONARY->{'OPERATOR'} . ')\s*(' . $DICTIONARY->{'REGEXP'} . ')',
        'replacement'   => sub { return sprintf( "%s%s", $_[1]->[0], $_[1]->[1] ); }
    }
];

$COMMENTS = [
    {
        'regexp'        => ';;;[^\n]*\n',
        'replacement'   => ''
    },
    {
        'regexp'        => $DICTIONARY->{'COMMENT1'} . '\s*(' . $DICTIONARY->{'REGEXP'} . ')?',
        'replacement'   => sub { return sprintf( "\n%s", $_[1]->[2] ); }
    },
    {
        'regexp'        => '(' . $DICTIONARY->{'COMMENT2'} . ')\s*(' . $DICTIONARY->{'REGEXP'} . ')?',
        'replacement'   => sub { return sprintf( " %s", $_[1]->[1] ); }
    }
];

$CLEAN = [
    {
        'regexp'        => '\(\s*([^;)]*)\s*;\s*([^;)]*)\s*;\s*([^;)]*)\)',
        'replacement'   => sub { return sprintf( "(%s;%s;%s)", @{$_[1]} ); }
    },
    {
        'regexp'        => 'throw[^};]+[};]',
        'replacement'   => sub { return shift; }
    },
    {
        'regexp'        => ';+\s*([};])',
        'replacement'   => sub { return $_[1]->[0]; }
    }
];

$WHITESPACE = [
    {
        'regexp'        => '\/\/@[^\n]*\n',
        'replacement'   => sub { return shift; }
    },
    {
        'regexp'        => '@\s+\b',
        'replacement'   => '@ '
    },
    {
        'regexp'        => '\b\s+@',
        'replacement'   => ' @'
    },
    {
        'regexp'        => '(\d)\s+(\.\s*[a-z\x24_\[(])',
        'replacement'   => sub { return sprintf( "%s %s", @{$_[1]} ); }
    },
    {
        'regexp'        => '([+-])\s+([+-])',
        'replacement'   => sub { return sprintf( "%s %s", @{$_[1]} ); }
    },
    {
        'regexp'        => '(?>\s+)(\x24)(?>\s+)',
        'replacement'   => sub { return sprintf( " %s ", $_[1]->[0] ); }
    },
    {
        'regexp'        => '(\x24)(?>\s+)(?!=)',
        'replacement'   => sub { return sprintf( "%s ", $_[1]->[0] ); }
    },
    {
        'regexp'        => '(?<!=)(?>\s+)(\x24)',
        'replacement'   => sub { return sprintf( " %s", $_[1]->[0] ); }
    },
    {
        'regexp'        => '\b\s+\b',
        'replacement'   => ' '
    },
    {
        'regexp'        => '\s+',
        'replacement'   => ''
    }
];

$TRIM = [
    {
        'regexp'        => '(\d)(?:\|\d)+\|(\d)',
        'replacement'   => sub { return sprintf( "%d-%d", $_[1]->[0] || 0, $_[1]->[1] || 0 ); }
    },
    {
        'regexp'        => '([a-z])(?:\|[a-z])+\|([a-z])',
        'replacement'   => sub { return sprintf( "%s-%s", $_[1]->[0], $_[1]->[1] ); }
    },
    {
        'regexp'        => '([A-Z])(?:\|[A-Z])+\|([A-Z])',
        'replacement'   => sub { return sprintf( "%s-%s", $_[1]->[0], $_[1]->[1] ); }
    },
    {
        'regexp'        => '\|',
        'replacement'   => ''
    }
];

sub init {
    my $class   = shift;
    my $self    = {};

    map {
        my $what = $_;

        map {
            push(
                @{$self->{$what}->{'reggrp'}},
                {
                    'regexp'        => $_->{'regexp'},
                    'replacement'   => $_->{'replacement'}
                }
            );
        } @$DATA;

        if ( $what eq 'comments' ) {
            map {
                push(
                    @{$self->{'comments'}->{'reggrp'}},
                    {
                        'regexp'        => $_->{'regexp'},
                        'replacement'   => $_->{'replacement'}
                    }
                );
            } @$COMMENTS;
        }
        elsif ( $what eq 'clean' ) {
            map {
                push(
                    @{$self->{'clean'}->{'reggrp'}},
                    {
                        'regexp'        => $_->{'regexp'},
                        'replacement'   => $_->{'replacement'}
                    }
                );
            } @$CLEAN;
        }
        elsif ( $what eq 'whitespace' ) {
            map {
                push(
                    @{$self->{'whitespace'}->{'reggrp'}},
                    {
                        'regexp'        => $_->{'regexp'},
                        'replacement'   => $_->{'replacement'}
                    }
                );
            } @$WHITESPACE;
        }
    } ( 'comments', 'clean', 'whitespace', 'concat' );

    splice( @{$self->{'comments'}->{'reggrp'}}, 2, 1 );
    splice( @{$self->{'whitespace'}->{'reggrp'}}, 2, 1 );
    splice( @{$self->{'concat'}->{'reggrp'}}, 2, 1 );

    map {
        push(
            @{$self->{'data_store'}->{'reggrp'}},
            {
                'regexp'        => $_->{'regexp'},
                'replacement'   => sub {
                    return sprintf( "\x01%d\x01", $_[2] );
                },
                'store'         => sub { return sprintf( "%s", $_[0] ); }
            }
        );
    } @$DATA;

    for ( my $i = 1; $i >= 0; $i-- ) {
        unshift(
            @{$self->{'concat'}->{'reggrp'}},
            {
                'regexp'        => $DATA->[$i]->{'regexp'},
                'replacement'   => sub { return shift; }
            }
        );
        unshift(
            @{$self->{'concat'}->{'reggrp'}},
            {
                'regexp'        => '(' . $DATA->[$i]->{'regexp'} . ')((?:\+' . $DATA->[$i]->{'regexp'} . ')+)',
                'replacement'   => sub {
                    my $submatches = $_[1];
                    my $ret = $submatches->[0];

                    my $next_str = '^\+(' . $DATA->[0]->{'regexp'} . '|' . $DATA->[1]->{'regexp'} . ')';

                    while ( my ( $next ) = $submatches->[1] =~ /$next_str/ ) {
                        chop( $ret );
                        $ret .= substr( $next, 1 );
                        $submatches->[1] =~ s/$next_str//;
                    }

                    return $ret;
                }
            }
        );
    }

    push(
        @{$self->{'concat'}->{'reggrp'}},
        {
            'regexp'        => $DATA->[3]->{'regexp'},
            'replacement'   => $DATA->[3]->{'replacement'}
        }
    );

    map {
        push(
            @{$self->{'trim'}->{'reggrp'}},
            {
                'regexp'        => $_->{'regexp'},
                'replacement'   => $_->{'replacement'}
            }
        );
    } @$TRIM;

    map {
        my $what    = $_;
        my $offset    = 2;
        my $midx    = 0;

        $self->{$what}->{'re_str'} = ( ( $^V lt 'v5.10.0' ) ? '(?{ %+ = (); })' : '' ) . '(' . join(
            '|',
            map {
                my $re = $_->{'regexp'};
                $re =~ s/$MINIFY_VARS->{'ESCAPE_CHARS'}//g;
                $re =~ s/$MINIFY_VARS->{'ESCAPE_BRACKETS'}//g;
                my @nparen = $re =~ /$MINIFY_VARS->{'BRACKETS'}/g;
                $_->{'regexp'} = qr/$_->{'regexp'}/;

                $re = $_->{'regexp'};

                $re =~ s/$MINIFY_VARS->{'BACK_REF'}/sprintf( "\\%d", $offset + $1 )/eg;

                my $ret;

                if ( $^V lt 'v5.10.0' ) {
                    $ret = '(' . $re . ')' . '(?{ $+{\'_' . $midx++ . '\'} = $^N; })';
                }
                else {
                    $ret = '(?\'_' . $midx++ . '\'' . $re . ')';
                }

                $offset += scalar( @nparen ) + 1;

                $ret;

            } @{$self->{$what}->{'reggrp'}}
        ) . ')';
    } ( 'comments', 'clean', 'whitespace', 'data_store', 'concat', 'trim' );

    $self->{'comments'}->{'reggrp'}->[-2]->{'replacement'} = sub {
        if ( $_[1]->[0] eq '@' ) {
            $_[1]->[1] =~ s/$self->{'comments'}->{'re_str'}/$self->_process_minify( 'comments', $1, %+ )/egsm;
            $_[1]->[1] =~ s/$self->{'clean'}->{'re_str'}/$self->_process_minify( 'clean', $1, %+ )/egsm;
            $_[1]->[1] =~ s/$self->{'whitespace'}->{'re_str'}/$self->_process_minify( 'whitespace', $1, %+ )/egsm;

            return sprintf( "//%s%s\n%s", @{$_[1]} );
        }
        return sprintf( "\n%s", $_[1]->[2] );
    };

    $self->{'comments'}->{'reggrp'}->[-1]->{'replacement'} = sub {
        if ( $_[1]->[0] =~ /^\/\*\@(.*)\@\*\/$/sm ) {
            my $cmnt = $1;
            $cmnt =~ s/$self->{'comments'}->{'re_str'}/$self->_process_minify( 'comments', $1, %+ )/egsm;
            $cmnt =~ s/$self->{'clean'}->{'re_str'}/$self->_process_minify( 'clean', $1, %+ )/egsm;
            $cmnt =~ s/$self->{'whitespace'}->{'re_str'}/$self->_process_minify( 'whitespace', $1, %+ )/egsm;

            return sprintf( '/*@%s@*/ %s', $cmnt, $_[1]->[1] );
        }
        return sprintf( " %s", $_[1]->[1] );
    };

    $self->{'data_store'}->{'reggrp'}->[-1]->{'replacement'} = sub {
        return sprintf( "%s\x01%d\x01", $_[1]->[0], $_[2] );
    };

    $self->{'data_store'}->{'reggrp'}->[-1]->{'store'} = sub {
        return $_[1]->[1];
    };

    $self->{'store_data'} = [];
    $self->{'block_data'} = [];

    bless( $self, $class );

    return $self;
}

sub minify {
    my ( $self, $input, $opts );

    unless (
        ref( $_[0] ) and
        ref( $_[0] ) eq __PACKAGE__
    ) {
        $self = __PACKAGE__->init();

        shift( @_ ) unless ( ref( $_[0] ) );

        ( $input, $opts ) = @_;
    }
    else {
        ( $self, $input, $opts ) = @_;
    }

    if ( ref( $input ) ne 'SCALAR' ) {
        carp( 'First argument must be a scalarref!' );
        return undef;
    }

    my $javascript    = \'';
    my $cont    = 'void';

    if ( defined( wantarray ) ) {
        my $tmp_input = ref( $input ) ? ${$input} : $input;

        $javascript    = \$tmp_input;
        $cont        = 'scalar';
    }
    else {
        $javascript = ref( $input ) ? $input : \$input;
    }

    if ( ref( $opts ) ne 'HASH' ) {
        carp( 'Second argument must be a hashref of options! Using defaults!' ) if ( $opts );
        $opts = { 'compress' => 'clean', 'copyright' => '' };
    }
    else {
        $opts->{'compress'} ||= 'clean';
        unless (
            grep(
                $_ eq $opts->{'compress'},
                ( 'clean', 'minify', 'shrink', 'base62', 'obfuscate', 'best' )
            )
        ) {
            $opts->{'compress'} = 'clean';
        }

        if ( $opts->{'compress'} eq 'minify' ) {
            $opts->{'compress'} = 'clean';
        }
        elsif ( $opts->{'compress'} eq 'base62' ) {
            $opts->{'compress'} = 'obfuscate';
        }

        $opts->{'copyright'}    = ( $opts->{'copyright'} and $opts->{'compress'} eq 'clean' ) ? ( '/* ' . $opts->{'copyright'} . ' */' ) : '';
    }

    ${$javascript} =~ s/\r//gsm;
    ${$javascript} .= "\n";

    ${$javascript} =~ s/$self->{'comments'}->{'re_str'}/$self->_process_minify( 'comments', $1, %+ )/egsm;
    ${$javascript} =~ s/$self->{'clean'}->{'re_str'}/$self->_process_minify( 'clean', $1, %+ )/egsm;
    ${$javascript} =~ s/$self->{'whitespace'}->{'re_str'}/$self->_process_minify( 'whitespace', $1, %+ )/egsm;
    ${$javascript} =~ s/$self->{'concat'}->{'re_str'}/$self->_process_minify( 'concat', $1, %+ )/egsm;

    if ( $opts->{'compress'} ne 'clean' ) {
        ${$javascript} =~ s/$self->{'data_store'}->{'re_str'}/$self->_store_shrink( $1, %+ )/egsm;

        while( ${$javascript} =~ /$SHRINK_VARS->{'BLOCK'}/ ) {
            ${$javascript} =~ s/$SHRINK_VARS->{'BLOCK'}/$self->_encode_shrink( $1 )/egsm;
        }

        $self->_decode_shrink( $javascript, 'block_data', $SHRINK_VARS->{'ENCODED_BLOCK'} );

        my %shrunk_vars = map { $_ => 1 } ( ${$javascript} =~ /$SHRINK_VARS->{'SHRUNK'}/g );

        my $cnt = 0;
        foreach my $shrunk_var ( keys( %shrunk_vars ) ) {
            my $short_id;
            do {
                $short_id = $self->_encode52( $cnt++ );
            } while (
                ${$javascript} =~ /[^a-zA-Z0-9_\\x24\.]\Q$short_id\E[^a-zA-Z0-9_\\x24:]/
            );

            ${$javascript} =~ s/$shrunk_var/$short_id/g;
        }

        $self->_decode_shrink( $javascript, 'store_data', $SHRINK_VARS->{'ENCODED_DATA'} );

        $self->{'store_data'} = [];
        $self->{'block_data'} = [];
    }
    else {
        ${$javascript} = $opts->{'copyright'} . ${$javascript} if ( $opts->{'copyright'} );
    }


    if ( $opts->{'compress'} eq 'obfuscate' or $opts->{'compress'} eq 'best' ) {
        my $words = {};

        my @words = ${$javascript} =~ /$BASE62_VARS->{'WORDS'}/g;

        my $idx = 0;

        map {
            if ( exists( $words->{$_} ) ) {
                $words->{$_}->{'count'}++;
            }
            else {
                $words->{$_}->{'count'} = 1;
            }
        } @words;

        WORD: foreach my $word ( sort { $words->{$b}->{'count'} <=> $words->{$a}->{'count'} } keys( %{$words} ) ) {

            if ( exists( $words->{$word}->{'encoded'} ) and $words->{$word}->{'encoded'} eq $word ) {
                next WORD;
            }

            my $encoded = $self->_encode62( $idx );

            if ( exists( $words->{$encoded} ) ) {
                my $next = 0;
                if ( exists( $words->{$encoded}->{'encoded'} ) ) {
                    $words->{$word}->{'encoded'} = $words->{$encoded}->{'encoded'};
                    $words->{$word}->{'index'} = $words->{$encoded}->{'index'};
                    $words->{$word}->{'minus'} = length( $word ) - length( $words->{$word}->{'encoded'} );
                    $next = 1;
                }
                $words->{$encoded}->{'encoded'} = $encoded;
                $words->{$encoded}->{'index'} = $idx;
                $words->{$encoded}->{'minus'} = 0;
                $idx++;
                next WORD if ( $next );
                redo WORD;
            }

            $words->{$word}->{'encoded'} = $encoded;
            $words->{$word}->{'index'} = $idx;
            $words->{$word}->{'minus'} = length( $word ) - length( $encoded );

            $idx++;
        }

        my $packed_length = length( ${$javascript} );

        my ( @pk, @pattern ) = ( (), () );

        foreach (
            sort {
                $words->{$a}->{'index'} <=> $words->{$b}->{'index'}
            } keys( %{$words} )
        ) {
            $packed_length -= ( $words->{$_}->{'count'} * $words->{$_}->{'minus'} );

            if ( $words->{$_}->{'encoded'} ne $_ ) {
                push( @pk, $_ );
                push( @pattern, $words->{$_}->{'encoded'} );
            }
            else {
                push( @pk, '' );
                push( @pattern, '' );
            }
        }

        my $size = scalar( @pattern );

        splice( @pattern, 62 ) if ( scalar( @pattern ) > 62 );

        my $pd = join( '|', @pattern );

        $pd =~ s/$self->{'trim'}->{'re_str'}/$self->_process_minify( 'trim', $1, %+ )/egsm;

        unless ( $pd ) {
            $pd = '^$';
        }
        else {
            $pd = '[' . $pd . ']';

            if ( $size > 62 ) {
                $pd = '(' . $pd . '|';

                my $enc = $self->_encode62( $size );

                my ( $c ) = $enc =~ /(^.)/;
                my $ord = ord( $c );

                my $mul = length( $enc ) - 1;

                my $is62 = 0;

                if ( $ord >= 65 ) {
                    if ( $c eq 'Z' ) {
                        $mul += 1;
                        $is62 = 1;
                    }
                    else {
                        $pd .= '[0-9a';
                        if ( $ord > 97 ) {
                            $pd .= '-' . $c;
                        }
                        elsif ( $ord > 65 ) {
                            $pd .= '-zA-' . $c;
                        }
                        $pd .= ']';
                    }
                }
                elsif ( $ord == 57 ) {
                    $pd .= '0-9';
                }
                elsif ( $ord == 50 ) {
                    $pd .= '[12]';
                }
                elsif ( $ord == 49 ) {
                    $pd .= '1';
                }
                else {
                    $pd .= '[0-' . ( $ord - 48 ) . ']';
                }

                $pd .= '[0-9a-zA-Z]' . ( ( $mul > 1 ) ? '{' . $mul . '}' : '' );

                $mul-- if ( $is62 );

                if ( $mul > 1 ) {
                    for ( my $i = $mul; $i >= 2; $i-- ) {
                        $pd .= '|[0-9a-zA-Z]{' . $i . '}';
                    }
                }

                $pd .= ')';
            }
        }
        $packed_length += length( $pd );

        my $pk = join( '|', @pk );
        $pk =~ s/(?>\|+)$//;
        $packed_length += length( $pk );

        my $pc = length( $pk ) ? ( ( $pk =~ tr/|// ) + 1 ) : 0;
        $packed_length += length( $pc );

        my $pa = '[]';
        $packed_length += length( $pa );

        my $pe = $BASE62_VARS->{'ENCODE' . ( $pc > 10 ? $pc > 36 ? 62 : 36 : 10 )};
        $packed_length += length( $pe );


        $packed_length += length( $BASE62_VARS->{'UNPACK'} );
        $packed_length -= ( $BASE62_VARS->{'UNPACK'} =~ s/(%s|%d)/$1/g ) * 2;

        map {
            $packed_length -= length( $_ ) - 3;
        } ${$javascript} =~ s/((?>[\r\n]+))/$1/g;

        $packed_length += ${$javascript} =~ tr/\\\'/\\\'/;

        if ( $opts->{'compress'} eq 'obfuscate' or $packed_length <= length( ${$javascript} ) ) {

            ${$javascript} =~ s/$BASE62_VARS->{'WORDS'}/sprintf( "%s", $words->{$1}->{'encoded'} )/eg;

            ${$javascript}    =~ s/([\\'])/\\$1/g;
            #'
            ${$javascript}    =~ s/[\r\n]+/\\n/g;

            my $pp = ${$javascript};

            ${$javascript} = sprintf( $BASE62_VARS->{'UNPACK'}, $pe, $pd, $pp, $pa, $pc, $pk );
        }

    }

    return ${$javascript} if ( $cont eq 'scalar' );
}

sub _process_minify {
    my ( $self, $reg_name, $match, %match_hash ) = @_;

    my ( $midx ) = ( keys( %match_hash ) )[0] =~ /^_(\d+)$/;

    my @submatches = $match =~ /$self->{$reg_name}->{'reggrp'}->[$midx]->{'regexp'}/;
    map { $_ ||= ''; } @submatches;

    return $self->{$reg_name}->{'reggrp'}->[$midx]->{'replacement'} unless ( ref( $self->{$reg_name}->{'reggrp'}->[$midx]->{'replacement'} ) );

    return $self->{$reg_name}->{'reggrp'}->[$midx]->{'replacement'}->( $match, \@submatches ) if ( ref( $self->{$reg_name}->{'reggrp'}->[$midx]->{'replacement'} ) eq 'CODE' );

    return $match;
};

sub _store_shrink {
    my ( $self, $match, %match_hash ) = @_;

    my ( $midx ) = ( keys( %match_hash ) )[0] =~ /^_(\d+)$/;

    my @submatches = $match =~ /$self->{'data_store'}->{'reggrp'}->[$midx]->{'regexp'}/;
    map { $_ ||= ''; } @submatches;

    my $ret        = $self->{'data_store'}->{'reggrp'}->[$midx]->{'replacement'}->( $match, \@submatches, scalar( @{$self->{'store_data'}} ) );
    my $store    = $self->{'data_store'}->{'reggrp'}->[$midx]->{'store'}->( $match, \@submatches );

    push( @{$self->{'store_data'}}, $store );

    return $ret;
};

sub _decode_shrink {
    my ( $self, $string_ref, $data_name, $pattern ) = @_;

    while ( ${$string_ref} =~ /$pattern/ ) {
        ${$string_ref} =~ s/$pattern/$self->{$data_name}->[$1]/egsm;
    }
};

sub _encode_shrink {
    my ( $self, $match ) = @_;

    my ( undef, $prefix, $blocktype, $args, $block ) = $match =~ /$SHRINK_VARS->{'BLOCK'}/;

    $prefix ||= '';
    $blocktype ||= '';
    $args ||= '';
    my $replacement = '';
    if ( $blocktype eq 'function' ) {

        $self->_decode_shrink( \$block, 'block_data', $SHRINK_VARS->{'SCOPED'} );

        $args =~ s/\s*//g;

        $block = $args . $block;
        $prefix =~ s/$SHRINK_VARS->{'BRACKETS'}//;

        $args =~ s/^\(|\)$//g;

        my %block_vars = ();
        my $do_shrink = grep( $_ eq '_no_shrink_', split( /\s*,\s*/, $args ) ) ? 0 : 1;

        if ( $do_shrink ) {
            %block_vars = map { $_ => 1 } ( $block =~ /$SHRINK_VARS->{'VARS'}/g ), grep( $_ ne '$super', split( /\s*,\s*/, $args ) );
        }

        $self->_decode_shrink( \$block, 'block_data', $SHRINK_VARS->{'ENCODED_BLOCK'} );

        if ( $do_shrink ) {

            my $cnt = 0;
            foreach my $block_var ( keys( %block_vars ) ) {
                if ( length( $block_var ) ) {
                    my $pattern = sprintf( "%s%d", $SHRINK_VARS->{'PREFIX'}, $cnt );
                    while ( $block =~ /$SHRINK_VARS->{'PREFIX'}\Q$cnt\E\b/ ) {
                        $cnt++;
                    }

                    while ( $block =~ /[^a-zA-Z0-9_\\x24\.]\Q$block_var\E[^a-zA-Z0-9_\\x24:]/ ) {
                        $block =~ s/([^a-zA-Z0-9_\\x24\.])\Q$block_var\E([^a-zA-Z0-9_\\x24:])/sprintf( "%s\x02%d%s", $1, $cnt, $2 )/eg;
                    }

                    $block =~ s/([^{,a-zA-Z0-9_\\x24\.])\Q$block_var\E:/sprintf( "%s\x02%d:", $1, $cnt )/eg;

                    $cnt++;
                }
            }
        }
        $replacement = sprintf( "%s~%d~", $prefix, scalar( @{$self->{'block_data'}} ) );

        push( @{$self->{'block_data'}}, $block );
    }
    else {
        $replacement = sprintf( "~#%d~", scalar( @{$self->{'block_data'}} ) );

        push( @{$self->{'block_data'}}, $prefix . $block );
    }

    return $replacement;
};

sub _encode52 {
    my ( $self, $c ) = @_;

    my $m = $c % 52;

    my $ret = $m > 25 ? chr( $m + 39 ) : chr( $m + 97 );

    if ( $c >= 52 ) {
        $ret = $self->_encode52( int( $c / 52 ) ) . $ret;
    }

    $ret = substr( $ret, 1 ) . '0' if ( $ret =~ /^(do|if|in)$/ );

    return $ret;
};


sub _encode62 {
    my ( $self, $c ) = @_;

    my $m = $c % 62;

    my $ret = $m > 35 ? chr( $m + 29 ) : $m > 9 ? chr( $m + 87 ) : $m;

    if ( $c >= 62 ) {
        $ret = $self->_encode62( int( $c / 62 ) ) . $ret;
    }

    return $ret;
};

1;

__END__

=head1 NAME

JavaScript::Packer - Perl version of Dean Edwards' Packer.js

=head1 VERSION

Version 0.0401

=head1 DESCRIPTION

A JavaScript Compressor

This module is an adaptation of Dean Edwards' Packer.js.

Additional information: http://dean.edwards.name/packer/

=head1 SYNOPSIS

    use JavaScript::Packer;

    my $packer = JavaScript::Packer->init();

    $packer->minify( $javascript, $opts );

To return a scalar without changing the input simply use (e.g. example 2):

    my $ret = $packer->minify( $javascript, $opts );

For backward compatibility it is still possible to call 'minify' as a function:

    JavaScript::Packer::minify( $javascript, $opts );

The first argument must be a scalarref of javascript-code.

Second argument must be a hashref of options. Possible options are:

=over 4

=item compress

Defines compression level. Possible values are 'clean', 'shrink', 'obfuscate'
and 'best'.
Default value is 'clean'.
'best' uses 'shrink' or 'obfuscate' depending on which result is shorter. This
is recommended because especially when compressing short scripts the result
will exceed the input if compression level is 'obfuscate'.

For backward compatibility 'minify' and 'base62' will still work.

=item copyright

You can add a copyright notice on top of the script. The copyright notice will
only be added if the compression value is 'clean'.

=back

=head1 EXAMPLES

=over 4

=item Example 1

Common usage.

    #!/usr/bin/perl

    use strict;
    use warnings;

    use JavaScript::Packer;

    my $packer = JavaScript::Packer->init();

    open( UNCOMPRESSED, 'uncompressed.js' );
    open( COMPRESSED, '>compressed.js' );

    my $js = join( '', <UNCOMPRESSED> );

    $packer->minify( \$js, { 'compress' => 'best' } );

    print COMPRESSED $js;
    close(UNCOMPRESSED);
    close(COMPRESSED);

=item Example 2

A scalar is requested by the context. The input will remain unchanged.

    #!/usr/bin/perl

    use strict;
    use warnings;

    use JavaScript::Packer;

    my $packer = JavaScript::Packer->init();

    open( UNCOMPRESSED, 'uncompressed.js' );
    open( COMPRESSED, '>compressed.js' );

    my $uncompressed = join( '', <UNCOMPRESSED> );

    my $compressed = $packer->minify( \$uncompressed, { 'compress' => 'best' } );

    print COMPRESSED $compressed;
    close(UNCOMPRESSED);
    close(COMPRESSED);

=back

=head1 AUTHOR

Merten Falk, C<< <nevesenin at cpan.org> >>

=head1 BUGS

Please report any bugs or feature requests to
C<bug-javascript-packer at rt.cpan.org>, or through the web interface at
L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=JavaScript-Packer>.

=head1 SUPPORT

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

perldoc JavaScript::Packer


=head1 COPYRIGHT & LICENSE

Copyright 2008-2010 Merten Falk, all rights reserved.

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

=cut