Finance-FITF

 view release on metacpan or  search on metacpan

inc/Class/MOP.pm  view on Meta::CPAN

}

use strict;
use warnings;

use 5.008;

use MRO::Compat;

use Carp          'confess';
use Scalar::Util  'weaken', 'isweak', 'reftype', 'blessed';
use Data::OptList;
use Try::Tiny;

use Class::MOP::Mixin::AttributeCore;
use Class::MOP::Mixin::HasAttributes;
use Class::MOP::Mixin::HasMethods;
use Class::MOP::Class;
use Class::MOP::Attribute;
use Class::MOP::Method;

inc/Class/MOP.pm  view on Meta::CPAN

    # because they should die only when the program dies.
    # After all, do package definitions even get reaped?
    # Anonymous classes manage their own destruction.
    my %METAS;

    sub get_all_metaclasses         {        %METAS         }
    sub get_all_metaclass_instances { values %METAS         }
    sub get_all_metaclass_names     { keys   %METAS         }
    sub get_metaclass_by_name       { $METAS{$_[0]}         }
    sub store_metaclass_by_name     { $METAS{$_[0]} = $_[1] }
    sub weaken_metaclass            { weaken($METAS{$_[0]}) }
    sub metaclass_is_weak           { isweak($METAS{$_[0]}) }
    sub does_metaclass_exist        { exists $METAS{$_[0]} && defined $METAS{$_[0]} }
    sub remove_metaclass_by_name    { delete $METAS{$_[0]}; return }

    # This handles instances as well as class names
    sub class_of {
        return unless defined $_[0];
        my $class = blessed($_[0]) || $_[0];
        return $METAS{$class};
    }

inc/Class/MOP/Attribute.pm  view on Meta::CPAN

BEGIN {
  $Class::MOP::Attribute::VERSION = '2.0009';
}

use strict;
use warnings;

use Class::MOP::Method::Accessor;

use Carp         'confess';
use Scalar::Util 'blessed', 'weaken';
use Try::Tiny;

use base 'Class::MOP::Object', 'Class::MOP::Mixin::AttributeCore';

# NOTE: (meta-circularity)
# This method will be replaced in the
# boostrap section of Class::MOP, by
# a new version which uses the
# &Class::MOP::Class::construct_instance
# method to build an attribute meta-object

inc/Class/MOP/Attribute.pm  view on Meta::CPAN

        'writer'             => $options->{writer},
        'predicate'          => $options->{predicate},
        'clearer'            => $options->{clearer},
        'builder'            => $options->{builder},
        'init_arg'           => $options->{init_arg},
        exists $options->{default}
            ? ('default'     => $options->{default})
            : (),
        'initializer'        => $options->{initializer},
        'definition_context' => $options->{definition_context},
        # keep a weakened link to the
        # class we are associated with
        'associated_class' => undef,
        # and a list of the methods
        # associated with this attr
        'associated_methods' => [],
        # this let's us keep track of
        # our order inside the associated
        # class
        'insertion_order'    => undef,
    }, $class;

inc/Class/MOP/Attribute.pm  view on Meta::CPAN

# slots

sub slots { (shift)->name }

# class association

sub attach_to_class {
    my ($self, $class) = @_;
    (blessed($class) && $class->isa('Class::MOP::Class'))
        || confess "You must pass a Class::MOP::Class instance (or a subclass)";
    weaken($self->{'associated_class'} = $class);
}

sub detach_from_class {
    my $self = shift;
    $self->{'associated_class'} = undef;
}

# method association

sub associate_method {

inc/Class/MOP/Class.pm  view on Meta::CPAN

use strict;
use warnings;

use Class::MOP::Instance;
use Class::MOP::Method::Wrapped;
use Class::MOP::Method::Accessor;
use Class::MOP::Method::Constructor;
use Class::MOP::MiniTrait;

use Carp         'confess';
use Scalar::Util 'blessed', 'reftype', 'weaken';
use Sub::Name    'subname';
use Try::Tiny;
use List::MoreUtils 'all';

use base 'Class::MOP::Module',
         'Class::MOP::Mixin::HasAttributes',
         'Class::MOP::Mixin::HasMethods';

# Creation

inc/Class/MOP/Class.pm  view on Meta::CPAN

        || $class->_construct_class_instance(package => $package_name, @_);
}

