CatalystX::Usul::File::IO - Better IO syntax

   use MyExceptionClass;
   use CatalystX::Usul::File::IO;

   sub io {
      my ($self, @rest) = @_;
      my $io = CatalystX::Usul::File::IO->new( @rest );

      $io->exception_class( q(MyExceptionClass) );
      return $io;
   }

   # Read the first line of a file and chomp the result
   my $line = $self->io( q(path_name) )->chomp->getline;

   # Write the line to file set permissions, atomic update and fcntl locking
   $self->io( q(path_name), q(w), q(0644) )->atomic->lock->print( $line );

   my $io = CatalystX::Usul::File::IO->new( $pathname, [ $mode, $perms ] );

   my $io = $self->io( q(path_to_file) )->absolute;

   my $lines = $self->io( q(path_to_file) )->all;

   $self->io( q(path_to_file) )->append( $line1, $line2, ... );

   $self->io( q(path_to_file) )->appendln( $line, $line2, ... );

   my $io = $self->io( q(path_to_file) )->assert;

   $self->io( q(path_to_file) )->assert_dirpath;

   $self->io( q(path_to_file) )->assert_filepath;

   my $io = $self->io( q(path_to_file) )->assert_open( $mode, $perms );

   my $io = $self->io( q(path_to_file) )->atomic;

   $dirname = $self->io( q(path_to_file) )->basename( @suffixes );

   my $io = $self->io( q(path_to_file) )->binary;

   my $io = $self->io( q(path_to_file) )->binmode( $layer );

   my $io = $self->io( q(path_to_file) )->chomp;

   $io->close;

   $self->io( $tempdir )->delete_tmp_files( $template );

   $dirname = $self->io( q(path_to_file) )->dirname;

   my $io = $self->io( q(path_to_file) )->encoding( $encoding );

   my $bool = $self->io( q(path_to_file) )->is_dir;

   my $bool = $self->io( q(path_to_file) )->is_file;

   my $io = $self->io( q(path_to_file) )->lock;

   my $io = $self->io( q(path_to_file) )->open( $mode, $perms );

   my $pathname = $io->pathname( $pathname );

   my $io = $self->io( q(path_to_file) )->perms( $perms );

   $self->io( q(path_to_file) )->println( $line1, $line2, ... );

   my $bytes_read = $self->io( q(path_to_file) )->read( $buffer, $length );

   my $bytes_written = $self->io( q(pathname) )->write( $buffer, $length );

# @(#)$Id: IO.pm 576 2009-06-09 23:23:46Z pjf $

package CatalystX::Usul::File::IO;

use strict;
use warnings;
use version; our $VERSION = qv( sprintf '0.3.%d', q$Rev: 576 $ =~ /\d+/gmx );
use parent qw(Class::Accessor::Fast);

use English qw(-no_match_vars);
use Exception::Class ( 'IO::Exception' => { fields => [ qw(args) ] } );
use Fcntl qw(:flock);
use File::Basename ();
use File::Path ();
use File::Spec ();
use File::Temp ();
use IO::Dir;
use IO::File;

my $NUL         = q();
my @STAT_FIELDS = (
   qw(dev ino mode nlink uid gid rdev size atime mtime ctime blksize blocks) );

__PACKAGE__->mk_accessors( qw(atomic_pref autoclose block_size
                              exception_class io_handle is_open
                              lock_obj name mode type _assert _atomic
                              _binary _binmode _chomp _dir_pattern
                              _encoding _lock _perms _utf8) );

sub new {
   my ($self, @rest) = @_; my $attrs = {};

   if ($rest[ 0 ]) {
      if (ref $rest[ 0 ] ne q(HASH)) {
         $attrs = { name   => $rest[ 0 ],
                    mode   => $rest[ 1 ],
                    _perms => $rest[ 2 ] };
      }
      else { $attrs = { %{ $rest[ 0 ] } } }
   }

   my $new = bless $attrs, ref $self || $self;

   return $new->_init;
}

sub _init {
   my ($self, $type, $name) = @_;

   $self->atomic_pref( q(B_)         );
   $self->autoclose  ( 1             );
   $self->block_size ( 1024          );
   $self->io_handle  ( undef         );
   $self->is_open    ( 0             );
   $self->name       ( $name         ) if (defined $name);
   $self->type       ( $type || $NUL );

   return $self;
}

sub absolute {
   my $self = shift;

   $self->is_absolute
      || $self->pathname( File::Spec->rel2abs( $self->pathname ) );
   return $self;
}

