File Coverage

blib/lib/Data/JPack.pm

Criterion	Covered	Total	%
statement	87	210	41.4
branch	7	52	13.4
condition	8	27	29.6
subroutine	20	34	58.8
pod	14	18	77.7
total	136	341	39.8

line	stmt	bran	cond	sub	pod	time	code
1							package Data::JPack;
2	2			2		118877	use strict;
	2					6
	2					82
3	2			2		26	use warnings;
	2					5
	2					119
4	2			2		13	use feature ":all";
	2					15
	2					448
5
6	2			2		1318	use CSS::Minifier::XS;
	2					1632
	2					153
7	2			2		1293	use JavaScript::Minifier::XS;
	2					1688
	2					198
8
9							our $VERSION="v0.3.0";
10
11	2			2		17	use feature qw;
	2					5
	2					91
12	2			2		12	no warnings "experimental";
	2					3
	2					114
13
14	2			2		1532	use MIME::Base64;
	2					1872
	2					201
15	2			2		1416	use IO::Compress::RawDeflate qw;
	2					103760
	2					256
16	2			2		1518	use IO::Uncompress::RawInflate qw;
	2					35073
	2					311
17
18	2			2		19	use File::Basename qw;
	2					6
	2					230
19
20	2			2		1265	use constant::more B64_BLOCK_SIZE=>(57*71); #Best fit into page size
	2					2507
	2					17
21
22	2			2		463	use File::Path qw;
	2					4
	2					253
23
24	2			2		1330	use File::ShareDir ":ALL";
	2					85777
	2					425
25							my $share_dir=dist_dir "Data-JPack";
26
27	2			2		1381	use Export::These qw;
	2					2409
	2					19
28
29							# turn any data into locally (serverless) loadable data for html/javascript apps
30
31							#represents a chunk of a data to load
32							#could be a an entire file, or just part of one
33							#
34	2			2		2544	use constant::more('options_=0', qw);
	2					4
	2					20
