view release on metacpan or  search on metacpan

lib/Apache2/Response/FileMerge.pm  view on Meta::CPAN

        my ( $location, $file );
        ( $location, $file, $type ) = $uri =~ /^(.*)\/(.*)\.(js|css)$/;
        my $root                    = $DOC_ROOT || $r->document_root();

        _substitute_vars( \$location, \$file ) if ( %VARS );

        foreach my $input ( split( $SEPARATOR, $file ) ) {
            $input     =~ s/\./\//g;
            $content  .= ( _load_content( $root, $location, $input, $type ) || '' );
        }

        my $has_content = ! ! $content;
        
        {
            no strict 'refs';
            $content  = &{ "_minimize_$type" }( 'input' => $content ) if ( $DO_MIN_JS || $DO_MIN_CSS );
        }

        my $delta = _time() - $start;
        $content  = sprintf(
            STATS_PATTERN,
            $uri,
            $mtime,
            $DO_MODIFIED,
            $DO_MIN_JS,
            $DO_MIN_CSS,
            $SEPARATOR,
            $DO_COMPRESS,
            $DOC_ROOT,
            $APPEND_INC_NAME,
            $delta,
            $content
        ) if ( $DO_STATS );

        $r->content_type( $CONTENT_TYPES{$type} || 'text/plain' );
        my $headers                 = $r->headers_out();
        $headers->{LAST_MODIFIED()} = time2str($mtime);
        $cache{$uri}{'mtime'}       = $mtime;

        if ( $DO_COMPRESS ) {
            $r->content_encoding('gzip');
            $content = _compress($content);
        }

        $r->print($content);

        return ( $has_content ) ? Apache2::Const::OK 
                                : Apache2::Const::NOT_FOUND;
    }

    {
        my %loaded;

        sub _init {
            my( $r ) = @_;

            %loaded  = ();
            %VARS    = map {
                my( $k, $v ) = split(/=/);
                $k => URI::Escape::uri_unescape( ( $v || '' ) )
            } split( /[&;]/, $r->args() );
        }

        sub _load_content {
            my ( $root, $location, $file_name, $type ) = @_;
            return unless ( $file_name );

            _substitute_vars( \$location, \$file_name ) if ( %VARS );

            $LOG->debug( "\$location = $location" );
            $location =~ s/\/$//g;
            $location = "$location/";
            $LOG->debug( "\$location = $location" );

            $file_name       =  "${location}${file_name}" if ( $location );
            $file_name       =  "$root/$file_name.$type";
            my $cname        =  $file_name;
            $cname           =~ s/\///g;
            my $this_mtime   =  ( stat($file_name) )[9];
            $mtime         ||= 0;
            $mtime           =  $this_mtime if ( ! $mtime || $mtime > ( $this_mtime || 0 ) );
            my $content      =  '';

            if ( exists( $loaded{$cname} ) ) {
                $LOG->debug("Attempting to include \"$file_name\" more than once");
                return;
            }
            else {
                $loaded{$cname} = \0;
                $LOG->debug("Loading: $file_name");        
            }

            if ( open( my $handle, '<', $file_name ) ) {
                {
                    local $/ = undef;
                    $content = <$handle>;
                }
                close( $handle );
            }
            else {
                $LOG->error("File not found: \"$file_name\".");
                return;
            }

            $content = _sf_escape($content);
            while ( $content =~ /(\/\\\*\\\*\s*[Ii]nc(?:lude)\s*([-\{\}\w\.\/]+)\s*\\\*\\\*\/)/sgm ) {
                my ( $matcher, $file )      =  ( $1, $2 );
                my ( $inc_file, $inc_type ) =  $file =~ /^(.*?)\.(js|css)$/;
                my $new_file_content        =  _load_content( $root, '', $inc_file, $inc_type ) || '';
                $new_file_content           = sprintf( COMMENT_PATTERN, "$root/$inc_file" ) 
                                                . "\n\n$new_file_content" if ( $APPEND_INC_NAME );
                $content                    =~ s/\/\\\*\\\*\s*[Ii]nc(?:lude)\s*[-\{\}\w\.\/]+\s*\\\*\\\*\//$new_file_content/sm;
            }

            return _sf_unescape($content);
        }

        sub _substitute_vars {
            foreach my $string ( @_ ) {
                while( $$string =~ /\{\s*([\w-]+)\s*\}/g ) {
                    my $varname = $1;
                    next unless defined $VARS{$varname};
                    $$string =~ s/\{\s*$varname\s*\}/$VARS{$varname}/g;
                }
            }
        }
    }
}

