view release on metacpan or  search on metacpan

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

    make_path $dir;
    open my $fh, ">", $out_path or die $!;
    print $fh $data;
  }
  else
  {
    $data;
  }

}

#single shot.. non OO
sub jpack_encode {
	my $data=shift;
	my $jpack=Data::JPack->new(@_);

	$jpack->encode($data);
}


# Opens, reads and encodes data from file at $path
# if $out_path is given the dir and file is create and data written
# otherwise the encoded data is returned
sub jpack_encode_file {
	local $/;
	my $path = shift;
  my $out_path=shift;
	return unless open my $file, "<", $path;

	my $data=jpack_encode <$file>, @_;
  if($out_path){
    my $dir=dirname $out_path;
    make_path $dir;
    open my $fh, ">", $out_path;
    print $fh $data;
  }
  else
  {
    $data;
  }

}

sub decode {
  my $self=shift;
  my $data=shift;
  my $compression; 
  $data=~/decodeData\(\s*\{(.*)\}\s*,\s*function\(\)\{\s*return\s*"(.*)"\s*\}\)/;
  my $js=$1;
  $data=$2;
  my @items=split /\s*,\s*/, $js;
  my %pairs= map {s/^\s+//; s/\s+$//;$_ }
          map {split ":", $_} @items;
  for(keys %pairs){
    if(/compression/){
      $pairs{$_}=~/"(.*)"/;
      $compression=$1;
    }
  }

  my $decoded;
  my $output="";
  for($compression){
    if(/deflate/){
      $decoded=decode_base64($data);
      rawinflate(\$decoded, \$output) or die $RawInflateError;
    }
    else {
      $output=decode_base64($data);
    }
  }
  $output;

}

sub jpack_decode {

}

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;
}