sub all {
   my $self = shift;

   $self->assert_open( q(r) );

   local $RS = undef; my $all = $self->io_handle->getline;

   $self->error_check;
   $self->autoclose && $self->close;
   return $all;
}

sub append {
   my ($self, @rest ) = @_;

   $self->assert_open( q(a) );
   $self->print( @rest );
   return;
}

sub appendln {
   my ($self, @rest ) = @_;

   $self->assert_open( q(a) );
   $self->println( @rest );
   return;
}

sub assert {
   my $self = shift; $self->_assert( 1 ); return $self;
}

sub assert_dirpath {
   my ($self, $dir_name) = @_; my $perms = $self->_perms || oct q(0775);

   return $dir_name if (-d $dir_name
                        or CORE::mkdir( $self->pathname, $perms )
                        or File::Path::mkpath( $dir_name )
                        or $self->throw( error => 'Cannot create path [_1]',
                                         args  => [ $dir_name ] ));
   return;
}

sub assert_filepath {
   my $self = shift;
   my $name = $self->pathname or return;
   my $directory;

   (undef, $directory) = File::Spec->splitpath( $name );
   return $self->assert_dirpath( $directory );
}

sub assert_open {
   my ($self, @rest) = @_;

   $self->is_open && return $self;
   $self->type || $self->file;
   return $self->open( @rest );
}

sub atomic {
   my $self = shift;

   $self->_atomic( File::Spec->catfile
                   ( $self->filepath, $self->atomic_pref.$self->filename ) );
   return $self;
}

sub basename {
   my ($self, @suffixes ) = @_;

   return unless ($self->pathname);

   return File::Basename::basename( $self->pathname, @suffixes );
}

sub binary {
   my $self = shift;

   $self->is_open && CORE::binmode( $self->io_handle );
   $self->_binary( 1 );
   return $self;
}

sub binmode {
   my ($self, $layer) = @_;

   if ($self->is_open) {
      $layer ? CORE::binmode( $self->io_handle, $layer )
             : CORE::binmode( $self->io_handle );
   }

   $self->_binmode( $layer );
   return $self;
}

sub buffer {
   my ($self, @rest) = @_;

   if (not @rest) {
      unless (exists *$self->{buffer}) {
         *$self->{buffer} = do { my $x = $NUL; \$x };
      }

      return *$self->{buffer};
   }

   my $buffer_ref   = ref $rest[ 0 ] ? $rest[ 0 ] : \$rest[ 0 ];
   ${ $buffer_ref } = $NUL unless defined ${ $buffer_ref };
   *$self->{buffer} = $buffer_ref;
   return $self;
}

sub chomp {
   my $self = shift; $self->_chomp( 1 ); return $self;
}

sub clear {
   my $self = shift; ${ $self->buffer } = $NUL; return $self;
}

sub close {
   my $self = shift;

   $self->is_dir  && return $self->_close_dir;
   $self->is_file && return $self->_close_file;
   return;
}

sub _close {
   my $self = shift;

   $self->io_handle && $self->io_handle->close;
   $self->io_handle( undef );
   $self->mode( undef );
   $self->is_open( 0 );
   return $self;
}

sub _close_dir {
   my $self = shift; return $self->is_open ? $self->_close : undef;
}

sub _close_file {
   my $self = shift;

   if ($self->_atomic and -f $self->_atomic) {
      rename $self->_atomic, $self->pathname
         or $self->throw( error => 'Cannot rename [_1] to [_2]',
                          args  => [ $self->_atomic, $self->pathname ] );
   }

   $self->is_open || return;
   $self->unlock;
   return $self->_close;
}

sub delete {
   my $self = shift;

   $self->_atomic && -f $self->_atomic && unlink $self->_atomic;
   return $self->_close_file;
}

sub delete_tmp_files {
   my ($self, $tmplt) = @_;

   $tmplt ||= q(%6.6d....); my $pat = sprintf $tmplt, $PID;

   while (my $entry = $self->next) {
      unlink $entry->pathname if ($entry->filename =~ m{ \A $pat \z }mx);
   }

   $self->_close_dir;
   return;
}

sub DESTROY {
   my $self = shift;

   $self->_atomic && $self->delete;
   $self->is_open && $self->close;
   return;
}

sub dir {
   my ($self, @rest) = @_; return $self->_init( q(dir), @rest );
}

sub dir_pattern {
   my $self = shift; my ($curdir, $pat, $updir);

   return $pat if ($pat = $self->_dir_pattern);

   $updir  = File::Spec->updir;
   $curdir = File::Spec->curdir;
   $pat    = "\Q$curdir\E" if ($curdir);
   $pat   .= q(|)          if ($updir and $pat);
   $pat   .= "\Q$updir\E"  if ($updir);
   return $self->_dir_pattern( qr{ \A $pat \z }mx );
}