sub reinitialize {
    my ( $class, @args ) = @_;
    unshift @args, "package" if @args % 2;
    my %options = @args;
    my $old_metaclass = blessed($options{package})
        ? $options{package}
        : Class::MOP::get_metaclass_by_name($options{package});
    $options{weaken} = Class::MOP::metaclass_is_weak($old_metaclass->name)
        if !exists $options{weaken}
        && blessed($old_metaclass)
        && $old_metaclass->isa('Class::MOP::Class');
    $old_metaclass->_remove_generated_metaobjects
        if $old_metaclass && $old_metaclass->isa('Class::MOP::Class');
    my $new_metaclass = $class->SUPER::reinitialize(%options);
    $new_metaclass->_restore_metaobjects_from($old_metaclass)
        if $old_metaclass && $old_metaclass->isa('Class::MOP::Class');
    return $new_metaclass;
}

inc/Class/MOP/Class.pm  view on Meta::CPAN

        # Class::MOP::Class, which defines meta
        $meta = $class->meta->_construct_instance($options)
    }

    # and check the metaclass compatibility
    $meta->_check_metaclass_compatibility();  

    Class::MOP::store_metaclass_by_name($package_name, $meta);

    # NOTE:
    # we need to weaken any anon classes
    # so that they can call DESTROY properly
    Class::MOP::weaken_metaclass($package_name) if $options->{weaken};

    $meta;
}

sub _real_ref_name {
    my $self = shift;

    # NOTE: we need to deal with the possibility of class immutability here,
    # and then get the name of the class appropriately
    return $self->is_immutable

inc/Class/MOP/Instance.pm  view on Meta::CPAN

BEGIN {
  $Class::MOP::Instance::AUTHORITY = 'cpan:STEVAN';
}
BEGIN {
  $Class::MOP::Instance::VERSION = '2.0009';
}

use strict;
use warnings;

use Scalar::Util 'isweak', 'weaken', 'blessed';

use base 'Class::MOP::Object';

# make this not a valid method name, to avoid (most) attribute conflicts
my $RESERVED_MOP_SLOT = '<<MOP>>';

sub BUILDARGS {
    my ($class, @args) = @_;

    if ( @args == 1 ) {

inc/Class/MOP/Instance.pm  view on Meta::CPAN

}

sub new {
    my $class = shift;
    my $options = $class->BUILDARGS(@_);

    # FIXME replace with a proper constructor
    my $instance = $class->_new(%$options);

    # FIXME weak_ref => 1,
    weaken($instance->{'associated_metaclass'});

    return $instance;
}

sub _new {
    my $class = shift;
    return Class::MOP::Class->initialize($class)->new_object(@_)
      if $class ne __PACKAGE__;

    my $params = @_ == 1 ? $_[0] : {@_};

inc/Class/MOP/Instance.pm  view on Meta::CPAN

sub clone_instance {
    my ($self, $instance) = @_;

    my $clone = $self->create_instance;
    for my $attr ($self->get_all_attributes) {
        next unless $attr->has_value($instance);
        for my $slot ($attr->slots) {
            my $val = $self->get_slot_value($instance, $slot);
            $self->set_slot_value($clone, $slot, $val);
            $self->weaken_slot_value($clone, $slot)
                if $self->slot_value_is_weak($instance, $slot);
        }
    }

    $self->_set_mop_slot($clone, $self->_get_mop_slot($instance))
        if $self->_has_mop_slot($instance);

    return $clone;
}

inc/Class/MOP/Instance.pm  view on Meta::CPAN

    foreach my $slot_name ($self->get_all_slots) {
        $self->deinitialize_slot($instance, $slot_name);
    }
}

sub is_slot_initialized {
    my ($self, $instance, $slot_name, $value) = @_;
    exists $instance->{$slot_name};
}

sub weaken_slot_value {
    my ($self, $instance, $slot_name) = @_;
    weaken $instance->{$slot_name};
}

sub slot_value_is_weak {
    my ($self, $instance, $slot_name) = @_;
    isweak $instance->{$slot_name};
}

sub strengthen_slot_value {
    my ($self, $instance, $slot_name) = @_;
    $self->set_slot_value($instance, $slot_name, $self->get_slot_value($instance, $slot_name));

inc/Class/MOP/Instance.pm  view on Meta::CPAN

sub inline_deinitialize_slot {
    my ($self, $instance, $slot_name) = @_;
    "delete " . $self->inline_slot_access($instance, $slot_name);
}
sub inline_is_slot_initialized {
    my ($self, $instance, $slot_name) = @_;
    "exists " . $self->inline_slot_access($instance, $slot_name);
}

sub inline_weaken_slot_value {
    my ($self, $instance, $slot_name) = @_;
    sprintf "Scalar::Util::weaken( %s )", $self->inline_slot_access($instance, $slot_name);
}

sub inline_strengthen_slot_value {
    my ($self, $instance, $slot_name) = @_;
    $self->inline_set_slot_value($instance, $slot_name, $self->inline_slot_access($instance, $slot_name));
}

sub inline_rebless_instance_structure {
    my ($self, $instance, $class_variable) = @_;
    "bless $instance => $class_variable";

inc/Class/MOP/Method.pm  view on Meta::CPAN

  $Class::MOP::Method::AUTHORITY = 'cpan:STEVAN';
}
BEGIN {
  $Class::MOP::Method::VERSION = '2.0009';
}

use strict;
use warnings;

use Carp         'confess';
use Scalar::Util 'weaken', 'reftype', 'blessed';

use base 'Class::MOP::Object';

# NOTE:
# if poked in the right way,
# they should act like CODE refs.
use overload '&{}' => sub { $_[0]->body }, fallback => 1;

# construction

inc/Class/MOP/Method.pm  view on Meta::CPAN

    }
    elsif (!ref $code || 'CODE' ne reftype($code)) {
        confess "You must supply a CODE reference to bless, not (" . ($code || 'undef') . ")";
    }

    ($params{package_name} && $params{name})
        || confess "You must supply the package_name and name parameters";

    my $self = $class->_new(\%params);

    weaken($self->{associated_metaclass}) if $self->{associated_metaclass};

    return $self;
}

sub _new {
    my $class = shift;

    return Class::MOP::Class->initialize($class)->new_object(@_)
        if $class ne __PACKAGE__;

inc/Class/MOP/Method.pm  view on Meta::CPAN

    } => $class;
}

