The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package Mojolicious::Plugin::AssetTagHelpers;

BEGIN {
    $Mojolicious::Plugin::AssetTagHelpers::VERSION = '0.004';
}

use strict;

# Other modules:
use base qw/Mojolicious::Plugin/;
use Mojo::ByteStream;
use Regexp::Common qw/URI/;
use Mojo::UserAgent;
use HTTP::Date;
use File::stat;
use File::Spec::Functions;
use File::Basename;

# Module implementation
#

__PACKAGE__->attr('asset_dir');
__PACKAGE__->attr('asset_host');
__PACKAGE__->attr('relative_url_root');
__PACKAGE__->attr( 'javascript_dir' => '/javascripts' );
__PACKAGE__->attr( 'stylesheet_dir' => '/stylesheets' );
__PACKAGE__->attr( 'image_dir'      => '/images' );
__PACKAGE__->attr( 'javascript_ext' => '.js' );
__PACKAGE__->attr( 'stylesheet_ext' => '.css' );
__PACKAGE__->attr(
    'image_options' => sub { [qw/width height class id border/] } );
__PACKAGE__->attr('app');
__PACKAGE__->attr( 'true' => 1 );

sub register {
    my ( $self, $app, $conf ) = @_;
    $self->asset_dir( $app->static->root );
    $self->app($app);
    if ( my $url = $self->compute_relative_url( @_[ 1, -1 ] ) ) {
        $self->relative_url_root($url);
        $app->log->debug("relative url root: $url");

# -- in case of non-default value strip off the name before serving the assets
        $app->static->root($url);
    }
    if ( my $host = $self->compute_asset_host( @_[ 1, -1 ] ) ) {
        $self->asset_host($host);
    }

    # -- image tag
    $app->helper(
        image_tag => sub {
            my ( $c, $name, %options ) = @_;
            my $tags;
            if (%options) {
                if ( defined $options{size} ) {
                    $tags
                        = qq/height="$options{size}" width="$options{size}"/;
                }
                if ( defined $options{alt} ) {
                    $tags .= qq/alt="$options{alt}"/;
                }
                for my $opt_name ( @{ $self->image_options } ) {
                    $tags .= qq/ $opt_name="$options{$opt_name}"/
                        if defined $options{$opt_name};
                }
            }
            else {
                my $alt_name = $self->compute_alt_name($name);
                $tags .= qq/alt="$alt_name"/;
            }

            my $source = $self->compute_image_path( $name, $self->true );
            return Mojo::ByteStream->new(qq{<img src="$source" $tags/>});
        }
    );

    # -- javascript tag
    $app->helper(
        javascript_include_tag => sub {
            my ( $c, $name ) = @_;
            my $source = $self->compute_javascript_path( $name, $self->true );
            return Mojo::ByteStream->new(
                qq{<script src="$source" type="text/javascript"></script>});
        }
    );

    # -- stylesheet tag
    $app->helper(
        stylesheet_link_tag => sub {
            my ( $c, $name, %option ) = @_;
            my $source = $self->compute_stylesheet_path( $name, $self->true );
            my $media
                = $option{media}
                ? qq{media="$option{media}}
                : qq{media="screen"};

            return Mojo::ByteStream->new(
                qq{<link href="$source" $media rel="stylesheet" type="text/css" />}
            );
        }
    );

    $app->helper(
        'stylesheet_path' => sub {
            my ( $c, $path ) = @_;
            return Mojo::ByteStream->new(
                $self->compute_stylesheet_path($path) );
        }
    );

    $app->helper(
        'javascript_path' => sub {
            my ( $c, $path ) = @_;
            return Mojo::ByteStream->new(
                $self->compute_javascript_path($path) );
        }
    );

    $app->helper(
        'image_path' => sub {
            my ( $c, $path ) = @_;
            return Mojo::ByteStream->new( $self->compute_image_path($path) );
        }
    );
}

sub compute_relative_url {
    my ( $self, $app, $conf ) = @_;
    my $url;
    if ( $app->can('config') and defined $app->config->{relative_url_root} ) {
        $url = $app->config->{relative_url_root};
    }

    if ( defined $conf and defined $conf->{relative_url_root} ) {
        $url = $conf->{relative_url_root};
    }
    $url;
}

sub compute_asset_host {
    my ( $self, $app, $conf ) = @_;
    my $host;
    if ( $app->can('config') and defined $app->config->{asset_host} ) {
        $host = $app->config->{asset_host};
    }

    if ( defined $conf and defined $conf->{asset_host} ) {
        $host = $conf->{asset_host};
    }
    $host;
}

sub compute_alt_name {
    my ( $self, $name ) = @_;
    my $img_regexp = qr/^([^.]+)\.(jpg|png|gif)$/;
    if ( $name =~ $RE{URI}{HTTP} ) {
        my $img_name = basename $name;
        return ucfirst $1 if $img_name =~ $img_regexp;
        return ucfirst $img_name;
    }

    return ucfirst $1 if $name =~ $img_regexp;
    return ucfirst $name;
}

sub compute_asset_id {
    my ( $self, $file ) = @_;
    if ( $file =~ $RE{URI}{HTTP} ) {
        my $tx = Mojo::UserAgent->new->head($file);
        if ( my $res = $tx->success ) {
            my $asset_id = str2time( $res->headers->last_modified );
            return $asset_id;
        }
        else {
            return;
        }
    }

    my $full_path = catfile( $self->asset_dir, $file );
    if ( -e $full_path ) {
        my $st = stat($full_path);
        return $st->mtime;
    }
}

sub compute_image_path {
    my ( $self, $name, $default ) = @_;
    my $image_path
        = $default
        ? $self->compute_asset_path( catfile( $self->image_dir, $name ) )
        : $self->compute_asset_path($name);
    my $asset_id
        = $default
        ? $self->compute_asset_id( catfile( $self->image_dir, $name ) )
        : $self->compute_asset_id($name);

    return $image_path . '?' . $asset_id if $asset_id;
    $image_path;
}

sub compute_javascript_path {
    my ( $self, $name, $default ) = @_;
    my ( $js_path, $asset_id );
    if ( $name !~ $RE{URI}{HTTP} ) {
        $name = $name . $self->javascript_ext if $name !~ /\.js$/;
    }

    $js_path
        = $default
        ? $self->compute_asset_path( catfile( $self->javascript_dir, $name ) )
        : $self->compute_asset_path($name);
    $asset_id
        = $default
        ? $self->compute_asset_id( catfile( $self->javascript_dir, $name ) )
        : $self->compute_asset_id($name);

    return $js_path . '?' . $asset_id if $asset_id;
    $js_path;
}

sub compute_stylesheet_path {
    my ( $self, $name, $default ) = @_;
    my ( $css_path, $asset_id );
    if ( $name !~ $RE{URI}{HTTP} ) {
        $name = $name . $self->stylesheet_ext if $name !~ /\.css$/;
    }

    $css_path
        = $default
        ? $self->compute_asset_path( catfile( $self->stylesheet_dir, $name ) )
        : $self->compute_asset_path($name);

    $asset_id
        = $default
        ? $self->compute_asset_id( catfile( $self->stylesheet_dir, $name ) )
        : $self->compute_asset_id($name);

    return $css_path . '?' . $asset_id if $asset_id;
    $css_path;
}

sub compute_asset_path {
    my ( $self, $file ) = @_;
    return $file if $file =~ $RE{URI}{HTTP};    ## -- full http url
    my $path
        = $self->relative_url_root
        ? $self->relative_url_root . $file
        : $file;
    $path = $self->asset_host ? $self->asset_host . '/' . $path : $path;
    $path;
}

1;    # Magic true value required at end of module

=pod

=head1 NAME

Mojolicious::Plugin::AssetTagHelpers

=head1 VERSION

version 0.004

=head1 NAME

B<Mojolicious::Plugin::AssetTagHelpers> - [Tag helpers for javascripts,images and
stylesheets]

=head1 AUTHOR

Siddhartha Basu <biosidd@gmail.com>

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2010 by Siddhartha Basu.

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

=cut

__END__