package DBIx::Class;
+# important to load early
+use DBIx::Class::_Util;
+
use strict;
use warnings;
# $VERSION declaration must stay up here, ahead of any other package
# declarations, as to not confuse various modules attempting to determine
# this ones version, whether that be s.c.o. or Module::Metadata, etc
-$VERSION = '0.082700_06';
+$VERSION = '0.082899_15';
$VERSION = eval $VERSION if $VERSION =~ /_/; # numify for warning-free dev releases
-use DBIx::Class::_Util;
use mro 'c3';
-use DBIx::Class::Optional::Dependencies;
-
use base qw/DBIx::Class::Componentised DBIx::Class::AccessorGroup/;
-use DBIx::Class::StartupCheck;
use DBIx::Class::Exception;
-__PACKAGE__->mk_group_accessors(inherited => '_skip_namespace_frames');
-__PACKAGE__->_skip_namespace_frames('^DBIx::Class|^SQL::Abstract|^Try::Tiny|^Class::Accessor::Grouped|^Context::Preserve');
-
-sub mk_classdata {
- shift->mk_classaccessor(@_);
-}
+use DBIx::Class::_Util qw( uniq refdesc visit_namespaces );
+use Scalar::Util qw( weaken refaddr );
+use namespace::clean;
-sub mk_classaccessor {
- my $self = shift;
- $self->mk_group_accessors('inherited', $_[0]);
- $self->set_inherited(@_) if @_ > 1;
+__PACKAGE__->mk_group_accessors(inherited => '_skip_namespace_frames');
+__PACKAGE__->_skip_namespace_frames('^DBIx::Class|^SQL::Abstract|^Try::Tiny|^Class::Accessor::Grouped|^Context::Preserve|^Moose::Meta::');
+
+# FIXME - this is not really necessary, and is in
+# fact going to slow things down a bit
+# However it is the right thing to do in order to get
+# various install bases to highlight their brokenness
+# Remove at some unknown point in the future
+#
+# The oddball BEGIN is there for... reason unknown
+# It does make non-segfaulty difference on pre-5.8.5 perls, so shrug
+BEGIN {
+ sub DESTROY { &DBIx::Class::_Util::detected_reinvoked_destructor };
}
sub component_base_class { 'DBIx::Class' }
+
+my $attr_cref_registry;
+sub DBIx::Class::__Attr_iThreads_handler__::CLONE {
+
+ # this is disgusting, but the best we can do without even more surgery
+ visit_namespaces( action => sub {
+ my $pkg = shift;
+
+ # skip dangerous namespaces
+ return 1 if $pkg =~ /^ (?:
+ DB | next | B | .+? ::::ISA (?: ::CACHE ) | Class::C3
+ ) $/x;
+
+ no strict 'refs';
+
+ if (
+ exists ${"${pkg}::"}{__cag___attr_cache}
+ and
+ ref( my $attr_stash = ${"${pkg}::__cag___attr_cache"} ) eq 'HASH'
+ ) {
+ $attr_stash->{ $attr_cref_registry->{$_}{weakref} } = delete $attr_stash->{$_}
+ for keys %$attr_stash;
+ }
+
+ return 1;
+ });
+
+ # renumber the cref registry itself
+ %$attr_cref_registry = map {
+ ( defined $_->{weakref} )
+ ? (
+ # because of how __attr_cache works, ugh
+ "$_->{weakref}" => $_,
+ )
+ : ()
+ } values %$attr_cref_registry;
+}
+
sub MODIFY_CODE_ATTRIBUTES {
my ($class,$code,@attrs) = @_;
- $class->mk_classdata('__attr_cache' => {})
+ $class->mk_classaccessor('__attr_cache' => {})
unless $class->can('__attr_cache');
- $class->__attr_cache->{$code} = [@attrs];
+
+ # compaction step
+ defined $attr_cref_registry->{$_}{weakref} or delete $attr_cref_registry->{$_}
+ for keys %$attr_cref_registry;
+
+ # The original API used stringification instead of refaddr - can't change that now
+ if( $attr_cref_registry->{$code} ) {
+ Carp::confess( sprintf
+ "Coderefs '%s' and '%s' stringify to the same value '%s': nothing will work",
+ refdesc($code),
+ refdesc($attr_cref_registry->{$code}{weakref}),
+ "$code"
+ ) if refaddr($attr_cref_registry->{$code}{weakref}) != refaddr($code);
+ }
+ else {
+ weaken( $attr_cref_registry->{$code}{weakref} = $code )
+ }
+
+ $class->__attr_cache->{$code} = [ sort( uniq(
+ @{ $class->__attr_cache->{$code} || [] },
+ @attrs,
+ ))];
+
+ # FIXME - DBIC essentially gobbles up any attribute it can lay its hands on:
+ # decidedly not cool
+ #
+ # There should be some sort of warning on unrecognized attributes or
+ # somesuch... OTOH people do use things in the wild hence the plan of action
+ # is anything but clear :/
+ #
+ # https://metacpan.org/source/ZIGOROU/DBIx-Class-Service-0.02/lib/DBIx/Class/Service.pm#L93-110
+ # https://metacpan.org/source/ZIGOROU/DBIx-Class-Service-0.02/t/lib/DBIC/Test/Service/User.pm#L29
+ # https://metacpan.org/source/ZIGOROU/DBIx-Class-Service-0.02/t/lib/DBIC/Test/Service/User.pm#L36
+ #
return ();
}
+sub FETCH_CODE_ATTRIBUTES {
+ my ($class,$code) = @_;
+ @{ $class->_attr_cache->{$code} || [] }
+}
+
sub _attr_cache {
my $self = shift;
- my $cache = $self->can('__attr_cache') ? $self->__attr_cache : {};
-
- return {
- %$cache,
+ +{
+ %{ $self->can('__attr_cache') ? $self->__attr_cache : {} },
%{ $self->maybe::next::method || {} },
};
}
__END__
-=encoding UTF-8
-
=head1 NAME
DBIx::Class - Extensible and flexible object <-> relational mapper.
my $cd = $millennium_cds_rs->next; # SELECT ... FROM cds JOIN artists ...
my $cd_artist_name = $cd->artist->name; # Already has the data so no 2nd query
- # new() makes a Result object but doesnt insert it into the DB.
+ # new() makes a Result object but doesn't insert it into the DB.
# create() is the same as new() then insert().
my $new_cd = $schema->resultset('CD')->new({ title => 'Spoon' });
$new_cd->artist($cd->artist);
welcome documentation improvements). The delivery methods include git-
or unified-diff formatted patches, GitHub pull requests, or plain bug
reports either via RT or the Mailing list. Contributors are generally
-granted full access to the official repository after their first patch
-passes successful review.
+granted access to the official repository after their first several
+patches pass successful review. Don't hesitate to
+L<contact|/GETTING HELP/SUPPORT> either of the L</CAT HERDERS> with
+any further questions you may have.
=for comment
FIXME: Getty, frew and jnap need to get off their asses and finish the contrib section so we can link it here ;)
=item * Travis-CI log: L<https://travis-ci.org/dbsrgits/dbix-class/builds>
=for html
-↪ Stable branch CI status: <img src="https://secure.travis-ci.org/dbsrgits/dbix-class.png?branch=master"></img>
+↪ Bleeding edge dev CI status: <img src="https://secure.travis-ci.org/dbsrgits/dbix-class.png?branch=master"></img>
=back
per-line authorship is the L<git repository|/HOW TO CONTRIBUTE> history
itself.
-=head1 COPYRIGHT
+=head1 CAT HERDERS
+
+The fine folks nudging the project in a particular direction:
+
+=over
+
+B<ribasushi>: Peter Rabbitson <ribasushi@cpan.org>
+(present day maintenance and controlled evolution)
+
+B<castaway>: Jess Robinson <castaway@desert-island.me.uk>
+(lions share of the reference documentation and manuals)
+
+B<mst>: Matt S Trout <mst@shadowcat.co.uk> (project founder -
+original idea, architecture and implementation)
+
+=back
-Copyright (c) 2005 the DBIx::Class L</AUTHORS> as listed above.
+=head1 COPYRIGHT AND LICENSE
-=head1 LICENSE
+Copyright (c) 2005 by mst, castaway, ribasushi, and other DBIx::Class
+L</AUTHORS> as listed above and in F<AUTHORS>.
This library is free software and may be distributed under the same terms
-as perl itself.
+as perl5 itself. See F<LICENSE> for the complete licensing terms.
projects / dbsrgits/DBIx-Class.git / blobdiff