File Coverage

blib/lib/Log/Delimited.pm

Criterion	Covered	Total	%
statement	104	123	84.5
branch	33	74	44.5
condition	13	39	33.3
subroutine	15	18	83.3
pod	0	12	0.0
total	165	266	62.0

#!/usr/bin/perl -w

package Log::Delimited;

use strict;
use vars qw(@EXPORT @EXPORT_OK @ISA $LOG_BASE_DIR $VERSION);

use Exporter;
@ISA = ('Exporter');
@EXPORT = qw(log);
@EXPORT_OK = qw($LOG_BASE_DIR);

use File::Path qw(mkpath);
use Storable qw(freeze);
use Sys::Hostname qw(hostname);

$LOG_BASE_DIR = "/tmp/logs";
$VERSION = '0.90';

sub O_RDWR () { 2 }
sub O_CREAT () { 64 }


sub new {
  my $type  = shift;
  my @PASSED_ARGS = (ref $_[0] eq 'HASH') ? %{$_[0]} : @_;
  my @DEFAULT_ARGS = (
    base_dir      => $LOG_BASE_DIR,

    delimiter     => '|',
    log_cols      => '',

    # log_info is an array ref of the info you would like to log
    log_info      => '',
    log_name      => '',
    log_node      => 'main',

    no_hostname   => 0,
    no_pid        => 0,
    no_time       => 0,
  );
  my %ARGS = (@DEFAULT_ARGS, @PASSED_ARGS);
  foreach(qw(log_node log_name)) {
    unless($ARGS{$_}) {
      ($ARGS{$_}) = ($0 =~ m@.*/(.+)@) || $0;
    }
  }
  my $self = bless \%ARGS, $type;
  die "need a \$self->{log_name}" unless($self->{log_name});
  $self->handle_dirs;
  $self->mkpath_dirs;
  return $self;
}

sub URLEncode {
  my $arg = shift;
  my ($ref,$return) = ref($arg) ? ($arg,0) : (\$arg,1) ;

  $$ref =~ s/([^\w\.\ -])/sprintf("%%%02X",ord($1))/eg;
  $$ref =~ tr/\ /+/;

  return $return ? $$ref : '';
}

sub handle_dirs {
  my $self = shift;
  return if($self->{handled_dirs});
  die "need a \$self->{base_dir}" unless($self->{base_dir});
  die "need a \$self->{log_name}" unless($self->{log_name});
  $self->{log_dir}      ||= "$self->{base_dir}/$self->{log_node}";
  $self->{log_filename} ||= "$self->{log_dir}/$self->{log_name}";
  $self->{zip_filename} ||= "$self->{log_dir}/$self->{log_name}.gz";
  $self->{handled_dirs} = 1;
}

sub mkpath_dirs {
  my $self = shift;
  return if($self->{mkpathd});
  foreach(keys %{$self}) {
    next unless(/_dir$/ && $self->{$_} =~ m@^/@);
    mkpath ($self->{$_}) unless(-d $self->{$_});
    die "couldn't mkpath $self->{$_}" unless(-d $self->{$_});
  }
  $self->{mkpathd} = 1;
}

sub handle_log_cols {
  my $self = shift;
  if(ref $self->{log_cols} eq 'ARRAY' && !$self->{cols_string}) {
    unshift @{$self->{log_cols}}, 'hostname' unless($self->{unshifted_hostname} || $self->{no_hostname});
    unshift @{$self->{log_cols}}, 'pid' unless($self->{unshifted_pid} || $self->{no_pid});
    unshift @{$self->{log_cols}}, 'time' unless($self->{unshifted_time} || $self->{no_time});
    $self->{cols_string} = join($self->{delimiter}, @{$self->{log_cols}});
  } else {
    $self->{cols_string} = $self->{log_cols};
  }
}

sub handle_log_info {
  my $self = shift;
  my $ref = shift;
  die "\$self->{log_info} is required" unless($ref);
  die "\$self->{log_info} needs to be an array ref" unless(ref $ref && ref $ref eq 'ARRAY');
  unshift @{$ref}, hostname unless($self->{no_hostname});
  unshift @{$ref}, $$ unless($self->{no_pid});
  unshift @{$ref}, time unless($self->{no_time});
}

sub ref2string {
  my $self = shift;
  my $ref = shift;
  unless(ref $ref && ref $ref eq 'ARRAY') {
    $ref = [$ref];
  }
  my @this_array = @{$ref};
  foreach(@this_array) {
    $_ = '' unless((defined $_) && length $_);
    if(ref $_ && ref $_ eq 'HASH') {
      $_ = freeze $_;
    }
    URLEncode \$_ unless($self->{no_URLEncode});
  }
  my $string = join($self->{delimiter}, @this_array);
  return $string;
}

sub log {
  my $self = shift;
  die "need a " . __PACKAGE__ . " object" unless(ref $self eq __PACKAGE__);

  open(LOG, ">>$self->{log_filename}") || die "couldn't opendir $self->{log_filename}: $!";
  if(!-s $self->{log_filename}) {
    if($self->{log_cols}) {
      $self->handle_log_cols;
      print LOG "$self->{cols_string}\n";
    }
  }

  unless(ref $self->{log_info}[0] eq 'ARRAY') {
    $self->{log_info} = [$self->{log_info}];
  }

  for(my $i=0;$i<@{$self->{log_info}};$i++) {
    my (@this_array) = @{$self->{log_info}[$i]};
    $self->handle_log_info(\@this_array);
    my $this_string = $self->ref2string(\@this_array);
    print LOG "$this_string\n";
  }
  close(LOG);
  delete $self->{log_info};
}

sub wipe {
  my $self = shift;
  if(-e $self->{log_filename}) {
    return unlink $self->{log_filename};
  }
}

sub zip {
  my $self = shift;
  die "need a \$self->{log_filename}" unless($self->{log_filename});
  die "need a \$self->{zip_filename}" unless($self->{zip_filename});
  return unless(-s $self->{log_filename});
  system("gzip -c < $self->{log_filename} > $self->{zip_filename}");
}

sub unzip {
  my $self = shift;
  die "need a \$self->{log_filename}" unless($self->{log_filename});
  die "need a \$self->{zip_filename}" unless($self->{zip_filename});
  return unless(-s $self->{zip_filename});
  system("gzip -dc < $self->{zip_filename} > $self->{log_filename}");
}

sub log_zipped {
  my $self = shift;
  $self->unzip;
  $self->log;
  $self->zip;
  $self->wipe;
}

1;

__END__