## accessors

sub associated_metaclass { shift->{'associated_metaclass'} }

sub attach_to_class {
    my ( $self, $class ) = @_;
    $self->{associated_metaclass} = $class;
    weaken($self->{associated_metaclass});
}

sub detach_from_class {
    my $self = shift;
    delete $self->{associated_metaclass};
}

sub fully_qualified_name {
    my $self = shift;
    $self->package_name . '::' . $self->name;

inc/Class/MOP/Method/Accessor.pm  view on Meta::CPAN

  $Class::MOP::Method::Accessor::AUTHORITY = 'cpan:STEVAN';
}
BEGIN {
  $Class::MOP::Method::Accessor::VERSION = '2.0009';
}

use strict;
use warnings;

use Carp         'confess';
use Scalar::Util 'blessed', 'weaken';
use Try::Tiny;

use base 'Class::MOP::Method::Generated';

sub new {
    my $class   = shift;
    my %options = @_;

    (exists $options{attribute})
        || confess "You must supply an attribute to construct with";

inc/Class/MOP/Method/Accessor.pm  view on Meta::CPAN

        || confess "You must supply an attribute which is a 'Class::MOP::Attribute' instance";

    ($options{package_name} && $options{name})
        || confess "You must supply the package_name and name parameters $Class::MOP::Method::UPGRADE_ERROR_TEXT";

    my $self = $class->_new(\%options);

    # we don't want this creating
    # a cycle in the code, if not
    # needed
    weaken($self->{'attribute'});

    $self->_initialize_body;

    return $self;
}

