File Coverage

blib/lib/DWH_File/Value/Factory.pm

Criterion	Covered	Total	%
statement	53	61	86.8
branch	25	34	73.5
condition	4	9	44.4
subroutine	12	12	100.0
pod	0	2	0.0
total	94	118	79.6

package DWH_File::Value::Factory;

use warnings;
use strict;
use vars qw( @ISA $VERSION );

use UNIVERSAL;

use DWH_File::Value::Plain;
use DWH_File::Value::Undef;
use DWH_File::Tie::Scalar;
use DWH_File::Tie::Array;
use DWH_File::Tie::Hash;
use DWH_File::Tie::Foreign;

@ISA = qw(  );
$VERSION = 0.01;

sub from_input {
    my ( $this, $kernel, $actual, $tier ) = @_;
    unless ( defined $actual ) { return DWH_File::Value::Undef->new }
    elsif ( ref $actual ) {
        my $ty;
	if ( UNIVERSAL::isa( $actual, 'DWH_File::Aware' ) ) {
            $tier ||= $actual->dwh_tier;
        }
	if ( UNIVERSAL::isa( $actual, 'SCALAR' ) ) {
            $ty = tied $$actual or $tier ||= 'DWH_File::Tie::Scalar';
        }
        elsif ( UNIVERSAL::isa( $actual, 'ARRAY' ) ) {
            $ty = tied @$actual or $tier ||= 'DWH_File::Tie::Array';
        }
        elsif ( UNIVERSAL::isa( $actual, 'HASH' ) ) {
            $ty = tied %$actual or $tier ||= 'DWH_File::Tie::Hash'
        }
        else { die "Unable to tie $actual" }
        if ( $ty ) {
            if ( $ty->isa( 'DWH_File::Tie' ) ) {
		if ( $ty->{ kernel } == $kernel ) { return $ty }
		else { return DWH_File::Tie::Foreign->new( $kernel, $ty ) }
	    }
            else { die "Can't handle tied data" }
        }
	else {
	    if ( UNIVERSAL::isa( $actual, 'DWH_File::Aware' ) ) {
		$actual->dwh_pre_sign_in;
	    }
	    $ty = $tier->tie_reference( $kernel, $actual );
	    if ( UNIVERSAL::isa( $actual, 'DWH_File::Aware' ) ) {
		$actual->dwh_post_sign_in( $ty );
	    }
	    $kernel->ground_reference( $ty );
	    return $ty;
	}
    }
    else { return DWH_File::Value::Plain->from_input( $actual ) }
}

sub from_stored {
    my ( $this, $kernel, $stored ) = @_;
    unless ( defined $stored ) { return DWH_File::Value::Undef->new }
    elsif ( $stored eq '%' ) { return DWH_File::Value::Undef->new }
    elsif ( my $val = $kernel->activate_reference( $stored ) ) {
        return $val;
    }
    else { return DWH_File::Value::Plain->from_stored( $stored ) }
}

1;

__END__