File Coverage

blib/lib/GetRc.pm

Criterion	Covered	Total	%
statement	119	212	56.1
branch	23	96	23.9
condition	7	36	19.4
subroutine	13	23	56.5
pod	4	10	40.0
total	166	377	44.0

package GetRc;
require 5.002;
require Exporter;

#use strict;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK $AUTOLOAD);
use File::Basename;
use UNIVERSAL qw(isa);
use Carp;
use IO::File;
use Fcntl qw(:DEFAULT :flock); # import LOCK_* constants


### my initial version was 0.13
### version 0.20 is first OO ( Object Oriented of course )
$VERSION = '0.23';

@ISA = qw(Exporter);

# Items to export into callers namespace by default
@EXPORT =	qw();

# Other items we are prepared to export if requested
@EXPORT_OK =	qw();


sub new {
	my $type = shift;
	my $class = ref($type) || $type;
	croak "Usage $class->new (filename)" if ( @_ != 1 ) ;
	my $self = {};
	bless $self, $class;

	$self->{'filename'} = shift;

	$self->_init;
	$self->_find_file;

	return($self);
}

sub _find_file {
  my $self = shift;

  foreach (  @{$self->{'find_path'}} ) {
    last if ( $self->{'filename'} =~ /^\//);
    $self->{'filename'} = "$_".$self->{'filename'},last if ( -e "$_".$self->{'filename'}) ;
  }
  $self->dprint("file is " . $self->{'filename'});

}

sub _init {
  my $self = shift;
  my ( $filename,$dirname ) = fileparse($0);
  $self->{'ifs'} = '\s*=\s*';
  $self->{'ofs'} = ' = ';
  $self->{'debug'} = 0;
  $self->{'multivalues'} = 1;
  $self->{'lock'} = 1;
  $self->{'locktimeout'} = 15;
  $self->{'find_path'} = [
                           "./",
                           (getpwuid($>))[7]."/",
                           $dirname,
                           "../",
                           "/usr/local/etc/",
                         ];

  bless $self->{'find_path'};

  return($self);
}

sub writerc ($\%) {
  my $self = shift;
  local *h_input = shift;
  my ($rc);

  $self->dprint("join to writerc");
  ### locking ? uff .. this a bit messy code
  if ( $self->{'lock'} ) {
    eval {
      local $SIG{ALRM} = sub { die "File lock timeouted\n" };
      alarm($self->{'locktimeout'});
      $self->dprint("openning file ".$self->{'filename'});
      $rc = new IO::File $self->{'filename'}, O_CREAT|O_WRONLY|O_TRUNC;
      croak "Can't open file\n" unless ( defined $rc );
      $self->dprint("locking file ".$self->{'filename'});
      flock($rc,LOCK_EX);
      $self->dprint($self->{'filename'} . " locked");
      alarm(0);
    };

  if ($@) {
    return(-3),$self->dprint("File lock timeouted\n") if $@ eq "File lock timeouted\n";
    return(-4),$self->dprint("Can't open file ".$self->{'filename'}) if $@ eq "Can't open file\n";
  }

  } else {
    $self->dprint("openning file ".$self->{'filename'});
    $rc = new IO::File $self->{'filename'}, O_CREAT|O_WRONLY|O_TRUNC;
    croak "Can't open file ".$self->{'filename'}." : $!" unless ( defined $rc );
  }

  my $separator = $self->{'ofs'};

    while (($key,$value) = each %h_input) {
      print $rc "$key${separator}$value\n";
      print "HEY: $key => $value\n";
    }
  flock($rc,LOCK_UN),$self->dprint( $self->{'filename'} ." unlocked") if ( $self->{'lock'} );
  $rc->close;
  croak "Can't close file ".$self->{'filename'} .": $1" if $?;
  $self->dprint( $self->{'filename'} ." closed");
  return(0);

}

sub getrc ($\%){
  my $self = shift;
  local *h_input = shift;
  my ( $key, $value, $rc);

  $self->dprint("join to getrc");
  $self->dprint("file ".$self->{'filename'}." doesn't exist"),return(-1) unless ( -e $self->{'filename'} );
  $self->dprint("Can't read file ".$self->{'filename'}),return(-2) unless ( -r $self->{'filename'} || -R $self->{'filename'} );

  ### locking ? uff .. this a bit messy code
  if ( $self->{'lock'} ) {
    eval {
      local $SIG{ALRM} = sub { die "File lock timeouted\n" };
      alarm($self->{'locktimeout'});
      $self->dprint("openning file ".$self->{'filename'});
      $rc = new IO::File $self->{'filename'}, O_RDONLY;
      croak "Can't open file ".$self->{'filename'}." : $!" unless  ( defined $rc );
      $self->dprint("locking file ".$self->{'filename'});
      flock($rc,LOCK_EX);
      $self->dprint($self->{'filename'} . " locked");
      alarm(0);
    };

  if ($@) {
    $self->dprint("File lock timeouted\n") if $@ eq "File lock timeouted\n";
    return(-3);
  }

  } else {
    $self->dprint("openning file ".$self->{'filename'});
    $rc = new IO::File $self->{'filename'}, O_RDONLY;
    croak "Can't open file ".$self->{'filename'}." : $!" unless ( defined $rc );
  }

  my $separator = $self->{'ifs'};

    while (<$rc>) {
      chomp;
      #### Skip blank text entry fields and comment
      next if ( /^\s*#/ || /^\s*$/ || /^\s*\;/);

      #### Allow for multiple line values
      if (s/\\$//) {
        $_ .= <$rc>;
        redo;
      }

      ($key,$value) = /\s*(.*?)${separator}(.*)/;

      ### skip empty keys
      $self->dprint("skip line: $_"),next if ( !defined($value) || !$key );

      #### Allow for multiple values of a single name
      if ($h_input{"$key"} && $self->{'multivalues'}) {
        $h_input{"$key"} .= ", " ;
        $h_input{"$key"} .= $value;
      } else {
        $h_input{"$key"} = $value;
      }
    }
  flock($rc,LOCK_UN),$self->dprint( $self->{'filename'} ." unlocked") if ( $self->{'lock'} );
  $rc->close;
  croak "Can't close file ".$self->{'filename'} .": $1" if $?;
  $self->dprint( $self->{'filename'} ." closed");
  return(0);
}

sub updaterc ($\%){
  my $self = shift;
  local *h_input = shift;
  my ( $key, $value, $rc, %update_input);

  $self->dprint("join to updaterc");
  $self->dprint("WARN: file ".$self->{'filename'}." doesn't exist") unless ( -e $self->{'filename'} );
  $self->dprint("WARN: Can't read file ".$self->{'filename'}) unless ( -r $self->{'filename'} || -R $self->{'filename'} );

  ### locking ? uff .. this a bit messy code
  if ( $self->{'lock'} ) {
    eval {
      local $SIG{ALRM} = sub { die "File lock timeouted\n" };
      alarm($self->{'locktimeout'});
      $self->dprint("openning file ".$self->{'filename'});
      $rc = new IO::File $self->{'filename'}, O_RDWR|O_CREAT;
      croak "Can't open file\n" unless ( defined $rc );
      $self->dprint("locking file ".$self->{'filename'});
      flock($rc,LOCK_EX);
      $self->dprint($self->{'filename'} . " locked");
      alarm(0);
    };

  if ($@) {
    return(-3),$self->dprint("File lock timeouted\n") if $@ eq "File lock timeouted\n";
    return(-4),$self->dprint("Can't open file ".$self->{'filename'}) if $@ eq "Can't open file\n";

  }

  } else {
    $self->dprint("openning file ".$self->{'filename'});
    $rc = new IO::File $self->{'filename'}, O_RDWR|O_CREAT;
    croak "Can't open file ".$self->{'filename'}." : $!" unless ( defined $rc );
  }

  my $separator = $self->{'ifs'};

    while (<$rc>) {
      chomp;
      #### Skip blank text entry fields and comment
      next if ( /^\s*#/ || /^\s*$/ || /^\s*\;/);

      #### Allow for multiple line values
      if (s/\\$//) {
        $_ .= <$rc>;
        redo;
      }

      ($key,$value) = /\s*(.*?)${separator}(.*)/;

      ### skip empty keys
      $self->dprint("skip line: $_"),next if ( !defined($value) || !$key );

      #### Allow for multiple values of a single name
      if ($update_input{"$key"} && $self->{'multivalues'}) {
        $update_input{"$key"} .= ", " ;
        $update_input{"$key"} .= $value;
      } else {
        $update_input{"$key"} = $value;
      }
    }

  while (($key,$value) = each %h_input) {
    $update_input{"$key"} = $value;
  }

  $separator = $self->{'ofs'};

  seek($rc,0,0);
  truncate($rc,0);

  while (($key,$value) = each %update_input) {
    print $rc "$key${separator}$value\n";
  }


  flock($rc,LOCK_UN),$self->dprint( $self->{'filename'} ." unlocked") if ( $self->{'lock'} );
  $rc->close;
  croak "Can't close file ".$self->{'filename'} .": $1" if $?;
  $self->dprint( $self->{'filename'} ." closed");
  return(0);
}

sub configure {
	my $self = shift;
	my (%arg) = @_;

	foreach (keys %arg) {
		$self->{"$_"} = $arg{$_};
	}

	bless $self->{'find_path'};
	return($self);
}

sub dprint {
  my $self = shift;
  my $debug_output = shift;
  my $filename = $self->{'filename'};
  return(0) unless $self->{'debug'};
  print STDERR <
  ==> PID:$$\t$debug_output

EOM
}

sub AUTOLOAD {
  my $self = shift;
  my $value = shift;
  my ($name) = $AUTOLOAD;

  ($name) = ( $name =~ /^.*::(.*)/);

  $self->{$name} = $value if ( defined $value );

  ### find file location
  $self->_find_file if ( $value && ($name eq 'filename'));

  if ( ref($self->{$name}) =~ /ARRAY/ ) {
    return(@{$self->{$name}});
  } elsif (isa($self->{$name}, 'ARRAY')) {
    if ( wantarray ) {
      return(@{$self->{$name}});
    } else {
      return($self->{$name});
    }
  } else {
    return($self->{$name});
  }
}

sub push {
  my $self = shift;
  my $value = shift;

  return() unless (ref($self) !~ /ARRAY/ );

  push @{$self},$value;
  return($self);
}

sub unshift {
  my $self = shift;
  my $value = shift;

  return() unless (ref($self) !~ /ARRAY/ );

  unshift @{$self},$value;
  return($self);
}

sub pop {
  my $self = shift;

  return() unless (ref($self) !~ /ARRAY/ );

  pop @{$self};
}

sub shift {
  my $self = shift;

  return() unless (ref($self) !~ /ARRAY/ );

  shift @{$self};
}

sub DESTROY {}


1;
__END__