Crane

 view release on metacpan or  search on metacpan

lib/Crane.pm  view on Meta::CPAN

use File::Spec::Functions qw( catdir splitdir );


our $VERSION = '1.03.0011';


sub get_package_path {
    
    my ( $package ) = @_;
    
    my @path      = split m{::}si, $package;
       $path[-1] .= '.pm';
    
    return catdir(@path);
    
}


sub create_package_alias {
    
    my ( $original, $alias ) = @_;

lib/Crane/Logger.pm  view on Meta::CPAN

    
    local $Data::Dumper::Indent = 1;
    local $Data::Dumper::Purity = 0;
    local $Data::Dumper::Terse  = 1;
    
    flock $fh, LOCK_EX;
    
    my $datetime = strftime(q{%Y-%m-%d %H:%M:%S %z %s}, localtime);
    
    foreach my $message ( @messages ) {
        foreach my $line ( split m{$INPUT_RECORD_SEPARATOR}osi, ( not defined $message or ref $message ) ? Dumper($message) : $message ) {
            print { $fh } "[$datetime] $line\n" or confess($OS_ERROR);
        }
    }
    
    flock $fh, LOCK_UN;
    
    return;
    
}

lib/Crane/Logger.pm  view on Meta::CPAN

  log_fatal('Fatal message', caller);
  log_error('Error message');
  log_warning('Warning message', $ref);
  log_info("First line\nSecond line\n");
  log_debug($ref);
  log_verbose('First line', 'Second line');


=head1 DESCRIPTION

Simple log manager with six log levels. Supports auto split messages by "end of
line" and dump references using L<Data::Dumper|Data::Dumper>.


=head2 Log entry

Each log entry looks like ...

  [2013-12-30 02:36:22 +0400 1388356582] Hello, world!

... and contains:

lib/Crane/Options.pm  view on Meta::CPAN

        
        my $spec   = $opt->[0];
        my $desc   = $opt->[1];
        my $params = $opt->[2];
        
        # Separator
        if ( not defined $spec and not defined $desc and not defined $params ) {
            $help .= "\n";
        # Option
        } elsif ( defined $spec and $spec =~ m{^([^!+=:]+)}si ) {
            my @names = split m{[|]}si, $1;
            my $name  = $names[0];
            my $short = ( grep { length == 1 } @names )[0];
            my $long  = ( grep { length >= 2 } @names )[0];
            
            # Check params
            if ( ref $params eq 'HASH' ) {
                # Default value
                if ( exists $params->{'default'} and not exists $options->{ $name } ) {
                    $options->{ $name } = $params->{'default'};
                }