view release on metacpan or  search on metacpan

lib/Class/Scaffold/Environment.pm  view on Meta::CPAN

use 5.008;
use warnings;
use strict;

package Class::Scaffold::Environment;
BEGIN {
  $Class::Scaffold::Environment::VERSION = '1.102280';
}

# ABSTRACT: Base class for framework environment classes
use Error::Hierarchy::Util 'load_class';
use Class::Scaffold::Factory::Type;
use Property::Lookup;
use Data::Storage;    # for AutoPrereq
use parent 'Class::Scaffold::Base';
Class::Scaffold::Base->add_autoloaded_package('Class::Scaffold::');

# ptags: /(\bconst\b[ \t]+(\w+))/
__PACKAGE__->mk_scalar_accessors(qw(test_mode context))
  ->mk_boolean_accessors(qw(rollback_mode))
  ->mk_class_hash_accessors(qw(storage_cache multiplex_transaction_omit))
  ->mk_object_accessors(
    'Property::Lookup' => {
        slot       => 'configurator',
        comp_mthds => [
            qw(
              get_config
              core_storage_name
              core_storage_args
              memory_storage_name
              )
        ]
    },
  );
use constant DEFAULTS =>
  (test_mode => (defined $ENV{TEST_MODE} && $ENV{TEST_MODE} == 1),);
Class::Scaffold::Factory::Type->register_factory_type(
    exception_container => 'Class::Scaffold::Exception::Container',
    result              => 'Data::Storage::DBI::Result',
    storage_statement   => 'Data::Storage::Statement',
    test_util_loader    => 'Class::Scaffold::Test::UtilLoader',
);
{    # closure over $env so that it really is private
    my $env;
    sub getenv { $env }

    sub setenv {
        my ($self, $newenv, @args) = @_;
        return $env = $newenv
          if ref $newenv
              && UNIVERSAL::isa($newenv, 'Class::Scaffold::Environment');
        unless (ref $newenv) {

            # it's a string containing the class name
            load_class $newenv, 1;
            return $env = $newenv->new(@args);
        }
        throw Error::Hierarchy::Internal::CustomMessage(
            custom_message => "Invalid environment specification [$newenv]",);
    }
}    # end of closure

sub setup {
    my $self = shift;
    $self->configurator->default_layer->hash(
        $self->every_hash('CONFIGURATOR_DEFAULTS'));
}

# ----------------------------------------------------------------------
# class name-related code
use constant STORAGE_CLASS_NAME_HASH => (

    # storage names
    STG_NULL     => 'Data::Storage::Null',
    STG_NULL_DBI => 'Data::Storage::DBI',    # for testing
);

sub make_obj {
    my $self = shift;
    Class::Scaffold::Factory::Type->make_object_for_type(@_);
}

sub get_class_name_for {
    my ($self, $object_type) = @_;
    Class::Scaffold::Factory::Type->get_factory_class($object_type);
}

sub isa_type {
    my ($self, $object, $object_type) = @_;
    return unless UNIVERSAL::can($object, 'get_my_factory_type');
    my $factory_type = $object->get_my_factory_type;
    defined $factory_type ? $factory_type eq $object_type : 0;
}

sub gen_class_hash_accessor (@) {
    for my $prefix (@_) {
        my $method = sprintf 'get_%s_class_name_for' => lc $prefix;
        my $every_hash_name = sprintf '%s_CLASS_NAME_HASH', $prefix;
        my $hash;    # will be cached here
        no strict 'refs';
        $::PTAGS && $::PTAGS->add_tag($method, __FILE__, __LINE__ + 1);
        *$method = sub {
            local $DB::sub = local *__ANON__ = sprintf "%s::%s", __PACKAGE__,
              $method
              if defined &DB::DB && !$Devel::DProf::VERSION;
            my ($self, $key) = @_;
            $hash ||= $self->every_hash($every_hash_name);

lib/Class/Scaffold/Environment.pm  view on Meta::CPAN

=head2 core_storage

FIXME

=head2 disconnect

FIXME

=head2 gen_class_hash_accessor

FIXME

=head2 get_class_name_for

FIXME

=head2 get_storage_class_name_for

FIXME

=head2 get_storage_type_for

FIXME

=head2 getenv

FIXME

=head2 isa_type

FIXME

=head2 load_cached_class_for_type

FIXME

=head2 make_delegate

FIXME

=head2 make_obj

FIXME

=head2 make_storage_object

FIXME

=head2 memory_storage

FIXME

=head2 release_storage_class_name_hash

FIXME

=head2 rollback

FIXME

=head2 setenv

FIXME

=head2 setup

FIXME

=head2 storage_CLASS_NAME

FIXME

=head2 storage_for_type

FIXME

=head1 INSTALLATION

See perlmodinstall for information and options on installing Perl modules.

=head1 BUGS AND LIMITATIONS

No bugs have been reported.

Please report any bugs or feature requests through the web interface at
L<http://rt.cpan.org>.

=head1 AVAILABILITY

The latest version of this module is available from the Comprehensive Perl
Archive Network (CPAN). Visit L<http://www.perl.com/CPAN/> to find a CPAN
site near you, or see
L<http://search.cpan.org/dist/Class-Scaffold/>.

The development version lives at
L<http://github.com/hanekomu/Class-Scaffold/>.
Instead of sending patches, please fork this project using the standard git
and github infrastructure.

=head1 AUTHORS

=over 4

=item *

Marcel Gruenauer <marcel@cpan.org>

=item *

Florian Helmberger <fh@univie.ac.at>

=item *

Achim Adam <ac@univie.ac.at>

=item *

Mark Hofstetter <mh@univie.ac.at>

=item *