X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FSchema%2FLoader.pm;h=a68e585142fab5e36455adb40dff071c4a5d5118;hb=9ae3eecd42f2c70ee84a5322fb2754c84fae5d2c;hp=951e576e950a941b25da36c92d8ac154d08f5bcc;hpb=e52d195f8f7e0939fa325cf31e59804e00a30511;p=dbsrgits%2FDBIx-Class-Schema-Loader.git diff --git a/lib/DBIx/Class/Schema/Loader.pm b/lib/DBIx/Class/Schema/Loader.pm index 951e576..a68e585 100644 --- a/lib/DBIx/Class/Schema/Loader.pm +++ b/lib/DBIx/Class/Schema/Loader.pm @@ -7,16 +7,16 @@ use MRO::Compat; use mro 'c3'; use Carp::Clan qw/^DBIx::Class/; use Scalar::Util 'weaken'; -use Sub::Name 'subname'; -use DBIx::Class::Schema::Loader::Utils 'array_eq'; +use Sub::Util 'set_subname'; +use DBIx::Class::Schema::Loader::Utils qw/array_eq sigwarn_silencer/; use Try::Tiny; -use Hash::Merge 'merge'; +use curry; use namespace::clean; # Always remember to do all digits for the version even if they're 0 # i.e. first release of 0.XX *must* be 0.XX000. This avoids fBSD ports # brain damage and presumably various other packaging systems too -our $VERSION = '0.07034_01'; +our $VERSION = '0.07049'; __PACKAGE__->mk_group_accessors('inherited', qw/ _loader_args @@ -37,49 +37,49 @@ DBIx::Class::Schema::Loader - Create a DBIx::Class::Schema based on a database =head1 SYNOPSIS - ### use this module to generate a set of class files - - # in a script - use DBIx::Class::Schema::Loader qw/ make_schema_at /; - make_schema_at( - 'My::Schema', - { debug => 1, - dump_directory => './lib', - }, - [ 'dbi:Pg:dbname="foo"', 'myuser', 'mypassword', - { loader_class => 'MyLoader' } # optionally - ], - ); + ### use this module to generate a set of class files - # from the command line or a shell script with dbicdump (distributed - # with this module). Do `perldoc dbicdump` for usage. - dbicdump -o dump_directory=./lib \ - -o components='["InflateColumn::DateTime"]' \ - -o debug=1 \ - My::Schema \ - 'dbi:Pg:dbname=foo' \ - myuser \ - mypassword - - ### or generate and load classes at runtime - # note: this technique is not recommended - # for use in production code - - package My::Schema; - use base qw/DBIx::Class::Schema::Loader/; - - __PACKAGE__->loader_options( - constraint => '^foo.*', - # debug => 1, - ); + # in a script + use DBIx::Class::Schema::Loader qw/ make_schema_at /; + make_schema_at( + 'My::Schema', + { debug => 1, + dump_directory => './lib', + }, + [ 'dbi:Pg:dbname="foo"', 'myuser', 'mypassword', + { loader_class => 'MyLoader' } # optionally + ], + ); + + # from the command line or a shell script with dbicdump (distributed + # with this module). Do `perldoc dbicdump` for usage. + dbicdump -o dump_directory=./lib \ + -o components='["InflateColumn::DateTime"]' \ + -o debug=1 \ + My::Schema \ + 'dbi:Pg:dbname=foo' \ + myuser \ + mypassword + + ### or generate and load classes at runtime + # note: this technique is not recommended + # for use in production code + + package My::Schema; + use base qw/DBIx::Class::Schema::Loader/; + + __PACKAGE__->loader_options( + constraint => '^foo.*', + # debug => 1, + ); - #### in application code elsewhere: + #### in application code elsewhere: - use My::Schema; + use My::Schema; - my $schema1 = My::Schema->connect( $dsn, $user, $password, $attrs); - # -or- - my $schema1 = "My::Schema"; $schema1->connection(as above); + my $schema1 = My::Schema->connect( $dsn, $user, $password, $attrs); + # -or- + my $schema1 = "My::Schema"; $schema1->connection(as above); =head1 DESCRIPTION @@ -187,13 +187,13 @@ sub _invoke_loader { $args->{naming} = $self->naming if $self->naming; $args->{use_namespaces} = $self->use_namespaces if defined $self->use_namespaces; - # XXX this only works for relative storage_type, like ::DBI ... my $loader_class = $self->loader_class; if ($loader_class) { $loader_class = "DBIx::Class::Schema::Loader${loader_class}" if $loader_class =~ /^::/; $args->{loader_class} = $loader_class; }; + # XXX this only works for relative storage_type, like ::DBI ... my $impl = $loader_class || "DBIx::Class::Schema::Loader" . $self->storage_type; try { $self->ensure_class_loaded($impl) @@ -232,13 +232,28 @@ sub _merge_state_from { $self->_copy_state_from($from); - $self->class_mappings(merge($orig_class_mappings, $self->class_mappings)) + $self->class_mappings(__merge($orig_class_mappings, $self->class_mappings)) if $orig_class_mappings; - $self->source_registrations(merge($orig_source_registrations, $self->source_registrations)) + $self->source_registrations(__merge($orig_source_registrations, $self->source_registrations)) if $orig_source_registrations; } +my $merger; +sub __merge { + + local $SIG{__WARN__} = sigwarn_silencer(qr/Arguments for _merge_hashes must be hash references/); + + ( $merger ||= do { + require Hash::Merge; + my $m = Hash::Merge->new('LEFT_PRECEDENT'); + $m->set_clone_behavior(0); + $m; + } )->merge( + $_[0], $_[1] + ); +} + sub _copy_state_from { my $self = shift; my ($from) = @_; @@ -341,7 +356,7 @@ sub connection { # ->load_components and we are now in a different place in the mro. no warnings 'redefine'; - local *connection = subname __PACKAGE__.'::connection' => sub { + local *connection = set_subname __PACKAGE__.'::connection' => sub { my $self = shift; $self->next::method(@_); }; @@ -460,11 +475,11 @@ sub import { } elsif($opt eq 'naming') { no strict 'refs'; - *{"${cpkg}::naming"} = sub { $self->naming(@_) }; + *{"${cpkg}::naming"} = $self->curry::naming; } elsif($opt eq 'use_namespaces') { no strict 'refs'; - *{"${cpkg}::use_namespaces"} = sub { $self->use_namespaces(@_) }; + *{"${cpkg}::use_namespaces"} = $self->curry::use_namespaces, } } } @@ -611,76 +626,87 @@ Based on L by Sebastian Riedel Based upon the work of IKEBE Tomohiro -=head1 AUTHOR +=head1 AUTHORS -blblack: Brandon Black +Caelum: Rafael Kitover -=head1 CONTRIBUTORS +Dag-Erling Smørgrav -ilmari: Dagfinn Ilmari MannsEker +Matias E. Fernandez + +SineSwiper: Brendan Byrd + +TSUNODA Kazuya + +acmoore: Andrew Moore + +alnewkirk: Al Newkirk + +andrewalker: André Walker + +angelixd: Paul C. Mantz + +arc: Aaron Crane arcanez: Justin Hunter ash: Ash Berlin -btilly: Ben Tilly +blblack: Brandon Black -Caelum: Rafael Kitover +bphillips: Brian Phillips -TSUNODA Kazuya +btilly: Ben Tilly -rbo: Robert Bohne +domm: Thomas Klausner -ribasushi: Peter Rabbitson +ether: Karen Etheridge gugu: Andrey Kostenko +hobbs: Andrew Rodland + +ilmari: Dagfinn Ilmari MannsEker + jhannah: Jay Hannah jnap: John Napiorkowski -rbuels: Robert Buels +kane: Jos Boumans -timbunce: Tim Bunce +mattp: Matt Phillips + +mephinet: Philipp Gortan + +moritz: Moritz Lenz mst: Matt S. Trout mstratman: Mark A. Stratman -kane: Jos Boumans +oalders: Olaf Alders -waawaamilk: Nigel McNie +rbo: Robert Bohne -acmoore: Andrew Moore +rbuels: Robert Buels -bphillips: Brian Phillips +ribasushi: Peter Rabbitson schwern: Michael G. Schwern -SineSwiper: Brendan Byrd - -hobbs: Andrew Rodland - -domm: Thomas Klausner - spb: Stephen Bennett -Matias E. Fernandez - -alnewkirk: Al Newkirk - -angelixd: Paul C. Mantz +timbunce: Tim Bunce -andrewalker: André Walker +waawaamilk: Nigel McNie ... and lots of other folks. If we forgot you, please write the current maintainer or RT. =head1 COPYRIGHT & LICENSE -Copyright (c) 2006 - 2009 by the aforementioned -L and -L. +Copyright (c) 2006 - 2015 by the aforementioned +L. This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself.