X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FSchema%2FLoader%2FBase.pm;h=79886cc7033812c89f7469770f72f05fc7ac2324;hb=af15ea3334eb18d5bdeafbba43c43db007394086;hp=6e1167957f3b7f2bbd50cc636dd17b1daafecd6e;hpb=d36c8734a5b871d1fe5ce3502e0dad29f4b7375b;p=dbsrgits%2FDBIx-Class-Schema-Loader.git diff --git a/lib/DBIx/Class/Schema/Loader/Base.pm b/lib/DBIx/Class/Schema/Loader/Base.pm index 6e11679..79886cc 100644 --- a/lib/DBIx/Class/Schema/Loader/Base.pm +++ b/lib/DBIx/Class/Schema/Loader/Base.pm @@ -22,6 +22,7 @@ use DBIx::Class::Schema::Loader::Utils qw/split_name dumper_squashed eval_packag use DBIx::Class::Schema::Loader::Optional::Dependencies (); use Try::Tiny; use DBIx::Class (); +use Encode qw/decode encode/; use namespace::clean; our $VERSION = '0.07010'; @@ -92,6 +93,8 @@ __PACKAGE__->mk_group_accessors('simple', qw/ result_roles_map datetime_undef_if_invalid _result_class_methods + naming_set + tables /); =head1 NAME @@ -370,7 +373,7 @@ L =head2 result_components_map -A hashref of moniker keys and component values. Unlike C, which +A hashref of moniker keys and component values. Unlike L, which loads the given components into every Result class, this option allows you to load certain components for specified Result classes. For example: @@ -382,7 +385,7 @@ load certain components for specified Result classes. For example: ], } -You may use this in conjunction with C. +You may use this in conjunction with L. =head2 result_roles @@ -390,7 +393,7 @@ List of L roles to be applied to all of your Result classes. =head2 result_roles_map -A hashref of moniker keys and role values. Unlike C, which +A hashref of moniker keys and role values. Unlike L, which applies the given roles to every Result class, this option allows you to apply certain roles for specified Result classes. For example: @@ -402,7 +405,7 @@ certain roles for specified Result classes. For example: RouteChange => 'YourApp::Role::TripEvent', } -You may use this in conjunction with C. +You may use this in conjunction with L. =head2 use_namespaces @@ -685,7 +688,8 @@ sub new { } $self->{monikers} = {}; - $self->{classes} = {}; + $self->{tables} = {}; + $self->{classes} = {}; $self->{_upgrading_classes} = {}; $self->{schema_class} ||= ( ref $self->{schema} || $self->{schema} ); @@ -708,6 +712,13 @@ sub new { $self->version_to_dump($DBIx::Class::Schema::Loader::VERSION); $self->schema_version_to_dump($DBIx::Class::Schema::Loader::VERSION); + if (not defined $self->naming) { + $self->naming_set(0); + } + else { + $self->naming_set(1); + } + if ((not ref $self->naming) && defined $self->naming) { my $naming_ver = $self->naming; $self->{naming} = { @@ -757,7 +768,7 @@ sub _check_back_compat { # just in case, though no one is likely to dump a dynamic schema $self->schema_version_to_dump('0.04006'); - if (not %{ $self->naming }) { + if (not $self->naming_set) { warn <_upgrading_from('v4'); } - $self->naming->{relationships} ||= 'v4'; - $self->naming->{monikers} ||= 'v4'; - - if ((not defined $self->use_namespaces) - && $self->naming->{monikers} ne 'v4') { + if ((not defined $self->use_namespaces) && ($self->naming_set)) { $self->use_namespaces(1); } + $self->naming->{relationships} ||= 'v4'; + $self->naming->{monikers} ||= 'v4'; + if ($self->use_namespaces) { $self->_upgrading_from_load_classes(1); } @@ -994,7 +1004,7 @@ sub _load_external { warn qq/# Loaded external class definition for '$class'\n/ if $self->debug; - my $code = $self->_rewrite_old_classnames(scalar slurp $real_inc_path); + my $code = $self->_rewrite_old_classnames(decode 'UTF-8', scalar slurp $real_inc_path); if ($self->dynamic) { # load the class too eval_package_without_redefine_warnings($class, $code); @@ -1017,7 +1027,7 @@ sub _load_external { } if ($old_real_inc_path) { - my $code = slurp $old_real_inc_path; + my $code = decode 'UTF-8', scalar slurp $old_real_inc_path; $self->_ext_stmt($class, <<"EOF"); @@ -1172,14 +1182,15 @@ sub _load_tables { $self->{quiet} = 1; local $self->{dump_directory} = $self->{temp_directory}; $self->_reload_classes(\@tables); - $self->_load_relationships($_) for @tables; - $self->_relbuilder->cleanup; + $self->_load_relationships(\@tables); $self->{quiet} = 0; # Remove that temp dir from INC so it doesn't get reloaded @INC = grep $_ ne $self->dump_directory, @INC; } + $self->_load_roles($_) for @tables; + $self->_load_external($_) for map { $self->classes->{$_} } @tables; @@ -1271,7 +1282,7 @@ sub _reload_class { eval_package_without_redefine_warnings ($class, "require $class"); } catch { - my $source = slurp $self->_get_dump_filename($class); + my $source = decode 'UTF-8', scalar slurp $self->_get_dump_filename($class); die "Failed to reload class $class: $_.\n\nCLASS SOURCE:\n\n$source"; }; } @@ -1386,6 +1397,10 @@ sub _dump_to_dir { else { $src_text .= qq|use base '$result_base_class';\n\n|; } + + $self->_base_class_pod($src_class, $result_base_class) + unless $result_base_class eq 'DBIx::Class::Core'; + $self->_write_classfile($src_class, $src_text); } @@ -1489,7 +1504,7 @@ sub _write_classfile { my $compare_to; if ($old_md5) { $compare_to = $text . $self->_sig_comment($old_ver, $old_ts); - if (Digest::MD5::md5_base64($compare_to) eq $old_md5) { + if (Digest::MD5::md5_base64(encode 'UTF-8', $compare_to) eq $old_md5) { return unless $self->_upgrading_from && $is_schema; } } @@ -1499,11 +1514,11 @@ sub _write_classfile { POSIX::strftime('%Y-%m-%d %H:%M:%S', localtime) ); - open(my $fh, '>', $filename) + open(my $fh, '>:encoding(UTF-8)', $filename) or croak "Cannot open '$filename' for writing: $!"; # Write the top half and its MD5 sum - print $fh $text . Digest::MD5::md5_base64($text) . "\n"; + print $fh $text . Digest::MD5::md5_base64(encode 'UTF-8', $text) . "\n"; # Write out anything loaded via external partial class file in @INC print $fh qq|$_\n| @@ -1542,7 +1557,7 @@ sub _parse_generated_file { return unless -f $fn; - open(my $fh, '<', $fn) + open(my $fh, '<:encoding(UTF-8)', $fn) or croak "Cannot open '$fn' for reading: $!"; my $mark_re = @@ -1559,7 +1574,7 @@ sub _parse_generated_file { $gen .= $pre_md5; croak "Checksum mismatch in '$fn', the auto-generated part of the file has been modified outside of this loader. Aborting.\nIf you want to overwrite these modifications, set the 'overwrite_modifications' loader option.\n" - if !$self->overwrite_modifications && Digest::MD5::md5_base64($gen) ne $md5; + if !$self->overwrite_modifications && Digest::MD5::md5_base64(encode 'UTF-8', $gen) ne $md5; last; } @@ -1675,8 +1690,14 @@ sub _make_src_class { $self->classes->{$table} = $table_class; $self->monikers->{$table} = $table_moniker; + $self->tables->{$table_moniker} = $table; + + $self->_pod_class_list($table_class, 'ADDITIONAL CLASSES USED', @{$self->additional_classes}); $self->_use ($table_class, @{$self->additional_classes}); + + $self->_pod_class_list($table_class, 'LEFT BASE CLASSES', @{$self->left_base_classes}); + $self->_inject($table_class, @{$self->left_base_classes}); my @components = @{ $self->components || [] }; @@ -1684,21 +1705,26 @@ sub _make_src_class { push @components, @{ $self->result_components_map->{$table_moniker} } if exists $self->result_components_map->{$table_moniker}; - $self->_dbic_stmt($table_class, 'load_components', @components) if @components; + my @fq_components = @components; + foreach my $component (@fq_components) { + if ($component !~ s/^\+//) { + $component = "DBIx::Class::$component"; + } + } - $self->_inject($table_class, @{$self->additional_base_classes}); + $self->_pod_class_list($table_class, 'COMPONENTS LOADED', @fq_components); - my @roles = @{ $self->result_roles || [] }; - push @roles, @{ $self->result_roles_map->{$table_moniker} } - if exists $self->result_roles_map->{$table_moniker}; + $self->_dbic_stmt($table_class, 'load_components', @components) if @components; - $self->_with($table_class, @roles) if @roles; + $self->_pod_class_list($table_class, 'ADDITIONAL BASE CLASSES', @{$self->additional_base_classes}); + + $self->_inject($table_class, @{$self->additional_base_classes}); } sub _is_result_class_method { my ($self, $name, $table_name) = @_; - my $table_moniker = $table_name ? $self->_table2moniker($table_name) : ''; + my $table_moniker = $table_name ? $self->monikers->{$table_name} : ''; $self->_result_class_methods({}) if not defined $self->_result_class_methods; @@ -1826,7 +1852,7 @@ sub _setup_src_meta { my $schema = $self->schema; my $schema_class = $self->schema_class; - my $table_class = $self->classes->{$table}; + my $table_class = $self->classes->{$table}; my $table_moniker = $self->monikers->{$table}; my $table_name = $table; @@ -1862,7 +1888,7 @@ sub _setup_src_meta { $info->{accessor} = $self->_make_column_accessor_name( $col, $context ); } - $self->_resolve_col_accessor_collisions($full_table_name, $col_info); + $self->_resolve_col_accessor_collisions($table, $col_info); # prune any redundant accessor names while (my ($col, $info) = each %$col_info) { @@ -1971,17 +1997,24 @@ sub _table2moniker { } sub _load_relationships { - my ($self, $table) = @_; + my ($self, $tables) = @_; - my $tbl_fk_info = $self->_table_fk_info($table); - foreach my $fkdef (@$tbl_fk_info) { - $fkdef->{remote_source} = - $self->monikers->{delete $fkdef->{remote_table}}; + my @tables; + + foreach my $table (@$tables) { + my $tbl_fk_info = $self->_table_fk_info($table); + foreach my $fkdef (@$tbl_fk_info) { + $fkdef->{remote_source} = + $self->monikers->{delete $fkdef->{remote_table}}; + } + my $tbl_uniq_info = $self->_table_uniq_info($table); + + my $local_moniker = $self->monikers->{$table}; + + push @tables, [ $local_moniker, $tbl_fk_info, $tbl_uniq_info ]; } - my $tbl_uniq_info = $self->_table_uniq_info($table); - my $local_moniker = $self->monikers->{$table}; - my $rel_stmts = $self->_relbuilder->generate_code($local_moniker, $tbl_fk_info, $tbl_uniq_info); + my $rel_stmts = $self->_relbuilder->generate_code(\@tables); foreach my $src_class (sort keys %$rel_stmts) { my $src_stmts = $rel_stmts->{$src_class}; @@ -1991,6 +2024,23 @@ sub _load_relationships { } } +sub _load_roles { + my ($self, $table) = @_; + + my $table_moniker = $self->monikers->{$table}; + my $table_class = $self->classes->{$table}; + + my @roles = @{ $self->result_roles || [] }; + push @roles, @{ $self->result_roles_map->{$table_moniker} } + if exists $self->result_roles_map->{$table_moniker}; + + if (@roles) { + $self->_pod_class_list($table_class, 'L ROLES APPLIED', @roles); + + $self->_with($table_class, @roles); + } +} + # Overload these in driver class: # Returns an arrayref of column names @@ -2088,6 +2138,31 @@ sub _make_pod { } } +sub _pod_class_list { + my ($self, $class, $title, @classes) = @_; + + return unless @classes && $self->generate_pod; + + $self->_pod($class, "=head1 $title"); + $self->_pod($class, '=over 4'); + + foreach my $link (@classes) { + $self->_pod($class, "=item * L<$link>"); + } + + $self->_pod($class, '=back'); + $self->_pod_cut($class); +} + +sub _base_class_pod { + my ($self, $class, $base_class) = @_; + + return unless $self->generate_pod; + + $self->_pod($class, "=head1 BASE CLASS: L<$base_class>"); + $self->_pod_cut($class); +} + sub _filter_comment { my ($self, $txt) = @_;