CSS::Squish - Compact many CSS files into one big file

  use CSS::Squish;
  my $concatenated = CSS::Squish->concatenate(@files);

  my $squisher = CSS::Squish->new( roots => ['/root1', '/root2'] );
  my $concatenated = $squisher->concatenate(@files);

    roots: /www/overlay/, /www/shared/

    $squisher->concatenate('/css/main.css');

    ->file_handle('/css/main.css');
        ->resolve_file('/css/main.css');
        <- '/www/shared/css/main.css';
    <- handle;

    content parsing
    find '@import url(nav.css)'
    -> resolve_uri('nav.css', '/css/main.css');
    <- '/css/nav.css';
        ... recursivly process file
    find '@import url(/css/another.css)'
    -> resolve_uri('/css/another.css', '/css/main.css');
    <- '/css/another.css'
    ...

    package My::CSS::Squish;
    use base qw(CSS::Squish);

    sub file_handle {
        my $self = shift;
        my $file = shift;

        my $content = $self->my_prepare_content($file);
        return undef unless defined $content;

        open my $fh, "<", \$content or warn "Couldn't open handle: $!";
        return $fh;
    }

use 5.008;
use strict;
use warnings;

package CSS::Squish;

$CSS::Squish::VERSION = '0.10';

# Setting this to true will enable lots of debug logging about what
# CSS::Squish is doing
$CSS::Squish::DEBUG = 0;

use File::Spec;
use Scalar::Util qw(blessed);
use URI;
use URI::file;

#
# This should be a decently close CSS 2.1 compliant parser for @import rules
#
# XXX TODO: This does NOT deal with comments at all at the moment.  Which
# is sort of a problem.
# 

my @ROOTS = qw( );

my @MEDIA_TYPES = qw(all aural braille embossed handheld print
                     projection screen tty tv);
my $MEDIA_TYPES = '(?:' . join('|', @MEDIA_TYPES) . ')';
my $MEDIA_LIST  = qr/$MEDIA_TYPES(?:\s*,\s*$MEDIA_TYPES)*/;

