view release on metacpan or  search on metacpan

lib/Catalyst/Controller/Combine.pm  view on Meta::CPAN

    $self->{replacement_for} = {};  # replacements for every full path
    $self->{seen}  = {}; # easy lookup of parts and count of dependencies
    foreach my $file (@_) {
        my $base_name = $file;
        $base_name =~ s{\.$ext\z}{}xms;

        $self->_check_dependencies($c, $base_name, ['', ".$ext"]);
    }

    return;
}

#
# check dependencies on files
#
sub _check_dependencies {
    my $self = shift;
    my $c = shift;
    my $base_name = shift;
    my $extensions = shift;
    my $depends = shift || 0;

    my $dependency_for = $self->depend;

    #
    # check if we already saw this file. Update dependency flag
    #
    if (exists($self->{seen}->{$base_name})) {
        $self->{seen}->{$base_name} ||= $depends;
        return;
    }

    if ($dependency_for &&
        ref($dependency_for) eq 'HASH' &&
        exists($dependency_for->{$base_name})) {
        #
        # we have a dependency -- resolve it.
        #
        my @depend_on = ref($dependency_for->{$base_name}) eq 'ARRAY'
                        ? @{$dependency_for->{$base_name}}
                        : $dependency_for->{$base_name};
        $self->_check_dependencies($c, $_, $extensions, 1)
            for @depend_on;
    }

    #
    # add the file if existing
    #
    my $dir = $c->path_to('root', $self->dir)->resolve;
    foreach my $file_path (map { $dir->file("$base_name$_") } @{$extensions}) {
        next if (!-f $file_path);
        
        # the file we want exists. Time to do a security check
        # hint: a call to resolve() will die under windows
        #       if the path requested does not exist on the filesystem.
        #       therefore, we check as late as possible
        $dir->subsumes($file_path->resolve)
            or die 'security violation - tried to access file outside of: '
                   . $self->dir();
        
        # looks like we are secure -- are there any secret unicodes
        # we forgot to double-check? *g*
        push @{$self->{parts}}, $base_name;
        push @{$self->{files}}, $file_path;
        $self->{seen}->{$base_name} = $depends;
        
        # check replacements
        return if (!$self->replace 
                || ref($self->replace) ne 'HASH' 
                || !scalar(keys(%{$self->replace})));
        foreach my $glob (keys(%{$self->replace})) {
            next if (!match_glob($glob, $base_name));
            my $replacements = $self->replace->{$glob};
            next if (!$replacements 
                  || ref($replacements) ne 'ARRAY' 
                  || !scalar(@{$replacements}));
            push @{$self->{replacement_for}->{$file_path}}, @{$replacements};
        }
        
        # done
        return;
    }

    $c->log->warn("$base_name.* --> NOT EXISTING, ignored");
    return;
}

=head1 GOTCHAS

Please do not use C<namespace::autoclean> if you intend to enable a minifier.
The black magic behind the scenes tries to determine your intention to minify
by searching for a sub called C<minify> inside the controller's package.
However, this sub is imported by eg C<JavaScript::Minifier::XS> and will be
kicked out of the controller by C<namespace::autoclean>.

=head1 AUTHOR

Wolfgang Kinkeldei, E<lt>wolfgang@kinkeldei.deE<gt>

=head1 LICENSE

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

=cut

1;