sub append_inc_name {
    return $APPEND_INC_NAME = pop;
}

sub document_root {
    return $DOC_ROOT = pop;
}

sub file_separator {
    return $SEPARATOR = pop;
}

sub cache {
    return $DO_MODIFIED ||= ! ! 1;
}

sub stats {
    $DO_STATS = ! ! 1;

    $DO_STATS = _register_function(
        'Time::HiRes',
        '_time',
        \&Time::HiRes::time
    );

    return $DO_STATS;
}

sub minimize {
    $DO_MIN_JS  = ! ! 1;
    $DO_MIN_CSS = ! ! 1;

    $DO_MIN_JS = _register_function(
        'JavaScript::Minifier',
        '_minimize_js',
        \&JavaScript::Minifier::minify
    );

    $DO_MIN_CSS = _register_function(
        'CSS::Minifier',
        '_minimize_css',
        \&CSS::Minifier::minify
    );

    return $DO_MIN_JS || $DO_MIN_CSS;
}

sub compress {
    $DO_COMPRESS = ! ! 1;

    $DO_COMPRESS = _register_function(
        'Compress::Zlib',
        '_compress',
        \&Compress::Zlib::memGzip
    );

    return $DO_COMPRESS;
}

sub _sf_escape {
    my ($escaper) = @_; 
    $escaper =~ s/\*/\\*/g;
    return $escaper;
}

sub _sf_unescape {
    my ($escaper) = @_;
    $escaper =~ s/\\\*/\*/g;
    return $escaper;
}

sub _register_function {
    my ( $class, $func, $ref ) = @_;

    eval {
        eval("use $class ();");
        if ( my $e = $@ ) {
            print STDERR "\"$class\" not installed, cannot use\n";
            return ! ! 0;
        }
        else {
            {
                no strict 'refs';
                no warnings 'redefine';
                *{$func} = $ref;
            }
            return ! ! 1;
        }
    }
}

sub _minimize_js  { return pop; }
sub _minimize_css { return pop; }
sub _compress($)  { return pop; }
sub _time()       { return 0;   }

1;

__END__

=head1 NAME

Apache2::Response::FileMerge - Easily merge JavaScript and CSS into a single file dynamically. 

=head1 SYNOPSIS

L<Apache2::Response::FileMerge> gives you the ability to merge, include, minimize
and compress multiple JavaScript and CSS files into a single file (respective of type)
to place anywhere into an HTML document.  All handled by an easy to configure mod_perl
Response handler with absolutely no alteration needed for existing JavaScript or CSS.

=head1 DESCRIPTION

=head2 Problem(s) Solved

There are a number of best practices on how to generate content into a web page.
Yahoo!, for example, publishes such a document (http://developer.yahoo.com/performance/rules.html)
and is relatively well respected as it contains a number of good and useful tips 
for high-performance sites along with sites that are less strained but are still
trying to conserve the resources they have.  The basis of this module will contribute
to the resolution of three of these points and one that is not documented there.

=head2 File Merging

A common problem with the standard development of sites is the number of <script/>,
<style/> and other static file includes that may/must be made in a single page.
Each requiring time, connections... overhead.  Although this isn't a revolutionary
solution, it is in terms of simple mod_perl handlers that can easily be integrated
into a single site.  Look to 'URI PROTOCOL' to see how this module will let you