my $AT_IMPORT = qr/^\s*                     # leading whitespace
                                        \@import\s+             # @import
                                                (?:url\(            #   url(
                                                \s*                 #   optional whitespace
                                                (?:"|')?            #   optional " or '
                                            |                     # or
                                                (?:"|'))            #   " or '
                                            (.+?)                 # the filename
                                                (?:(?:"|')?         #   optional " or '
                                                \s*                 #   optional whitespace
                                                \)                  #   )
                                            |                     # or
                                                (?:"|'))            #   " or '
                                        (?:\s($MEDIA_LIST))?    # the optional media list
                                        \;                      # finishing semi-colon
                                      \s*$                     # trailing whitespace
                                    /x;

sub new {
    my $proto = shift;
    return bless {@_}, ref($proto) || $proto;
}

sub concatenate {
    my $self   = shift;
    my $string = '';
    
    $self->_debug("Opening scalar as file");
    
    open my $fh, '>', \$string or die "Can't open scalar as file! $!";
    $self->concatenate_to($fh, @_);

    $self->_debug("Closing scalar as file");
    close $fh;

    return $string;
}

sub concatenate_to {
    my $self = shift;
    my $dest = shift;

    $self->_debug("Looping over list of files: ", join(", ", @_), "\n");

    my %seen = ();
    while ( my $file = shift @_ ) {

        next if $seen{ $file }{'all'}++;

        my $fh = $self->file_handle( $file );
        unless ( defined $fh ) {
            $self->_debug("Skipping '$file'...");
            print $dest qq[/* WARNING: Unable to find/open file '$file' */\n];
            next;
        }
        $self->_concatenate_to( $dest, $fh, $file, \%seen );
    }
}

sub _concatenate_to {
    my $self = shift;
    my $dest = shift;
    my $fh   = shift;
    my $file = shift;
    my $seen = shift || {};

    while ( my $line = <$fh> ) {
        if ( $line =~ /$AT_IMPORT/o ) {
            my $import = $1;
            my $media  = $2;

            $self->_debug("Processing import '$import'");

            # resolve URI against the current file and get the file path
            # which is always relative to our root(s)
            my $path = $self->resolve_uri( $import, $file );
            unless ( defined $path ) {
                $self->_debug("Skipping import because couldn't resolve URL");
                print $dest $line;
                next;
            }

            if ( $seen->{ $path }{'all'} ) {
                $self->_debug("Skipping import as it was included for all media types");
                print $dest "/** Skipping: \n", $line, "  */\n\n";
                next;
            }

            if ( $media ) {
                my @list = sort map lc, split /\s*,\s*/, ($media||'');
                if ( grep $_ eq 'all', @list ) {
                    @list = ();
                }
                $media = join ', ', @list;
            }
            if ( $seen->{ $path }{ $media || 'all' }++ ) {
                $self->_debug("Skipping import as it's recursion");
                print $dest "/** Skipping: \n", $line, "  */\n\n";
                next;
            }

            # Look up the new file in root(s), so we can leave import
            # if something is wrong
            my $new_fh = $self->file_handle( $path );
            unless ( defined $new_fh ) {
                $self->_debug("Skipping import of '$import'");

                print $dest qq[/* WARNING: Unable to find import '$import' */\n];
                print $dest $line;
                next;
            }

            print $dest "\n/**\n  * From $file: $line  */\n\n";

            if ( defined $media ) {
                print $dest "\@media $media {\n";
                $self->_concatenate_to($dest, $new_fh, $path, $seen);
                print $dest "}\n";
            }
            else {
                $self->_concatenate_to($dest, $new_fh, $path, $seen);
            }

            print $dest "\n/** End of $import */\n\n";
        }
        else {
            print $dest $line;
            last if not $line =~ /^\s*$/;
        }
    }
    $self->_debug("Printing the rest");
    local $_;
    print $dest $_ while <$fh>;
    close $fh;
}

sub roots {
    my $self = shift;
    my @res;
    unless ( blessed $self ) {
        @ROOTS = @_ if @_;
        @res = @ROOTS;
    } else {
        $self->{'roots'} = [ grep defined, @_ ] if @_;
        @res = @{ $self->{'roots'} };
    }
    $self->_debug("Roots are: ". join ", ", map "'$_'", @res);
    return @res;
}

sub file_handle {
    my $self = shift;
    my $file = shift;

    my $path = $self->resolve_file( $file );
    unless ( defined $path ) {
        $self->_debug("Couldn't find '$file' in root(s)");
        return undef;
    }

    my $fh;
    unless ( open $fh, '<', $path ) {
        $self->_debug("Skipping '$file' ($path) due to error: $!");
        return undef;
    }
    return $fh;
}

sub resolve_file {
    my $self = shift;
    my $file = shift;

    $self->_debug("Looking for '$file'");
    my @roots = $self->roots;
    unless ( @roots ) {
        return undef unless -e $file;
        return $file;
    }

    foreach my $root ( @roots ) {
        $self->_debug("Searching in '$root'");
        my @spec = File::Spec->splitpath( $root, 1 );
        my $path = File::Spec->catpath( @spec[0,1], $file );

        return $path if -e $path;
    }
    return undef;
}

sub _resolve_file {
    my ($self, $file, @roots) = @_;
    require Carp;
    Carp::carp("You called ->_resolve_file($file, ...). The method is deprecated!");
    return $file;
}

sub resolve_uri {
    my $self = shift;
    my $uri_str = shift;
    my $base_file = shift;

    my $uri = URI->new( $uri_str, 'http' );

    if ( defined $uri->scheme || defined $uri->authority ) {
        $self->_debug("Skipping uri because it's external");
        return undef;
    }

    my $strip_leading_slash = 0;
    unless ( $base_file =~ m{^/} ) {
        $base_file = '/'. $base_file;
        $strip_leading_slash = 1;
    }
    my $base_uri = URI::file->new( $base_file );

    my $path = $uri->abs( $base_uri )->path;
    $path =~ s{^/}{} if $strip_leading_slash;
    return $path;
}

sub _debug {
    my $self = shift;
    warn( ( caller(1) )[3], ": ", @_, "\n") if $CSS::Squish::DEBUG;
}

1;