view release on metacpan or  search on metacpan

lib/Data/JPack.pm  view on Meta::CPAN

package Data::JPack;
use strict;
use warnings;
use feature ":all";

our $VERSION="v0.2.2";

use feature qw<say>;
no warnings "experimental";

use MIME::Base64;
use IO::Compress::RawDeflate qw<rawdeflate>;
use IO::Uncompress::RawInflate qw<rawinflate $RawInflateError>;

use File::Basename qw<basename dirname>;

use constant::more B64_BLOCK_SIZE=>(57*71); #Best fit into page size

use File::Path qw<make_path remove_tree>;

use File::ShareDir ":ALL";
my $share_dir=dist_dir "Data-JPack";

use Export::These qw<jpack_encode jpack_encode_file jpack_decode_file>;

# turn any data into locally (serverless) loadable data for html/javascript apps

#represents a chunk of a data to load
#could be a an entire file, or just part of one
#
use constant::more('options_=0', qw<compress_ buffer_ src_ html_root_ html_container_ prefix_  current_set_ current_file_>);

# Database of files seen by a html_container.
#
my %seen;




sub new {
	my $pack=shift//__PACKAGE__;
	#options include
	#	compression
	#	tagName
	#	chunkSeq
	#	relativePath
	#	type
	#
	my $self=[];
	my %options=@_;
	$self->[options_]=\%options;;

	$self->[options_]{jpack_type}//="data";
	$self->[options_]{jpack_compression}//="none";
	$self->[options_]{jpack_seq}//=0;
  $self->[buffer_]="";
  $self->[options_]{html_container}//="index.html";
  #$self->[options]{prefix}";
  
  
  for($self->[options_]{html_container}){
    if(/\.html$/){
      # If it looks like a html file, then assume it will be
      $self->[html_root_]=dirname $_;

lib/Data/JPack.pm  view on Meta::CPAN

}

sub jpack_decode_file {
	local $/;
	my $path=shift;
	return unless open my $file,"<", $path;
	my $data=<$file>;

  my $jpack=Data::JPack->new;
  $jpack->decode($data);
}


# File system database
#
# Returns the current set name (dir) for the root dir/prefix
sub next_set_name {
  my $self=shift;
  my $force=shift;
  # use the html_container as and prefix to locate the current set
  my $dir=join "/", $self->[html_root_], $self->[prefix_]?$self->[prefix_]:();

  my @list;
  if(defined($force)  and $force){
    #my $n= sprintf "%032x", int($force)-1;
    
    push @list, int($force)-1;
  }
  else {
    # List all dirs with the correct formating in the name
    @list= map {hex} sort grep {length == 32 } map {-d; basename $_ } <"$dir"/*>;

    unless(@list){
      # create a new dir
      #my $name=sprintf "$dir/%032x", 1;
      push @list, -1; #$name;
    }
  }

  my $max=pop @list;

	my $name=sprintf "$dir/%032x", $max+1;

  #make_path $name;

  $self->[current_set_]=$name;
  return $name;
}


# Returns the path of a file, in a next set ( or set provided)
sub next_file_name{
	my $self =shift;
  my $path =shift;

  #Check if the passed file dis defined. If so then we check if its seen or not
  if(defined $path){
    my $p=$self->[html_root_]."/".$self->[prefix_]."/".$path;
    if($seen{$p}){
      #use feature ":all";
      #sleep 1;
      return undef;
    }
    else {
      $seen{$p}=1;
    }
  }
  else {
    # Ass previous versions
  }
  my $set_dir=$self->[current_set_]//$self->next_set_name;

  my @list= map {hex} sort grep {length == 32 } map {s/\.jpack// ; basename $_ } <"$set_dir"/*.jpack>;

  unless(@list){
    push @list, -1;
  }

  my $max=pop @list;

	my $name=sprintf "$set_dir/%032x.jpack", $max+1;
  return $name;
}

#########################################
# sub open_next_file {                  #
#   my $self=shift;                     #
#   my $name=$self->next_file_name(@_); #
#   open my $fh, ">>", $name;           #
#   $fh;                                #
# }                                     #
#########################################

sub html_root {
  my $self=shift;
  $self->[html_root_];
}

sub current_set {
  my $self=shift;
  $self->[current_set_];
}

sub current_file {
  my $self=shift;
  $self->[current_file_];
}


sub set_prefix {
  my $self=shift;
  $self->[prefix_]=shift;
  $self->[current_set_]=undef;
}

sub flush {
  my $self=shift;
# remove all directories under the current prefix
  my $dir=$self->[html_root_]."/".$self->[prefix_];
  remove_tree $dir;