CPAN::Groonga

#!/usr/bin/env perl
package Data::Resolver::Asset;
use v5.24;
use warnings;
use experimental 'signatures';
use English '-no_match_vars';
use File::Temp            qw< tempdir tempfile >;
use File::Spec::Functions qw< splitpath catpath >;
use Moo;
no warnings 'experimental::signatures';

use namespace::clean;

with 'Data::Resolver::RoleComplain';

has file => (is => 'lazy', predicate => 'has_file');
has _is_file_persistent => (is => rw => default => 1 => init_arg => undef);
has _filehandle => (
   is        => 'ro',
   init_arg  => 'filehandle',
   predicate => 'has_filehandle',
   clearer   => '_clear_filehandle'
);
has key => (is => 'lazy');
has raw_ref => (
   is        => 'lazy',
   predicate => 'has_raw_ref',
   init_arg  => 'raw',
   coerce    => sub { ref($_[0]) eq 'SCALAR' ? $_[0] : \$_[0] },
);

sub assert_useable ($self) {
   $self->is_useable or $self->complain(400, 'Not Useable');
   return $self;
}

sub _build_file ($self) {
   $self->assert_useable;
   $self->_is_file_persistent(0);
   return $self->_save_file;
}

sub _build_key ($self) {
   return undef unless $self->has_file;
   my ($v, $ds, $name) = splitpath($self->file);
   return $name;
}

sub _build_raw_ref ($self) {
   my $fh  = $self->filehandle;
   my $key = $self->key;
   local $/;
   defined(my $buf = <$fh>)
     or $self->complain(400, "readline('$key'): $OS_ERROR");
   return \$buf;
} ## end sub _build_raw_ref

sub _copy ($s, $src_rawfh, $dst) {
   require File::Copy;
   my $dst_rawfh = $s->_raw_fh($dst, '>');
   File::Copy::copy($src_rawfh, $dst_rawfh);
   return $s;
} ## end sub _copy

sub decoded_as ($self, $encoding) {
   require Encode;
   return Encode::decode($encoding, $self->raw_data);
}

sub decoded_as_utf8 ($self) { return $self->decoded_as('UTF-8') }

sub fh ($self, @rest) { return $self->filehandle(@rest) }

sub filehandle ($self, %args) {
   $self->assert_useable;

   my $binmode = $args{binmode}         // ':raw';
   my $nomem   = $args{not_from_memory} // 0;

   my $src =
       $self->has_filehandle             ? $self->_filehandle
     : ($nomem || (!$self->has_raw_ref)) ? $self->file
     :                                     $self->raw_ref;
   $self->_clear_filehandle;

   my $fh = $self->_raw_fh($src);
   binmode($fh, $binmode) or $self->complain(400, "binmode(): $OS_ERROR");
   return $fh;
} ## end sub filehandle

sub is_useable ($self) {
   $self->has_filehandle || $self->has_raw_ref || $self->has_file;
}

sub parsed_as_json ($self) {
   require JSON::PP;
   return JSON::PP::decode_json($self->raw_data);
}

sub persistent_file ($self) {
   return $self->file if $self->has_file && $self->_is_file_persistent;
   return $self->_save_file(0)
}

sub raw_data ($self) { return ${$self->raw_ref} }

sub _raw_fh ($self, $fh, $mode = '<') {
   my $name = '<filehandle>';
   if (ref($fh) ne 'GLOB') {
      $name = ref($fh) ? '<scalar ref>' : $fh;
      my $target = $fh;
      $fh = undef;
      open $fh, $mode, $target
        or $self->complain(400, "open($name): $OS_ERROR");
   } ## end if (ref($fh) ne 'GLOB')
   binmode $fh, ':raw'
     or $self->complain(400, "binmode('$name'): $OS_ERROR");
   return $fh;
} ## end sub _raw_fh

sub save_as ($self, $dst) { $self->_copy($self->filehandle, $dst); $dst }

sub _save_file ($self, $remove = 1) {
   my ($dst_fh, $path);    # establish destination
   if (defined(my $key = $self->key)) {
      my $dir = tempdir(CLEANUP => $remove);
      my ($v, $dirs) = splitpath($dir, 'no-file');
      my (undef, undef, $basename) = splitpath($key);
      $path = catpath($v, $dirs, $basename);
   }
   else {
      ($dst_fh, $path) = tempfile(UNLINK => $remove);
   }
   $dst_fh = $self->_raw_fh($dst_fh // $path, '>');

   if ($self->has_filehandle) {
      $self->_copy($self->filehandle, $dst_fh);
   }
   elsif ($self->has_raw_ref) {
      print {$dst_fh} ${$self->raw_ref};
   }
   else {
      die "unexpected branch";
   }

   close($dst_fh);
   return $path;
}

1;