CatalystX::Usul::Base - Base class utility methods

   package MyBaseClass;

   use base qw(CatalystX::Usul::Base);

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

      my $new      = $self->next::method( $app, @rest );
      my $app_conf = $app->config || {};

      $new->debug   ( $app->debug           || 0                  );
      $new->encoding( $app_conf->{encoding} || q(UTF-8)           );
      $new->log     ( $app->log             || Class::Null->new() );
      $new->tempdir ( $app_conf->{tempdir}  || File::Spec->tmpdir );

      return $new;
   }

   $prefix = $self->app_prefix( __PACKAGE__ );

   $args = $self->arg_list( @rest );

   $basename = $self->basename( $path, @suffixes );

   $e = $self->catch;

   $dir_path = $self->catdir( $part1, $part2 );

   $file_path = $self->catfile( $dir_path, $file_name );

   $appdir = $self->class2appdir( __PACKAGE__ );

   $path = $self->classfile( __PACKAGE__ );

   $random_hex = $self->create_token( $seed );

   $self->delete_tmp_files( $dir );

   $dirname = $self->dirname( $path );

   $distname = $self->distname( __PACKAGE__ );

   $self->ensure_class_loaded( $some_class );

   $prefix = $self->env_prefix( $class );

   $text = $self->escape_TT( q([% some_stash_key %]) );

   $path = $self->find_source( $module_name );

   $appldir = $self->home2appl( $home_dir );

   $io_obj = $self->io( $pathname );

   $bool = $self->is_member( q(test_value), qw(a_value test_value b_value) );

   $self->load_component( $child, @parents );

   $self->nap( $time_in_seconds );

   $self->say( @lines_of_text );

   $time_date_string = $self->stamp( $time );

   $stat_ref = $self->status_for( $path );

   $date_time_obj = $self->str2date_time( $date_time_string );

   $seconds = $self->str2time( $date_time_string );

   $stripped = $self->strip_leader( q(my_program: Error message) );

   $sub_name = $self->sub_name( $level );

   $bool = $self->supports( @spec );

   $tempfile_obj = $self->tempfile( $dir );

   $pathname = $self->tempname( $dir );

   $self->throw( error => q(error_key), args => [ q(error_arg) ] );

   $date_time_string = $self->time2str( $format, $time );

   $text = $self->unescape_TT( q(<% some_stash_key %>) );

   $uuid = $self->uuid;

# @(#)$Id: Base.pm 611 2009-06-27 02:56:27Z pjf $

package CatalystX::Usul::Base;

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

use CatalystX::Usul::Exception;
use CatalystX::Usul::File::IO;
use CatalystX::Usul::Time;
use Class::MOP;
use Digest qw();
use English qw(-no_match_vars);
use File::Spec;
use List::Util qw(first);
use Path::Class::Dir;

__PACKAGE__->mk_log_methods();

sub app_prefix {
   my ($self, $class) = @_; (my $prefix = lc $class) =~ s{ :: }{_}gmx;

   return $prefix;
}

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

   return {} unless ($rest[0]);

   return ref $rest[0] eq q(HASH) ? { %{ $rest[0] } } : { @rest };
}

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

   return $self->io( $path )->basename( @suffixes );
}

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

sub catdir {
   my ($self, @rest) = @_; return File::Spec->catdir( @rest );
}

sub catfile {
   my ($self, @rest) = @_; return File::Spec->catfile( @rest );
}

sub class2appdir {
   my ($self, $class) = @_; return lc $self->distname( $class );
}

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

   return $self->catfile( split m{ :: }mx, $class.q(.pm) );
}

sub create_token {
   my ($self, $seed) = @_; my ($candidate, $digest, $digest_name);

   unless ($digest_name = __PACKAGE__->get_inherited( q(digest) )) {
      for $candidate (qw(SHA-256 SHA-1 MD5)) {
         last if ($digest = eval { Digest->new( $candidate ) });
      }

      $self->throw( 'No digest algorithm' ) unless ($digest);

      __PACKAGE__->set_inherited( q(digest), $candidate );
   }
   else { $digest = Digest->new( $digest_name ) }

   $digest->add( $seed || join q(), time, rand 10_000, $PID, {} );
   return $digest->hexdigest;
}

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

   return $self->io( $dir || $self->tempdir )->delete_tmp_files;
}

sub dirname {
   my ($self, $path) = @_; return $self->io( $path )->dirname;
}