sub dirname {
   my $self = shift;

   return unless ($self->pathname);

   return File::Basename::dirname( $self->pathname );
}

sub empty {
   my $self = shift; return -z $self->pathname;
}

sub encoding {
   my ($self, $encoding) = @_;

   unless ($encoding) {
      $self->throw( 'No encoding value passed to '.__PACKAGE__.'::encoding' );
   }

   $self->is_open && CORE::binmode( $self->io_handle, ":$encoding" );
   $self->_encoding( $encoding );
   return $self;
}

sub error_check {
   my $self = shift;

   $self->io_handle->can( q(error) ) || return;
   $self->io_handle->error || return;
   $self->throw( error => 'IO error [_1]', args => [ $ERRNO ] );
   return;
}

sub exists {
   my $self = shift; return -e $self->pathname;
}

sub file {
   my ($self, @rest) = @_; return $self->_init( q(file), @rest );
}

sub filename {
   my $self = shift; my $file;

   (undef, undef, $file) = File::Spec->splitpath( $self->pathname );
   return $file;
}

sub filepath {
   my $self = shift;
   my ($volume, $path) = File::Spec->splitpath( $self->pathname );

   return File::Spec->catpath( $volume, $path, $NUL );
}

sub getline {
   my ($self, @rest) = @_; my $line;

   $self->assert_open( q(r) );

   {
      $rest[0] and local $RS = $rest[0];
      $line = $self->io_handle->getline;
      CORE::chomp $line if ($self->_chomp && defined $line);
   }

   $self->error_check;
   return $line if (defined $line);
   $self->autoclose && $self->close;
   return;
}

sub getlines {
   my ($self, @rest) = @_; my @lines;

   $self->assert_open( q(r) );

   {
      $rest[0] and local $RS = $rest[0];
      @lines = $self->io_handle->getlines;

      if ($self->_chomp) { CORE::chomp for @lines }
   }

   $self->error_check;
   return (@lines) if (scalar @lines);
   $self->autoclose && $self->close;
   return ();
}

sub is_absolute {
   my $self = shift;

   return File::Spec->file_name_is_absolute( $self->pathname );
}

sub is_dir {
   my $self = shift;

   $self->type && return $self->type eq q(dir) ? 1 : 0;
   return $self->pathname and -d $self->pathname ? 1 : 0;
}

sub is_file {
   my $self = shift;

   $self->type && return $self->type eq q(file) ? 1 : 0;
   return $self->pathname and -f $self->pathname ? 1 : 0;
}

sub length {
   my $self = shift; return length ${ $self->buffer };
}

sub lock {
   my $self = shift; $self->_lock( 1 ); return $self;
}

sub next {
   my $self = shift; my ($io, $name);

   $self->type || $self->dir;
   $self->assert_open;
   return unless defined ($name = $self->read_dir);
   $io = $self->new( File::Spec->catfile( $self->pathname, $name ) );
   return $io;
}

sub open {
   my ($self, @rest) = @_;

   $self->is_dir  && return $self->_open_dir(  @rest );
   $self->is_file && return $self->_open_file( @rest );
   return;
}

sub _open_dir {
   my ($self, @rest) = @_; my $io;

   $self->is_open && return $self;
   $self->_assert
      && $self->pathname && $self->assert_dirpath( $self->pathname );

   unless ($io = IO::Dir->new( $self->pathname )) {
      $self->throw( error => 'Cannot open [_1]', args => [ $self->pathname ] );
   }

   $self->io_handle( $io );
   $self->is_open( 1 );
   return $self;
}

sub _open_file {
   my ($self, @rest) = @_; my ($mode, $perms) = @rest; my (@args, $io);

   return $self if ($self->is_open);

   $self->_assert && $self->assert_filepath;
   @args = ( $self->mode( $mode || $self->mode || q(r) ) );
   $self->_perms( $perms )   if defined $perms;
   push @args, $self->_perms if defined $self->_perms;

   if (defined $self->pathname) {
      my $pathname = $self->_atomic ? $self->_atomic : $self->pathname;

      unless ($io = IO::File->new( $pathname, @args )) {
         $self->throw( error => 'Cannot open [_1]', args => [ $pathname ] );
      }

      $self->io_handle( $io );
      $self->is_open( 1 );
   }

   $self->_lock && $self->set_lock;
   $self->set_binmode;
   return $self;
}