sub _new {
    my $class = shift;

    return Class::MOP::Class->initialize($class)->new_object(@_)

inc/Class/MOP/Method/Constructor.pm  view on Meta::CPAN

  $Class::MOP::Method::Constructor::AUTHORITY = 'cpan:STEVAN';
}
BEGIN {
  $Class::MOP::Method::Constructor::VERSION = '2.0009';
}

use strict;
use warnings;

use Carp         'confess';
use Scalar::Util 'blessed', 'weaken';
use Try::Tiny;

use base 'Class::MOP::Method::Inlined';

sub new {
    my $class   = shift;
    my %options = @_;

    (blessed $options{metaclass} && $options{metaclass}->isa('Class::MOP::Class'))
        || confess "You must pass a metaclass instance if you want to inline"
            if $options{is_inline};

    ($options{package_name} && $options{name})
        || confess "You must supply the package_name and name parameters $Class::MOP::Method::UPGRADE_ERROR_TEXT";

    my $self = $class->_new(\%options);

    # we don't want this creating
    # a cycle in the code, if not
    # needed
    weaken($self->{'associated_metaclass'});

    $self->_initialize_body;

    return $self;
}

sub _new {
    my $class = shift;

    return Class::MOP::Class->initialize($class)->new_object(@_)

inc/Class/MOP/Method/Inlined.pm  view on Meta::CPAN

  $Class::MOP::Method::Inlined::AUTHORITY = 'cpan:STEVAN';
}
BEGIN {
  $Class::MOP::Method::Inlined::VERSION = '2.0009';
}

use strict;
use warnings;

use Carp         'confess';
use Scalar::Util 'blessed', 'weaken', 'looks_like_number', 'refaddr';

use base 'Class::MOP::Method::Generated';

sub _uninlined_body {
    my $self = shift;

    my $super_method
        = $self->associated_metaclass->find_next_method_by_name( $self->name )
        or return;

inc/Class/MOP/Package.pm  view on Meta::CPAN

BEGIN {
  $Class::MOP::Package::AUTHORITY = 'cpan:STEVAN';
}
BEGIN {
  $Class::MOP::Package::VERSION = '2.0009';
}

use strict;
use warnings;

use Scalar::Util 'blessed', 'reftype', 'weaken';
use Carp         'confess';
use Devel::GlobalDestruction 'in_global_destruction';
use Package::Stash;

use base 'Class::MOP::Object';

# creation ...

sub initialize {
    my ( $class, @args ) = @_;

inc/Class/MOP/Package.pm  view on Meta::CPAN

    # until we can bootstrap it
    if ( my $meta = Class::MOP::get_metaclass_by_name($package_name) ) {
        return $meta;
    } else {
        my $meta = ( ref $class || $class )->_new({
            'package'   => $package_name,
            %options,
        });
        Class::MOP::store_metaclass_by_name($package_name, $meta);

        Class::MOP::weaken_metaclass($package_name) if $options{weaken};


        return $meta;
    }
}

sub reinitialize {
    my ( $class, @args ) = @_;

    unshift @args, "package" if @args % 2;

inc/Class/MOP/Package.pm  view on Meta::CPAN

        my $self = shift;
        no warnings 'uninitialized';
        my $prefix = $self->_anon_package_prefix;
        $self->name =~ /^\Q$prefix/;
    }

    sub create_anon {
        my ($class, %options) = @_;

        my $cache_ok = delete $options{cache};
        $options{weaken} = !$cache_ok unless exists $options{weaken};

        my $cache_key;
        if ($cache_ok) {
            $cache_key = $class->_anon_cache_key(%options);
            undef $cache_ok if !defined($cache_key);
        }

        if ($cache_ok) {
            if (defined $ANON_PACKAGE_CACHE{$cache_key}) {
                return $ANON_PACKAGE_CACHE{$cache_key};
            }
        }

        my $package_name = $class->_anon_package_prefix . ++$ANON_SERIAL;

        my $meta = $class->create($package_name, %options);

        if ($cache_ok) {
            $ANON_PACKAGE_CACHE{$cache_key} = $meta;
            weaken($ANON_PACKAGE_CACHE{$cache_key});
        }

        return $meta;
    }

    sub _anon_cache_key { confess "Packages are not cacheable" }

    sub DESTROY {
        my $self = shift;