File Coverage

blib/lib/Mail/Box/MH/Resource.pm

Criterion	Covered	Total	%
statement	51	56	91.0
branch	14	22	63.6
condition	4	6	66.6
subroutine	10	10	100.0
pod	5	5	100.0
total	84	99	84.8

require 5.006;
package Mail::Box::MH::Resource;
use Cwd;
use File::Spec;
use Mail::Reporter;
use vars ('$VERSION', @ISA);
$VERSION = 0.06;
@ISA = 'Mail::Reporter';

local($_, $/, %ENV);

my $curdir = File::Spec->catfile(File::Spec->curdir(), 'foo');
   $curdir =~s/\bfoo$//;

sub new{
  shift;
  my $self = bless {};
  $self->SUPER::init();

  unless( $self->{_file} = shift ){
    if( exists($ENV{MH}) ){
      $self->{_file} = File::Spec->file_name_is_absolute($ENV{MH}) ?
	$ENV{MH} : File::Spec->catfile(cwd(), $ENV{MH});
    }
    $self->{_file} ||= File::Spec->catfile($ENV{HOME}, '.mh_profile');
  }
  unless( File::Spec->file_name_is_absolute($self->{_file}) ||
	  $self->{_file} =~ m%^\Q$curdir\E% ){
    my $profile = Mail::Box::MH::Resource->new();
    my $path = $profile->get('Path');
    $path = File::Spec->file_name_is_absolute($path) ? $path :
      File::Spec->catdir($ENV{HOME}, $path);
    $self->{_file} = File::Spec->catfile($path, $self->{_file});
  }

  if( -e $self->{_file} ){
    if( open(my $profile, $self->{_file}) ){
      while( <$profile> ){
	chomp;
	next unless defined($_);
	#MH doesn't strip out leading whitespace, so this is okay
	my @F = split(/:\s*/, $_ ,2);
	$self->{_profile}->{$F[0]} = $F[1];
      }
      close($profile);
      $self->log(PROGRESS=>"Resource file F<$self->{_file}> opened for read.");
    }
    else{
      $self->log(ERROR=>"Resource file F<$self->{_file}> could not be opened for read: $!");
      return;
    }
  }
  else{
    $self->log(NOTICE=>"Resource file F<$self->{_file}> does not exist, it will be created on close()");
  }
  return $self;
}

sub get{
  return @{shift->{_profile}}{@_};
}

sub set{
  my $self = shift;
  my %hash = @_;
  $self->{_profile}->{$_} = $hash{$_} for keys %hash;
  #XXX Should this actually only get touched if any keys are *modified*?
  $self->{_modified} = 1;
};

sub close{
  my $self = shift;
  if( open(my $profile, '>', $self->{_file}) ){
    print $profile "$_: $self->{_profile}->{$_}$/" for keys %{$self->{_profile}};
    close($profile) && ($self->{_modified} = 0);
    $self->log(PROGRESS=>"Resource file F<$self->{_file}> synced.");
  }
  else{
    $self->log(ERROR=>"Resource file F<$self->{_file}> could not be open for write: $!");
   }
};

sub enum{
  keys %{shift->{_profile}};
}

sub DESTROY{
  my $self = shift;
  return unless $self->{_modified};
  require Data::Dumper;
  $self->log(
	     WARNING=>"Resource file F<$self->{_file}> modifications
were destroyed, save changes by calling close() first:\n".
	     Data::Dumper->Dump([$self->{_profile}]));
}

1;
__END__