File Coverage

lib/UR/Context/Root.pm

Criterion	Covered	Total	%
statement	6	35	17.1
branch	0	14	0.0
condition	0	2	0.0
subroutine	2	7	28.5
pod	2	4	50.0
total	10	62	16.1

package UR::Context::Root;

use strict;
use warnings;

require UR;
our $VERSION = "0.46"; # UR $VERSION;

UR::Object::Type->define(
    class_name => 'UR::Context::Root',
    is => ['UR::Singleton', 'UR::Context'],
    is_abstract => 1,
    is_transactional => 1,
    doc => 'A base level context, representing the committed state of datasources external to the application.',
);

# this is called automatically by UR.pm at the end of the module
my $initialized = 0;
sub _initialize_for_current_process {
    my $class = shift;
    if ($initialized) {
        die "Attempt to re-initialize the current process?";
    }
    my $context_singleton_class = $ENV{UR_CONTEXT_ROOT} ||= 'UR::Context::DefaultRoot';
    $class->set_current($context_singleton_class);
}

sub name {
    my $class = shift->_singleton_class_name;
    my ($name) = ($class =~ /^\w+?\:\:\w+?\:\:(\w+)$/);
    die "failed to parse name from $class!" unless $name;
    return lc($name);
}

sub get_current {
    #shift->_initialize_for_current_process() unless $initialized;
    #eval "sub get_current { \$ENV{UR_CONTEXT_ROOT} }";
    return $ENV{UR_CONTEXT_ROOT};
}

sub set_current {
    my $class = shift;
    my $value = shift;

    return $value if $value eq $ENV{UR_CONTEXT_ROOT};

    $ENV{UR_CONTEXT_ROOT} = $value;

    #print "base context set to $value\n";
    #print Carp::longmess();

    eval {
        local $SIG{__DIE__};
        local $SIG{__WARN__};
        $ENV{UR_CONTEXT_ROOT}->class;
    };

    if ($@) {
        die "The context at application initialization is set to "
            . $ENV{UR_CONTEXT_ROOT} . ".\n"
            . "This failed to compile:\n$@"
    }

    unless ($ENV{UR_CONTEXT_ROOT}->isa("UR::Context")) {
        die "The context at application initialization is set to "
            . $ENV{UR_CONTEXT_ROOT} . ".\n"
            . "This does not inherit from UR::Context."
    }

    unless ($ENV{UR_CONTEXT_ROOT}->__meta__) {
        die "The context at application initialization is set to "
            . $ENV{UR_CONTEXT_ROOT} . ".\n"
            . "This is not defined with UR::Object::Type metadata!"
    }

    # Initialize the bottom of the transaction stack
    if (@UR::Context::Transaction::open_transaction_stack > 1) {
        die "Cannot change the base context once transactions are in progress!"
    }

    return $value;
}

sub access_level {
    my $self = shift->_singleton_object;
    return "???";
}

# sub has_changes { return }

1;