File Coverage

blib/lib/Bio/JBrowse/Store/NCList/JSONFileStorage.pm

Criterion	Covered	Total	%
statement	23	25	92.0
branch			n/a
condition			n/a
subroutine	9	9	100.0
pod			n/a
total	32	34	94.1

package Bio::JBrowse::Store::NCList::JSONFileStorage;
BEGIN {
  $Bio::JBrowse::Store::NCList::JSONFileStorage::AUTHORITY = 'cpan:RBUELS';
}
{
  $Bio::JBrowse::Store::NCList::JSONFileStorage::VERSION = '0.1';
}

use strict;
use warnings;
use File::Spec ();
use File::Path ();
use JSON 2 ();
use IO::File;
use Fcntl ":flock";
use PerlIO::gzip;

use constant DEFAULT_MAX_JSON_DEPTH => 2048;


sub new {
    my ($class, $outDir, $compress, $opts) = @_;

    # create JSON object
    my $json = JSON->new->relaxed->max_depth( DEFAULT_MAX_JSON_DEPTH );
    # set opts
    if (defined($opts) and ref($opts) eq 'HASH') {
        for my $method (keys %$opts) {
            $json->$method( $opts->{$method} );
        }
    }

    my $self = {
                outDir => $outDir,
                ext => $compress ? ".jsonz" : ".json",
                compress => $compress,
                json => $json
               };
    bless $self, $class;

    File::Path::mkpath( $outDir ) unless (-d $outDir);

    return $self;
}

sub _write_htaccess {
    my ( $self ) = @_;

    if( $self->{compress} && ! $self->{htaccess_written} ) {
        my $hn = File::Spec->catfile( $self->{outDir}, '.htaccess' );
        return if -e $hn;

        open my $h, '>', $hn or die "$! writing $hn";

        my @extensions = qw( .jsonz .txtz .txt.gz );
        my $re = '('.join('|',@extensions).')$';
        $re =~ s/\./\\./g;

        print $h <
# This Apache .htaccess file is for
# serving precompressed files (@extensions) with the proper
# Content-Encoding HTTP headers.  In order for Apache to pay attention
# to this, its AllowOverride configuration directive for this
# filesystem location must allow FileInfo overrides.

    mod_gzip_item_exclude "$re"


    SetEnvIf Request_URI "$re" no-gzip dont-vary



    Header onsuccess set Content-Encoding gzip


EOA
        $self->{htaccess_written} = 1;
    }
}


sub fullPath {
    my ($self, $path) = @_;
    return File::Spec->join($self->{outDir}, $path);
}


sub ext {
    return shift->{ext};
}


sub encodedSize {
    my ($self, $obj) = @_;
    return length($self->{json}->encode($obj));
}


sub put {
    my ($self, $path, $toWrite) = @_;

    $self->_write_htaccess;

    my $file = $self->fullPath($path);
    my $fh = IO::File->new( $file, O_WRONLY | O_CREAT )
      or die "couldn't open $file: $!";
    flock $fh, LOCK_EX;
    $fh->seek(0, SEEK_SET);
    $fh->truncate(0);
    if ($self->{compress}) {
        binmode($fh, ":gzip")
            or die "couldn't set binmode: $!";
    }
    $fh->print($self->{json}->encode($toWrite))
      or die "couldn't write to $file: $!";
    $fh->close()
      or die "couldn't close $file: $!";
}


sub get {
    my ($self, $path, $default) = @_;

    my $file = $self->fullPath($path);
    if (-s $file) {
        my $OLDSEP = $/;
        my $fh = IO::File->new( $file, O_RDONLY )
            or die "couldn't open $file: $!";
        binmode($fh, ":gzip") if $self->{compress};
        flock $fh, LOCK_SH;
        undef $/;
        eval {
            $default = $self->{json}->decode(<$fh>)
        }; if( $@ ) {
            die "Error parsing JSON file $file: $@\n";
        }
        $default or die "couldn't read from $file: $!";
        $fh->close()
            or die "couldn't close $file: $!";
        $/ = $OLDSEP;
    }
    return $default;
}

1;

__END__