File Coverage

blib/lib/Data/JPack.pm

Criterion	Covered	Total	%
statement	81	195	41.5
branch	7	48	14.5
condition	8	19	42.1
subroutine	18	32	56.2
pod	0	18	0.0
total	114	312	36.5

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