sub distname {
   my ($self, $class) = @_; (my $distname = $class) =~ s{ :: }{-}gmx;

   return $distname;
}

sub ensure_class_loaded {
   my ($self, $class, $opts) = @_; my $error; $opts ||= {};

   my $is_class_loaded = sub { Class::MOP::is_class_loaded( $class ) };

   return 1 if (not $opts->{ignore_loaded} and $is_class_loaded->());

   {  local $EVAL_ERROR = undef;
      eval { Class::MOP::load_class( $class ) };
      $error = $EVAL_ERROR;
   }

   $self->throw( $error ) if ($error);

   return 1 if ($is_class_loaded->());

   $error = 'Class [_1] loaded but package undefined';
   $self->throw( error => $error, args => [ $class ] );
   return;
}

sub env_prefix {
   my ($self, $class) = @_; return uc $self->app_prefix( $class );
}

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

   $val ||= q(); $val =~ s{ \[\% }{<%}gmx; $val =~ s{ \%\] }{%>}gmx;
   return $val;
}

sub exception_class {
   return q(CatalystX::Usul::Exception);
}

sub find_source {
   my ($self, $class) = @_; my $base = $self->classfile( $class );

   for (@INC) {
      my $path = $self->catfile( $_, $base );
      return $path if (-f $path);
   }

   return;
}

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

   return unless ($home);

   my $dir = Path::Class::Dir->new( $home );

   $dir = $dir->parent while ($dir ne $dir->parent and $dir !~ m{ lib \z }mx);

   return $dir->parent;
}

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

   my $io = CatalystX::Usul::File::IO->new( @rest );

   $io->exception_class( $self->exception_class );

   $io->lock_obj( $self->{lock} ) if (ref $self && exists $self->{lock});

   return $io;
}

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

   return unless ($candidate);

   return (first { $_ eq $candidate } @rest) ? 1 : 0;
}

sub load_component {
   my ($self, $child, @parents) = @_;

   ## no critic
   for my $parent (reverse @parents) {
      $self->ensure_class_loaded( $parent );
      {  no strict q(refs);

         unless ($child eq $parent || $child->isa( $parent )) {
            unshift @{ "${child}::ISA" }, $parent;
         }
      }
   }

   unless (exists $Class::C3::MRO{ $child }) {
      eval "package $child; import Class::C3;";
   }
   ## critic
   return;
}

sub nap {
   my ($self, @rest) = @_; return CatalystX::Usul::Time->nap( @rest );
}

sub say {
   my ($self, @rest) = @_; local ($OFS, $ORS) = ("\n", "\n"); chomp( @rest );

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

sub stamp {
   my ($self, @rest) = @_; return CatalystX::Usul::Time->stamp( @rest );
}

sub status_for {
   my ($self, $path) = @_; return $self->io( $path )->stat;
}

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

   return CatalystX::Usul::Time->str2date_time( @rest );
}

sub str2time {
   my ($self, @rest) = @_; return CatalystX::Usul::Time->str2time( @rest );
}

sub strip_leader {
   my ($self, $val) = @_; $val =~ s{ \A [^:]+ [:] \s+ }{}msx; return $val;
}

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

   $level = 0 unless (defined $level);

   return (split m{ :: }mx, (caller ++$level)[3])[-1];
}

sub supports {
   my ($self, @spec) = @_; my $cursor = eval { $self->get_features } || {};

   return 1 if (@spec == 1 and exists $cursor->{ $spec[0] });

   # Traverse the feature list
   for (@spec) {
      return if (ref $cursor ne q(HASH)); $cursor = $cursor->{ $_ };
   }

   return $cursor unless (ref $cursor);

   return if (ref $cursor ne q(ARRAY));

   # Check that all the keys required for a feature are in here
   for (@{ $cursor }) { return unless exists $self->{ $_ } }

   return 1;
}

sub tempfile {
   my ($self, $dir) = @_; return $self->io( $dir || $self->tempdir )->tempfile;
}

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

   my $file = sprintf '%6.6d%s', $PID, (substr $self->create_token, 0, 4);

   return $self->catfile( $dir || $self->tempdir, $file );
}

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

sub time2str {
   my ($self, @rest) = @_; return CatalystX::Usul::Time->time2str( @rest );
}

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

   $val =~ s{ \<\% }{[%}gmx; $val =~ s{ \%\> }{%]}gmx;
   return $val;
}

sub uuid {
   return shift->io( q(/proc/sys/kernel/random/uuid) )->chomp->lock->getline;
}

1;

__END__

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