35
36							# Database of files seen by a html_container.
37							#
38							my %seen;
39
40
41
42							*minify_js=\&JavaScript::Minifier::XS::minify;
43							*minify_css=\&CSS::Minifier::XS::minify;
44
45							sub new {
46	1		50	1	1	305539	my $pack=shift//__PACKAGE__;
47							#options include
48							# compression
49							# tagName
50							# chunkSeq
51							# relativePath
52							# type
53							#
54	1					3	my $self=[];
55	1					5	my %options=@_;
56	1					4	$self->[options_]=\%options;;
57
58	1		50			12	$self->[options_]{jpack_type}//="data";
59	1		50			7	$self->[options_]{jpack_compression}//="none";
60	1		50			8	$self->[options_]{jpack_seq}//=0;
61	1					3	$self->[buffer_]="";
62	1		50			4	$self->[options_]{html_container}//="index.html";
63							#$self->[options]{prefix}";
64
65
66	1					5	for($self->[options_]{html_container}){
67	1	50	0			8	if(/\.html$/){
		0
68							# If it looks like a html file, then assume it will be
69	1					38	$self->[html_root_]=dirname $_;
70							}
71							elsif( -d or ! -x){
72							# If its a existing or non existing location assume a dir
73	0					0	$self->[html_root_]=$_;
74							}
75							else {
76	0					0	$self->[html_root_]=dirname $_;
77							}
78							}
79
80	1					383	make_path $self->[html_root_];
81
82							#$self->[prefix_]
83							#$self->[html_root_];
84	1					10	bless $self , $pack;
85							}
86
87							sub encode_header {
88	0			0	1	0	my $self=shift;
89	0					0	for ($self->[options_]{jpack_compression}){
90	0	0				0	if(/deflate/i){
91	0					0	my %opts;
92	0					0	my $deflate=IO::Compress::RawDeflate->new(\$self->[buffer_]);
93
94	0					0	$self->[compress_]=$deflate;
95							}
96							else{
97							}
98							}
99
100							# NOTE: Technically this isn't needed as the RawDefalte does not add the zlib
101							# header. However if Deflate is used then this wipes out the header
102							#
103	0					0	$self->[buffer_]="";
104
105	0					0	my $header="";
106	0					0	my $options=($self->[options_]);
107	0	0				0	if($self->[options_]{embedded}){
108							$header.= ""
109							. qq\|\|;
137							}
138	0					0	$footer;
139							}
140
141							sub encode_data {
142	0			0	1	0	my $self=shift;
143	0					0	my $data=shift;
144	0					0	my $out="";
145	0	0				0	if($self->[compress_]){
146	0					0	$self->[compress_]->write($data);
147							}
148							else {
149							# Data might not be correct size for base64 so append
150	0					0	$self->[buffer_].=$data;
151							}
152
153	0					0	my $multiple=int(length ($self->[buffer_])/B64_BLOCK_SIZE);
154							#
155							#
156	0	0				0	if($multiple){
157							# only convert block if data is correcty multiple
158	0					0	$out=encode_base64(substr($self->[buffer_], 0, $multiple*B64_BLOCK_SIZE,""),"");
159							}
160	0					0	$out;
161							}
162
163
164							# Single shot data encoding. Adds a header, data and footer
165							#
166							sub encode {
167	0			0	1	0	my $self=shift;
168	0					0	my $data=shift;
169
170	0					0	$self->encode_header
171							.$self->encode_data($data)
172							.$self->encode_footer
173							}
174
175							sub encode_file {
176	0			0	1	0	my $self=shift;
177
178	0					0	my $path = shift;
179	0					0	my $out_path=shift;
180	0		0			0	my $options=shift//{};
181
182	0					0	local $/;
183							#return unless
184	0	0				0	open my $file, "<", $path or die "$path: $!";
185	0					0	my $data = <$file>;
186	0	0	0			0	if(!$options->{no_minify_js} and $path =~ /\.js$/){
		0	0
187	0					0	my $ol=length $data;
188	0					0	$data=minify_js($data);
189	0					0	my $nl=length $data;
190							#say STDERR "Minified JS from $ol to $nl: @{[sprintf('%d', 100*$nl/$ol)]}%";
191							}
192							elsif($options->{no_minify_css} or $path !~ /\.css$/){
193	0					0	my $ol=length $data;
194	0					0	$data=minify_css($data);
195	0					0	my $nl=length $data;
196							#say STDERR "Minified CSS from $ol to $nl: @{[sprintf('%d', 100*$nl/$ol)]}%";
197							}
198							else {
199
200							}
201
202	0					0	$data=$self->encode($data);
203
204	0	0				0	if($out_path){
205	0					0	my $dir=dirname $out_path;
206	0					0	make_path $dir;
207	0	0				0	open my $fh, ">", $out_path or die $!;
208	0					0	print $fh $data;
209							}
210							else
211							{
212	0					0	$data;
213							}
214
215							}
216
217							#single shot.. non OO
218							sub jpack_encode {
219	0			0	0	0	my $data=shift;
220	0					0	my $jpack=Data::JPack->new(@_);
221
222	0					0	$jpack->encode($data);
223							}
224
225
226							# Opens, reads and encodes data from file at $path
227							# if $out_path is given the dir and file is create and data written
228							# otherwise the encoded data is returned
229							sub jpack_encode_file {
230	0			0	0	0	local $/;
231	0					0	my $path = shift;
232	0					0	my $out_path=shift;
233	0	0				0	return unless open my $file, "<", $path;
234
235	0					0	my $data=jpack_encode <$file>, @_;
236	0	0				0	if($out_path){
237	0					0	my $dir=dirname $out_path;
238	0					0	make_path $dir;
239	0					0	open my $fh, ">", $out_path;
240	0					0	print $fh $data;
241							}
242							else
243							{
244	0					0	$data;
245							}
246
247							}
248
249							sub decode {
250	0			0	1	0	my $self=shift;
251	0					0	my $data=shift;
252	0					0	my $compression;
253	0					0	$data=~/decodeData$\s\{(.)\}\s,\sfunction\($\{\sreturn\s"(.)"\s\}\)/;
254	0					0	my $js=$1;
255	0					0	$data=$2;
256	0					0	my @items=split /\s,\s/, $js;
257	0					0	my %pairs= map {s/^\s+//; s/\s+$//;$_ }
	0					0
	0					0
258	0					0	map {split ":", $_} @items;
	0					0
259	0					0	for(keys %pairs){
260	0	0				0	if(/compression/){
261	0					0	$pairs{$_}=~/"(.*)"/;
262	0					0	$compression=$1;
263							}
264							}
265
266	0					0	my $decoded;
267	0					0	my $output="";
268	0					0	for($compression){
269	0	0				0	if(/deflate/){
270	0					0	$decoded=decode_base64($data);
271	0	0				0	rawinflate(\$decoded, \$output) or die $RawInflateError;
272							}
273							else {
274	0					0	$output=decode_base64($data);
275							}
276							}
277	0					0	$output;
278
279							}
280
281				0	0		sub jpack_decode {
282
283							}
284
285							sub jpack_decode_file {
286	0			0	0	0	local $/;
287	0					0	my $path=shift;
288	0	0				0	return unless open my $file,"<", $path;
289	0					0	my $data=<$file>;
290
291	0					0	my $jpack=Data::JPack->new;
292	0					0	$jpack->decode($data);
293							}
294
295
296							# File system database
297							#
298							# Returns the current set name (dir) for the root dir/prefix
299							sub next_set_name {
300	2			2	1	1062	my $self=shift;
301	2					4	my $force=shift;
302							# use the html_container as and prefix to locate the current set
303	2	50				18	my $dir=join "/", $self->[html_root_], $self->[prefix_]?$self->[prefix_]:();
304
305	2					5	my @list;
306	2	100	66			15	if(defined($force) and $force){
307							#my $n= sprintf "%032x", int($force)-1;
308
309	1					161	push @list, int($force)-1;
310							}
311							else {
312							# List all dirs with the correct formating in the name
313	1					192	@list= map {hex} sort grep {length == 32 } map {-d; basename $_ } <"$dir"/*>;
	0					0
	0					0
	0					0
	0					0
314
315	1	50				8	unless(@list){
316							# create a new dir
317							#my $name=sprintf "$dir/%032x", 1;
318	1					4	push @list, -1; #$name;
319							}
320							}
321
322	2					8	my $max=pop @list;
323
324	2					14	my $name=sprintf "$dir/%032x", $max+1;
325
326							#make_path $name;
327
328	2					8	$self->[current_set_]=$name;
329	2					12	return $name;
330							}
331
332
333							# Returns the path of a file, in a next set ( or set provided)
334							sub next_file_name{
335	2			2	1	1882	my $self =shift;
336	2					6	my $path =shift;
337
338							#Check if the passed file dis defined. If so then we check if its seen or not
339	2	50				8	if(defined $path){
340	0					0	my $p=$self->[html_root_]."/".$self->[prefix_]."/".$path;
341	0	0				0	if($seen{$p}){
342							#use feature ":all";
343							#sleep 1;
344	0					0	return undef;
345							}
346							else {
347	0					0	$seen{$p}=1;
348							}
349							}
350							else {
351							# Ass previous versions
352							}
353	2		33			8	my $set_dir=$self->[current_set_]//$self->next_set_name;
354
355	2					305	my @list= map {hex} sort grep {length == 32 } map {s/\.jpack// ; basename $_ } <"$set_dir"/*.jpack>;
	0					0
	0					0
	0					0
	0					0
356
357	2	50				13	unless(@list){
358	2					5	push @list, -1;
359							}
360
361	2					5	my $max=pop @list;
362
363	2					23	my $name=sprintf "$set_dir/%032x.jpack", $max+1;
364	2					11	return $name;
365							}
366
367							#########################################
368							# sub open_next_file { #
369							# my $self=shift; #
370							# my $name=$self->next_file_name(@_); #
371							# open my $fh, ">>", $name; #
372							# $fh; #
373							# } #
374							#########################################
375
376							sub html_root {
377	1			1	1	1157	my $self=shift;
378	1					490	$self->[html_root_];
379							}
380
381							sub current_set {
382	0			0	1		my $self=shift;
383	0						$self->[current_set_];
384							}
385
386							sub current_file {
387	0			0	1		my $self=shift;
388	0						$self->[current_file_];
389							}
390
391
392							sub set_prefix {
393	0			0	1		my $self=shift;
394	0						$self->[prefix_]=shift;
395	0						$self->[current_set_]=undef;
396							}
397
398							sub flush {
399	0			0	1		my $self=shift;
400							# remove all directories under the current prefix
401	0						my $dir=$self->[html_root_]."/".$self->[prefix_];
402	0						remove_tree $dir;
403
404							}
405
406							1;