[Bps-public-commit] r9557 - in CSS-Squish: lib/CSS t
ruz at bestpractical.com
ruz at bestpractical.com
Tue Nov 6 04:30:56 EST 2007
Author: ruz
Date: Tue Nov 6 04:30:49 2007
New Revision: 9557
Modified:
CSS-Squish/Makefile.PL
CSS-Squish/lib/CSS/Squish.pm
CSS-Squish/t/02-edge-cases.t
CSS-Squish/t/07-basic-extra-roots.t
Log:
* huge refactoring of the code to support subclassing
of the module
Modified: CSS-Squish/Makefile.PL
==============================================================================
--- CSS-Squish/Makefile.PL (original)
+++ CSS-Squish/Makefile.PL Tue Nov 6 04:30:49 2007
@@ -6,6 +6,9 @@
VERSION_FROM => 'lib/CSS/Squish.pm',
PREREQ_PM => {
'File::Spec' => 0,
+ 'URI' => 0,
+ 'URI::file' => 0,
+ 'Scalar::Util' => 0,
'Test::LongString' => 0,
},
($] >= 5.005 ? ## Add these new keywords supported since 5.005
Modified: CSS-Squish/lib/CSS/Squish.pm
==============================================================================
--- CSS-Squish/lib/CSS/Squish.pm (original)
+++ CSS-Squish/lib/CSS/Squish.pm Tue Nov 6 04:30:49 2007
@@ -7,10 +7,12 @@
# Setting this to true will enable lots of debug logging about what
# CSS::Squish is doing
-$CSS::Squish::DEBUG = 0;
+$CSS::Squish::DEBUG = 0;
use File::Spec;
use Scalar::Util qw(blessed);
+use URI;
+use URI::file;
=head1 NAME
@@ -18,8 +20,11 @@
=head1 SYNOPSIS
- use CSS::Squish;
- my $concatenated = CSS::Squish->concatenate(@files);
+ use CSS::Squish;
+ my $concatenated = CSS::Squish->concatenate(@files);
+
+ my $squisher = CSS::Squish->new( roots => ['/root1', '/root2'] );
+ my $concatenated = $squisher->concatenate(@files);
=head1 DESCRIPTION
@@ -50,7 +55,7 @@
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*)*?$MEDIA_TYPES/;
+my $MEDIA_LIST = qr/$MEDIA_TYPES(?:\s*,\s*$MEDIA_TYPES)*/;
my $AT_IMPORT = qr/^\s* # leading whitespace
\@import\s+ # @import
@@ -70,7 +75,23 @@
\s*$ # trailing whitespace
/x;
-=head1 METHODS
+=head1 COMMON METHODS
+
+=head2 new( [roots=>[...]] )
+
+A constructor. For backward compatibility with versions prior to 0.06
+you can still call everything as a class method, but should remember
+that roots are shared between all callers in this case.
+
+if you're using persistent environment (like mod_perl) then it's very
+recomended to use objects.
+
+=cut
+
+sub new {
+ my $proto = shift;
+ return bless {@_}, ref($proto) || $proto;
+}
=head2 B<CSS::Squish-E<gt>concatenate(@files)>
@@ -83,11 +104,6 @@
=cut
-sub new {
- my $proto = shift;
- return bless {@_}, ref($proto) || $proto;
-}
-
sub concatenate {
my $self = shift;
my $string = '';
@@ -108,95 +124,116 @@
my $dest = shift;
$self->_debug("Looping over list of files: ", join(", ", @_), "\n");
-
- FILE:
- while (my $file = shift @_) {
- my $fh;
-
- $self->_debug("Opening '$file'");
- if (not open $fh, '<', $file) {
- $self->_debug("Skipping '$file' due to error");
- print $dest qq[/* WARNING: Unable to open file '$file': $! */\n];
- next FILE;
+
+ 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;
}
-
- IMPORT:
- while (my $line = <$fh>) {
- if ($line =~ /$AT_IMPORT/o) {
- my $import = $1;
- my $media = $2;
-
- $self->_debug("Processing import '$import'");
-
- if ( $import =~ m{^https?://} ) {
- $self->_debug("Skipping import because it's a remote URL");
-
- # Skip remote URLs
- print $dest $line;
- next IMPORT;
- }
+ $self->_concatenate_to( $dest, $fh, $file, \%seen );
+ }
+}
- # We need the path relative to where we're importing it from
- my @spec = File::Spec->splitpath( $file );
+sub _concatenate_to {
+ my $self = shift;
+ my $dest = shift;
+ my $fh = shift;
+ my $file = shift;
+ my $seen = shift || {};
- # This first searches any user-specified roots for the
- # imported file and if that fails, tries to find it
- # relative to the importing file
- my $import_path = $self->_resolve_file(
- $import,
- $self->roots,
- File::Spec->catpath( @spec[0,1], '' ),
- );
-
- if ( not defined $import_path ) {
- $self->_debug("Skipping import of '$import'");
-
- print $dest qq[/* WARNING: Unable to find import '$import' */\n];
- print $dest $line;
- next IMPORT;
- }
+ 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 ($import_path eq $file) {
- $self->_debug("Skipping import because it's a loop");
-
- # We're in a direct loop, don't import this
- print $dest "/** Skipping: \n", $line, " */\n\n";
- next IMPORT;
- }
+ if ( $seen->{ $path }{'all'} ) {
+ $self->_debug("Skipping import as it was included for all media types");
+ print $dest "/** Skipping: \n", $line, " */\n\n";
+ next;
+ }
- print $dest "\n/**\n * From $file: $line */\n\n";
-
- if (defined $media) {
- print $dest "\@media $media {\n";
- $self->concatenate_to($dest, $import_path);
- print $dest "}\n";
- }
- else {
- $self->concatenate_to($dest, $import_path);
+ 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;
+ }
- print $dest "\n/** End of $import */\n\n";
+ # 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 {
- print $dest $line;
- last IMPORT if not $line =~ /^\s*$/;
+ $self->_concatenate_to($dest, $new_fh, $path, $seen);
}
- }
- $self->_debug("Printing the rest of '$file'");
- print $dest $_ while <$fh>;
- $self->_debug("Closing '$file'");
- close $fh;
+ print $dest "\n/** End of $import */\n\n";
+ }
+ else {
+ print $dest $line;
+ last if not $line =~ /^\s*$/;
+ }
}
+ $self->_debug("Printing the rest");
+ print $dest $_ while <$fh>;
+ close $fh;
}
+=head1 RESOLVING METHODS
+
+The following methods help map URIs to files and find them on the disk.
+
+In common situation you control CSS and can adopt it to use imports with
+relative URIs and most probably only have to set root(s).
+
+However, you can use subclass these methods to parse css files before submitting,
+implement advanced mapping of URIs to file system and other crazy things.
+
=head2 B<CSS::Squish-E<gt>roots(@dirs)>
-A getter/setter for additional paths to search when looking for imported
-files. The paths specified here are searched _before_ trying to find the
-import relative to the file from which it is imported. This is useful if
-your server has multiple document roots from which your CSS imports files
-and lets you override the default behaviour (but still fall back to it).
+A getter/setter for paths to search when looking for files.
+
+The paths specified here are searched to find file. This is useful if
+your server has multiple document roots.
+
+See also 'resolve_file' below.
=cut
@@ -214,18 +251,108 @@
return @res;
}
-sub _resolve_file {
+=head2 file_handle( $file )
+
+Takes a path to a file, resolves (see resolve_file) it and returns a handle.
+
+Returns undef if file couldn't be resolved or it's impossible to open file.
+
+You can subclass it to filter content, process it with templating system or
+generate it on the fly:
+
+ 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;
+ }
+
+B<Note> that the file is not resolved yet and is relative to the root(s), so
+you have to resolve it yourself or call resolve_file method.
+
+=cut
+
+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;
+}
+
+=head2 resolve_file( $file )
+
+Lookup file in the root(s) and returns first path it found or undef.
+
+=cut
+
+sub resolve_file {
my $self = shift;
my $file = shift;
- for my $root ( @_ ) {
- $self->_debug("Searching dir: $root");
+ $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;
+ return undef;
+}
+
+=head2 resolve_uri( $uri_string, $base_file )
+
+Takes an URI and base file path and transforms it into new
+file path.
+
+=cut
+
+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 {
Modified: CSS-Squish/t/02-edge-cases.t
==============================================================================
--- CSS-Squish/t/02-edge-cases.t (original)
+++ CSS-Squish/t/02-edge-cases.t Tue Nov 6 04:30:49 2007
@@ -34,7 +34,7 @@
* From t/css/02-edge-cases.css: @import url( "foo.css") print,aural;
*/
- at media print,aural {
+ at media aural, print {
foo1
}
@@ -45,7 +45,7 @@
* From t/css/02-edge-cases.css: @import url(foo2.css ) print, aural, tty;
*/
- at media print, aural, tty {
+ at media aural, print, tty {
foo2
}
Modified: CSS-Squish/t/07-basic-extra-roots.t
==============================================================================
--- CSS-Squish/t/07-basic-extra-roots.t (original)
+++ CSS-Squish/t/07-basic-extra-roots.t Tue Nov 6 04:30:49 2007
@@ -11,7 +11,7 @@
/**
- * From t/css/07-basic-extra-roots.css: @import "07-basic-extra-roots2.css";
+ * From 07-basic-extra-roots.css: @import "07-basic-extra-roots2.css";
*/
foobar
@@ -20,7 +20,7 @@
/**
- * From t/css/07-basic-extra-roots.css: @import "07-basic-extra-roots3.css";
+ * From 07-basic-extra-roots.css: @import "07-basic-extra-roots3.css";
*/
foobaz
@@ -29,7 +29,7 @@
/**
- * From t/css/07-basic-extra-roots.css: @import "07-basic-extra-roots4.css";
+ * From 07-basic-extra-roots.css: @import "07-basic-extra-roots4.css";
*/
fallback
@@ -40,8 +40,8 @@
EOT
-CSS::Squish->roots( 't/css2/', 't/css3/' );
-my $result = CSS::Squish->concatenate('t/css/07-basic-extra-roots.css');
+CSS::Squish->roots( 't/css2/', 't/css3/', 't/css/' );
+my $result = CSS::Squish->concatenate('07-basic-extra-roots.css');
is_string($result, $expected_result, "Basic extra roots");
More information about the Bps-public-commit
mailing list