sub pathname {
   my ($self, @rest) = @_; return $self->name( @rest );
}

sub perms {
   my ($self, $perms) = @_; $self->_perms( $perms ); return $self;
}

sub print {
   my ($self, @rest) = @_;

   $self->assert_open( q(w) );

   for (@rest) {
      print {$self->io_handle} $_
         or $self->throw( error => 'IO error [_1]',
                          args  => [ $ERRNO ] );
   }

   return;
}

sub println {
   my ($self, @rest) = @_;

   return $self->print( map { m{ [\n] \z }mx ? ($_) : ($_, "\n") } @rest );
}

sub read {
   my ($self, @rest) = @_;

   $self->assert_open( q(r) );
   my $length = (@rest or $self->is_dir)
              ? $self->io_handle->read( @rest )
              : $self->io_handle->read( ${ $self->buffer },
                                        $self->block_size, $self->length );
   $self->error_check;
   return $length || $self->autoclose && $self->close && 0;
}

sub read_dir {
   my $self = shift; my $dir_pat = $self->dir_pattern; my ($name, @names);

   $self->type || $self->dir;
   $self->assert_open;

   if (wantarray) {
      @names = grep { $_ !~ $dir_pat } $self->io_handle->read;
      $self->_close_dir;
      return @names;
   }

   while (not $name or $name =~ $dir_pat) {
      unless (defined ($name = $self->io_handle->read)) {
         $self->_close_dir;
         return;
      }
   }

   return $name;
}

sub set_binmode {
   my $self = shift;

   if (my $encoding = $self->_encoding) {
      CORE::binmode( $self->io_handle, ":encoding($encoding)" );
   }
   elsif ($self->_binary) {
      CORE::binmode( $self->io_handle );
   }
   elsif ($self->_binmode) {
      CORE::binmode( $self->io_handle, $self->_binmode );
   }

   return $self;
}

sub set_lock {
   my $self = shift;

   return $self->lock_obj->set( k => $self->pathname ) if ($self->lock_obj);

   my $flag = $self->mode =~ m{ \A [r] \z }mx ? LOCK_SH : LOCK_EX;

   return flock $self->io_handle, $flag;
}

sub slurp {
   my $self = shift; my $slurp = $self->all;

   wantarray || return $slurp;

   if ($self->_chomp) {
      return map { CORE::chomp; $_ } split m{ (?<=\Q$RS\E) }mx, $slurp;
   }

   return split m{ (?<=\Q$RS\E) }mx, $slurp;
}

sub stat {
   my $self = shift; my %stat_hash = ( id => $self->filename );

   @stat_hash{ @STAT_FIELDS } = stat $self->pathname;
   return \%stat_hash;
}

sub tempfile {
   my ($self, $tmplt) = @_; my ($tempdir, $tmpfh);

   unless ($tempdir = $self->pathname and -d $tempdir) {
      $tempdir = File::Spec->tmpdir;
   }

   $tmplt ||= q(%6.6dXXXX);
   $tmpfh   = File::Temp->new( DIR      => $tempdir,
                               TEMPLATE => (sprintf $tmplt, $PID) );
   $self->_init( q(file), $tmpfh->filename );
   $self->io_handle( $tmpfh );
   $self->is_open( 1 );
   return $self;
}

sub throw {
   my ($self, @rest) = @_;

   eval { $self->unlock; };

   $self->exception_class->throw( @rest ) if ($self->exception_class);

   IO::Exception->throw( @rest );
   return;
}

sub touch {
   my ($self, @rest) = @_;

   $self->pathname || return;

   if (-e $self->pathname) {
      my $now = time; utime $now, $now, $self->pathname;
   }
   else { $self->_open_file( q(w), $self->_perms || oct q(0664) )->close }

   return $self;
}

sub unlock {
   my $self = shift; $self->_lock || return;

   if ($self->lock_obj) { $self->lock_obj->reset( k => $self->pathname ) }
   else { flock $self->io_handle, LOCK_UN }

   return $self;
}

sub utf8 {
   my $self = shift;

   $self->encoding( q(utf8) );
   $self->_utf8( 1 );
   return $self;
}

sub write {
   my ($self, @rest) = @_;

   $self->assert_open( q(w) );
   my $length = @rest
              ? $self->io_handle->write( @rest )
              : $self->io_handle->write( ${ $self->buffer }, $self->length );
   $self->error_check;
   $self->clear unless (@rest);
   return $length;
}

1;

__END__

# Local Variables:
# mode: perl
# tab-width: 3
# End: