File Coverage

blib/lib/Tie/File/Hashify.pm

Criterion	Covered	Total	%
statement	74	81	91.3
branch	23	32	71.8
condition	17	24	70.8
subroutine	16	16	100.0
pod			n/a
total	130	153	84.9

package Tie::File::Hashify;

use strict;
use warnings;

use Carp;
use IO::File;

our $VERSION = '0.03';


sub TIEHASH {
	my ($class, $path, %options) = @_;

	my $self = bless {
		hash => {},
		format => $options{format},
		parse => $options{parse},
		path => $path,
		ro => $options{ro},
		dirty => 0,
	}, $class;

	if($path and -e $path and $options{parse}) {
		my $io = new IO::File($path) or croak "Can't read $path. $!.\n";

		while(my $line = $io->getline) {
			next unless defined $line and length($line);

			my ($key, $value);

			# Use callback for parsing.
			if(ref($options{parse}) eq 'CODE') {
				($key, $value) = &{$options{parse}}($line);
			}

			# Parse line using a regular expression.
			elsif(ref($options{parse}) eq '' or uc(ref($options{parse})) eq 'REGEXP') {
				my $re = ref($options{parse}) ? $options{parse} : qr/^$options{parse}$/;
				($key, $value) = ($line =~ $re);
			}

			# Croak.
			else {
				croak 'Can\'t use ', lc(ref($options{parse})), " for parsing.\n";
			}

			if(defined $key and length $key) {
				$self->{hash}->{$key} = $value if(length $key);
			}
		}

		$io->close;
	}

	return $self;
}


sub FETCH {
	my ($self, $key) = @_;
	return $self->{hash}->{$key};
}


sub STORE {
	my ($self, $key, $value) = @_;

	croak "Can't store in read-only mode" if($self->{ro});

	$self->{dirty} = !0;

	return $self->{hash}->{$key} = $value;
}


sub EXISTS {
	my ($self, $key) = @_;
	return exists($self->{hash}->{$key});
}


sub DELETE {
	my ($self, $key) = @_;

	croak "Can't delete in read-only mode" if($self->{ro});

	$self->{dirty} = !0;

	return delete($self->{hash}->{$key});
}


sub CLEAR {
	my ($self) = @_;

	croak "Can't clear in read-only mode" if($self->{ro});

	$self->{dirty} = !0;

	%{$self->{hash}} = ();
}


sub FIRSTKEY {
	my ($self) = @_;
	my ($key) = each %{$self->{hash}};
	return $key;
}


sub NEXTKEY {
	my ($self) = @_;

	my ($k, $v) = each %{$self->{hash}};

	return $k;
}


sub SCALAR {
	my ($self) = @_;

	my $format = $self->{format};

	if(defined $format) {
		my $text = '';

		values %{$self->{hash}};

		while(my ($key, $value) = each %{$self->{hash}}) {
			# Format using callback.
			if(ref($format) eq 'CODE') {
				$text .= &{$format}($key, $value) . "\n";
			}

			# Format using sprintf and a format string.
			elsif(ref($format) eq '') {
				$text .= sprintf($format, $key, $value) . "\n";
			}

			# Croak.
			else {
				croak 'Can\'t use ' . ref($format) . " as format.\n";
			}
		}

		return $text;
	}

	else {
		return %{$self->{hash}};
	}
}


sub _store {
	my ($self) = @_;

	my $path = $self->{path};

	if($path and $self->{dirty} and $self->{format} and !$self->{ro}) {
		my $io = new IO::File('>' . $path) or croak "Can't write $path. $!.\n";

		$io->print($self->SCALAR);
		$io->close;

		$self->{dirty} = 0;
	}
}


sub UNTIE {
	my ($self) = @_;

	$self->_store;
}


sub DESTROY {
	my ($self) = @_;

	$self->_store;
}


!0;

__END__