File Coverage

blib/lib/Zoidberg/Utils.pm

Criterion	Covered	Total	%
statement	62	79	78.4
branch	17	42	40.4
condition	3	6	50.0
subroutine	12	13	92.3
pod	2	5	40.0
total	96	145	66.2

package Zoidberg::Utils;

our $VERSION = '0.981';

use strict;
use vars '$AUTOLOAD';
use Zoidberg::Utils::Error;
use Exporter::Tidy
	default => [qw/:output :error/],
	output	=> [qw/output message debug/],
	error	=> [qw/error bug todo complain/],
	fs	=> [qw/path list_dir/],
	other	=> [qw/
		setting read_data_file read_file merge_hash
		complain typed_output output_is_captured
		list_path unique_file regex_glob
		getopt help usage version path2hashref
	/] ;

our $ERROR_CALLER = 1;

our %loadable = (
	fs      => ['Zoidberg::Utils::FileSystem', qw/path list_dir list_path unique_file regex_glob/ ],
	output	=> ['Zoidberg::Utils::Output',     qw/output message debug complain typed_output output_is_captured/ ],
	getopt	=> ['Zoidberg::Utils::GetOpt',     qw/getopt help usage version path2hashref/ ],
);

sub AUTOLOAD {
	$AUTOLOAD =~ s/.*:://;
	return if $AUTOLOAD eq 'DESTROY';

	my ($class, @subs);
	for my $key (keys %loadable) {
		next unless grep {$AUTOLOAD eq $_} @{$loadable{$key}};
		($class, @subs) = @{delete $loadable{$key}};
		eval "use $class \@subs";
		die if $@;
		last;
	}

	die "Could not load '$AUTOLOAD'" unless $class;
	no strict 'refs';
	goto &{$AUTOLOAD};
}

## Various methods ##

sub setting {
	# FIXME support for Fish argument and namespace
	my $key = shift;
	return undef unless exists $Zoidberg::CURRENT->{settings}{$key};
	my $ref = $Zoidberg::CURRENT->{settings}{$key};
	return (wantarray && ref($ref) eq 'ARRAY') ? (@$ref) : $ref;
}

sub read_data_file {
	my $file = shift;
	error 'read_data_file() is not intended for fully specified files, try read_file()'
		if $file =~ m!^/!;
	for my $dir (setting('data_dirs')) {
		for ("$dir/data/$file", map "$dir/data/$file.$_", qw/pl pd yaml/) {
			next unless -f $_;
			error "Can not read file: $_" unless -r $_;
			return read_file($_);
		}
	}
	error "Could not find 'data/$file' in (" .join(', ', setting('data_dirs')).')';
}

sub read_file {
	my $file = shift;
        error "no such file: $file\n" unless -f $file;

	my $ref;
	if ($file =~ /^\w+$/) { todo 'executable data file' }
	elsif ($file =~ /\.(pl)$/i) {
		eval q{package Main; $ref = do $file; die $@ if $@ };
       	}
	elsif ($file =~ /\.(pd)$/i) { $ref = pd_read($file) }
	elsif ($file =~ /\.(yaml)$/i) {
       		eval 'require YAML' or error $@;
		$ref = YAML::LoadFile($file);
	}
	else { error qq/Unkown file type: "$file"\n/ }

	error "In file $file\: $@" if $@;
	error "File $file did not return a defined value" unless defined $ref;
	return $ref;
}

sub pd_read {
	my $FILE = shift;

	print STDERR "Deprecated config file: $FILE - should be a .pl instead of .pd\n";

	open FILE, '<', $FILE or return undef;
	my $CONTENT = join '', ();
	close FILE;
	my $VAR1;
	eval $CONTENT;
	complain("Failed to eval the contents of $FILE ($@)") if $@;
	return $VAR1;
}

sub merge_hash {
    my $ref = {};
    local $ERROR_CALLER = 2;
    $ref = _merge($ref, $_) for @_;
    return $ref;
}

sub _merge { # Removed use of Storable::dclone - can throw nasty bugs
	my ($ref, $ding) = @_;
	while (my ($k, $v) = each %{$ding}) {
            if (defined $$ref{$k} and ref($v) eq 'HASH') {
	    	error 'incompatible types for key: '.$k.' in merging hashes'
			unless ref($$ref{$k}) eq 'HASH';
                $$ref{$k} = _merge($$ref{$k}, $v); #recurs
            }
            else { $ref->{$k} = $v; }
        }
	return $ref;
}

1;

__END__