Permalink
Switch branches/tags
Nothing to show
Find file
Fetching contributors…
Cannot retrieve contributors at this time
executable file 129 lines (100 sloc) 3.61 KB
#!/usr/bin/env perl
use strict;
use warnings;
our $VERSION = '0.10';
use File::Spec qw();
use FindBin qw($Bin);
my $root_path = $ENV{CGI_COMBO_FILES_PATH};
if (! defined $root_path) {
#
# TODO: should multiple root file paths be supported?
#
my $conf_file = File::Spec->catfile($Bin, 'combo.conf');
if (-r $conf_file) {
open my $FH, "$conf_file" or die "Cannot open conf file: $!";
$root_path = <$FH>;
close $FH;
chomp $root_path;
}
}
my $type_map = {
js => 'application/x-javascript',
css => 'text/css',
};
eval {
my @files = split '&', $ENV{QUERY_STRING};
unless (@files) {
die 'No files to combo';
}
my $content_type;
my @buffer;
for my $file (@files) {
if ($file =~ /\A(.+)\.(js|css)\z/i) {
my $name = $1;
my $type = $2;
my $lc_type = lc $type;
if (! exists $type_map->{$lc_type}) {
die "Unrecognized file type: $type\n";
}
my $path = File::Spec->catfile($root_path, sprintf('%s.%s', $name, $type));
open my $FH, $path or die sprintf 'Cannot open file (%s) for reading: %s', $path, $!;
my @raw = <$FH>;
close $FH;
if ($type eq 'css') {
# TODO: handle nested referencing of CSS files
# correct for image paths
my @dirs = File::Spec->splitdir($name);
# remove the file portion of the path (it looks like a dir)
splice @dirs, -1;
my $this_dir = File::Spec->catdir(@dirs);
for (@raw) {
# just filename or subdirs/filename (e.g) url(foo.png), url(foo/foo.png)
s/(url\()\s*(?!\/|(?:\.\.)|(?:http))([^\)]+)\s*(\))/$1\/$this_dir\/$2$3/g;
# relative paths (e.g.) url(../../foo.png)
s!(url\()\s*((?:\.\./)+)(\S+)\s*(\))!
my @splits = split /\.\./, $2;
my $dir = File::Spec->catdir(
@dirs[0..(@dirs - @splits)]
);
"$1$dir/$3$4";
!ge;
}
}
push @buffer, @raw;
if (defined $content_type and $content_type ne $type_map->{$lc_type}) {
die sprintf "Combo can only load single type of file: %s ne %s\n", $content_type, $type_map->{$lc_type};
}
$content_type = $type_map->{$lc_type};
}
else {
die "Unrecognized argument format (file): $file\n";
}
}
if (@buffer) {
print "Content-Type: $content_type\n\n";
print join '', @buffer;
}
else {
die 'Empty buffer';
}
};
if ($@) {
print "Status: 400 Bad Request\n";
print "Content-Type: text/html\n\n";
print "<html><body>$@</body></html>\n";
}
__END__
=pod
=head1 COPYRIGHT AND LICENSE
Copyright (C) 2008-2012 End Point Corporation, http://www.endpoint.com/
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 2 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program. If not, see: http://www.gnu.org/licenses/
=cut