File Coverage

blib/lib/JSAN/ServerSide.pm

Criterion	Covered	Total	%
statement	64	65	98.4
branch	4	4	100.0
condition	2	3	66.6
subroutine	15	16	93.7
pod	4	4	100.0
total	89	92	96.7

package JSAN::ServerSide;

use strict;
use warnings;

our $VERSION = '0.06';


use URI::ToDisk;
use JSAN::Parse::FileDeps;
use Params::Validate qw( validate SCALAR );


sub new
{
    my $class = shift;
    my %p = validate( @_,
                      { js_dir => { type => SCALAR },
                        uri_prefix => { type => SCALAR },
                      },
                    );

    my $location = URI::ToDisk->new( $p{js_dir}, $p{uri_prefix} );

    return bless { location => $location }, $class;
}

sub add
{
    my $self = shift;
    my $js_class = shift;

    $self->_record_dependencies($js_class);

    push @{ $self->{classes} }, $js_class;
}

sub _record_dependencies
{
    my $self     = shift;
    my $js_class = shift;

    my $js_file = $self->_class_to_file($js_class);

    my $last_mod = _last_mod($js_file);

    return if $self->{last_checked}{$js_class} && $last_mod <= $self->{last_checked}{$js_class};

    my @deps = JSAN::Parse::FileDeps->library_deps($js_file);

    $self->{dependencies}{$js_class} = [ @deps ];
    $self->{last_checked}{$js_class} = time;

    $self->_record_dependencies($_) for @deps;
}

# separate primarily so it can be mocked for tests
sub _last_mod { (stat $_[0])[9] }

sub _class_to_file
{
    my $self = shift;

    $self->_class_to_path( shift )->path();
}

sub _class_to_path
{
    my $self     = shift;
    my $js_class = shift;

    my @pieces = split /\./, $js_class;
    $pieces[-1] .= '.js';

    return $self->{location}->catfile(@pieces);
}

sub uris
{
    my $self = shift;

    return map { $self->_class_to_uri($_) } $self->_classes();
}

sub files
{
    my $self = shift;

    return map { $self->_class_to_file($_) } $self->_classes();
}

sub _classes
{
    my $self = shift;

    my %seen;
    my @classes;
    for my $c ( @{ $self->{classes} } )
    {
        $self->_follow_deps( $c, \@classes, \%seen );
    }

    return @classes;
}

sub _follow_deps
{
    my $self    = shift;
    my $c       = shift;
    my $classes = shift;
    my $seen    = shift;

    return if $seen->{$c};
    $seen->{$c} = 1;

    for my $d ( @{ $self->{dependencies}{$c} } )
    {
        $self->_follow_deps( $d, $classes, $seen );
    }

    push @$classes, $c;
}

sub _class_to_uri
{
    my $self = shift;

    $self->_class_to_path( shift )->uri();
}


1;

__END__