File Coverage

blib/lib/Hazy.pm

Criterion	Covered	Total	%
statement	89	90	98.8
branch	26	36	72.2
condition	17	21	80.9
subroutine	11	11	100.0
pod	0	6	0.0
total	143	164	87.2

package Hazy;

use strict;
use warnings;
use 5.012;
use Cwd qw/abs_path/;
our $VERSION = '0.05';

sub new {
	my ( $pkg, @new ) = @_;
	my %args = scalar @new == 1 ? @{ shift @new } : @new;
	$args{file_name} //= 'test';
	$args{find} //= 'css';
	my $path = abs_path( [caller()]->[1] );
	$args{abs_path} = substr($path, 0, rindex($path, '/'));
	if ($args{write_dir}) {
		$args{write_dir} = sprintf "%s/%s", $args{abs_path}, $args{write_dir};
		unless(-d $args{write_dir}) {
			my $dir = '';
			map {
				(-e ($dir .= "/$_")) or mkdir $dir;
			} (split /\//, $args{write_dir});
		}
	}
	bless {%args}, $pkg;
}

sub process {
	$_[1] //= $_[0]->{read_dir} // die 'No read_dir provided';
	$_[1] = sprintf "%s/%s", $_[0]->{abs_path}, $_[1];
	my ( $spec, @files ) = $_[0]->lookup_dir( $_[1] );
	my $build_css;
	for my $css_file (@files) {
		open my $fh, "<$css_file" or die "Cannot open $css_file";
		my $css = do { local $/; <$fh> };
		$css = $_[0]->make_replacements( $spec, $css );
		$build_css .= $css;
	}
	my $write = exists $_[0]->{write_dir}
	  ? sprintf "%s/%s", $_[0]->{write_dir}, $_[0]->{file_name}
	  : $_[0]->{file_name};
	write_file( "$write.css",	 $build_css );
	write_file( "$write.min.css", $_[0]->min_css($build_css) );
	return 1;
}

sub write_file {
	open( my $fh, '>', $_[0] ) or die "could not open file $_[0]";
	print $fh $_[1];
	close $fh;
}

sub make_replacements {
	my $regx = join "|", map { quotemeta($_) } keys %{ $_[1] };
	return $_[2] unless $regx;
	$_[2] =~ s/($regx)/$_[1]->{$1}/g;
	( !$_[2] =~ m/\n$/ ) and $_[2] .= "\n";
	return $_[2];
}

sub lookup_dir {
	my $look = $_[0]->{find};
	opendir( my $dh, $_[1] ) or die "Could not open dir - $_[1]";
	my %files = map { $_ => sprintf "%s/%s", $_[1], $_ }
	  grep { /config|\.$look$/ } readdir $dh;
	closedir($dh);
	my $spec = delete $files{config} or die 'no config found';
	return ( _read_spec($spec), sort values %files );
}

sub min_css {
	$_[1] =~ s/[\s]{2,}|[\t\r\n]+//g;
	my %minify = (' {', '{', '{ ', '{', ' }', '}', '} ', '}', ': ',
	':', ';}', '}', ' ,', ',', ', ', ',', '( ', '(', ' )', ')' );
	my $regx = join "|", map { quotemeta($_) } sort keys %minify;
	$_[1] =~ s/($regx)/$minify{$1}/g;
	$_[1];
}

sub _read_spec {
	my ( %spec, %arg );
	open( my $fh, "<$_[0]" );
	$arg{end} = ';';
	while ( sysread( $fh, $arg{buffer}, 1 ) ) {
		if ( ! exists $arg{value} && $arg{buffer} =~ m/\s/ ) { next }
		if ( !$arg{flag} && !$arg{multi} && $arg{buffer} eq ':' ) { $arg{flag} = 1; next; }
		if ($arg{buffer} eq $arg{end}) {
			map { $arg{$_} =~ s/^\s+|\s+$// } qw/key value/;
			$spec{"$arg{key}"} = $arg{value};
			map { delete $arg{$_} } qw/key value flag multi/;
			$arg{end} = ';';
			next;
		}
		if ( exists $arg{flag} && ! exists $arg{value} ) {
			next if ($arg{buffer} =~ m/\s/);
			if ($arg{buffer} =~ m/[\@\$\^\&\*\{\/\\\~\`\>\<\+\_\]\[\?\|\"\'\=\!]/ ) {
				$arg{multi} = 1;
				$arg{end} = $arg{buffer};
				next;
			}
		}
		exists $arg{flag} ? ( $arg{value} .= $arg{buffer} ) : ( $arg{key} .= $arg{buffer} );
	}
	close($fh);
	return \%spec;
}

1;

__END__