ContinuousReadWrite.pm

package Timeshifter::ContinuousReadWrite;
use strict;
use warnings;
use base qw(Tie::Handle Exporter);
use File::Temp qw(mktemp);

our @EXPORT_OK = qw(continuous_open);

use constant {
  READ_MODE => 1,
  WRITE_MODE => 2,
  APPEND_MODE => 3
};

sub continuous_open {
  my $ret;
  tie *$ret, __PACKAGE__, @_;
  $ret;
}

sub TIEHANDLE {
  my $class = shift;
  my $self = bless {@_, readed => 0, total_wrote => 0, wrote_to_this_file => 0}, $class;

  $self->{mode} = READ_MODE unless exists $self->{mode};

  if($self->{mode} == READ_MODE){
    exists $self->{next} || exists $self->{list} || die('next or list should be given for READ mode');
    exists $self->{pattern} && die("READ mode can't use pattern");
    $self->{mode_str} = '<';
  }elsif($self->{mode} == WRITE_MODE || $self->{mode} == APPEND_MODE){
    exists $self->{next} || exists $self->{pattern} || die('next or pattern should be given for WRITE mode');
    exists $self->{list} && die("WRITE mode can't use list");
    $self->{mode_str} = $self->{mode} == WRITE_MODE ? '>' : '>>';
  }else{
    die('mode should be either READ or WRITE');
  }

  exists $self->{next} && ref $self->{next} ne 'CODE' && die('next should be a sub reference');
  exists $self->{list} && ref $self->{list} ne 'ARRAY' && die('list should be an array reference');
  exists $self->{on_open} && ref $self->{on_open} ne 'CODE' && die('on_open should be a sub reference');
  exists $self->{on_close} && ref $self->{on_close} ne 'CODE' && die('on_close should be a sub reference');
  exists $self->{on_open_error} && ref $self->{on_open_error} ne 'CODE' && die('on_open_error should be a sub reference');

  if(exists $self->{pattern}){
    my $t = ref($self->{pattern});
    $t eq '' || $t eq 'CODE' || die('pattern should be either string or sub reference');
  }

  $self
}

sub open_next {
  my $self = shift;
  return if $self->{eof};
  $self->CLOSE() if exists $self->{fh};

  $self->{wrote_to_this_file} = 0;

  my $next;
  if($self->{next}){
    $next = $self->{next}->();
  }elsif(exists $self->{list}){
    $next = shift @{$self->{list}};
  }elsif($self->{pattern}){
    $next = mktemp(ref $self->{pattern} eq 'CODE' ? $self->{pattern}->() : $self->{pattern});
  }

  unless($next){
    $self->{eof} = 1;
    return;
  }

  my $fh;
  unless(open($fh, $self->{mode_str}, $next)){
    exists $self->{on_open_error} && $self->{on_open_error}->($next, $!);
    return;
  }

  $self->binarize();
  $self->{fh} = $fh;
  $self->{current_file} = $next;

  exists $self->{on_open} && $self->{on_open}->($next);

  1;
}

sub check_open {
  my $self = shift;

  if($self->{eof}){
    $! = 0;
    return;
  }

  (!$self->{fh} || ($self->{mode} != READ_MODE && $self->{limit} < $self->{wrote_to_this_file}) ||
    ($self->{mode} == READ_MODE && eof($self->{fh}))) && ($self->open_next() || return);

  $self;
}

sub WRITE {
  my $self = shift->check_open() || return;
  my $n = syswrite($self->{fh}, @_) || return;
  $self->{wrote_to_this_file} += $n;
  $self->{total_wrote} += $n;
  $n;
}

sub PRINT {
  my $self = shift;
  my $data = join($,, @_);
  $data .= $\ if defined $\;
  $self->WRITE($data);
}

sub PRINTF {
  my $self = shift;
  $self->WRITE(sprnitf(@_));
}

sub READ {
  my $self = shift->check_open() || return;
  my $ret = sysread($self->{fh}, $_[0], @_[1..$#_]);
}

sub READLINE {
  my $self = shift->check_open() || return;
  readline($self->{fh});
}

sub GETC {
  my $self = shift->check_open() || return;
  getc($self->{fh});
}

sub CLOSE {
  my $self = shift;

  if($self->{fh}){
    exists $self->{on_close} && $self->{on_close}->($self->{current_file});
    delete $self->{current_file};
    close(delete($self->{fh}));
  }
}

sub OPEN {
  die("{__PACKAGE__} doesn't implement re-opening");
}

sub binarize {
  my $self = shift;
  return unless $self->{fh} && exists $self->{bined};
  if(defined $self->{bined}){
    binmode($self->{fh}, $self->{bined});
  }else{
    binmode($self->{fh});
  }
}

sub BINMODE {
  my $self = shift;
  $self->{bined} = shift;
  $self->binarize();
}

sub EOF {
  my $self = shift;
  $self->{eof};
}

sub TELL {
  my $self = shift;
  $self->{mode} == READ_MODE ? $self->{readed} : $self->{total_wrote};
}

sub SEEK {
  die("{__PACKAGE__} doesn't support SEEK");
}

sub FILENO {
  my $self = shift->check_open() || return;
  fileno($self->{fh});
}

sub DESTROY {
  shift->CLOSE();
}

sub UNTIE {
  shift->CLOSE();
}

1;

package main;
use strict;
use warnings;

my $fh = Timeshifter::ContinuousReadWrite::continuous_open(list => [glob('*.yml')], on_open => sub { warn("---------[opened @_]\n") });

while(<$fh>){
  print fileno($fh), "\n";
  print $_;
}