File Coverage

blib/lib/Unicode/Unihan.pm

Criterion	Covered	Total	%
statement	47	61	77.0
branch	9	28	32.1
condition	1	3	33.3
subroutine	13	14	92.8
pod	0	3	0.0
total	70	109	64.2

package Unicode::Unihan;

use 5.008001;
use strict;
use warnings;

our $VERSION = '0.042_02';
our $DEBUG = 0;

use Carp;
BEGIN{  @AnyDBM_File::ISA = qw(DB_File GDBM_File SDBM_File) ; }
use AnyDBM_File;
use Fcntl;

sub new($;){
    my $class = shift;
    my $dir = __FILE__; $dir =~ s/\.pm//o;
    -d $dir or die "DB Directory $dir nonexistent!";
    return bless { '_dir_' => $dir, @_ } => $class;
}

sub load($$){
    my ($self, $name) = @_;
    if ($self->{'-savemem'}){
	for my $k (keys %$self){
	    $k eq $name and next;
            $k =~ /^[A-Z]/o and delete $self->{$k};
        }
    }
    unless ( $self->{$name} ){
	my $file = $self->{_dir_} . "/$name.db";
	# SDBM files attach a .dir and .pag (two files), so allow for
	# that secret .dir at the end
	(-f $file or -f "$file.dir") or croak "There is no DB for $name";
	tie %{$self->{$name}}, 'AnyDBM_File', $file, O_RDONLY, 0444
            or die "$file: $!";
    }
    $self;
}

sub unload($;){
    my $self = shift;
    if (@_){
	while(my $k = shift) {
	    $k =~ /^[A-Z]/o and delete $self->{$k};
	}
    }else{
	for my $k (keys %$self){
	    $k =~ /^[A-Z]/o and delete $self->{$k};
	}
    }
    $self;
}

sub DESTROY {
    $DEBUG and warn "$_[0] destroyed!";
}

sub AUTOLOAD {
    my $self = shift;
    my $name = our $AUTOLOAD;
    $name =~ s/.*:://o;
    $self->load($name);
    no strict 'refs';
    *$AUTOLOAD = sub {
	my $self = shift; @_ or return;
	my $str = shift;  length($str) or return;
	if (wantarray){
	    my @result = ();
	    for my $ord (unpack("U*", $str)){
		push @result, $self->{$name}{$ord};
	    }
	    return @result;
	}else{
	    return $self->{$name}{ord($str)};
	}
    };
    return $self->$name(@_);
}

1;
__END__