use Class::Inspector ();
use Scalar::Util 'looks_like_number';
use File::Slurp 'slurp';
-use DBIx::Class::Schema::Loader::Utils qw/split_name dumper_squashed/;
+use DBIx::Class::Schema::Loader::Utils qw/split_name dumper_squashed eval_without_redefine_warnings/;
use DBIx::Class::Schema::Loader::Optional::Dependencies ();
use Try::Tiny;
use DBIx::Class ();
use namespace::clean;
-our $VERSION = '0.07001';
+our $VERSION = '0.07002';
__PACKAGE__->mk_group_ro_accessors('simple', qw/
schema
if ($self->use_moose) {
if (not DBIx::Class::Schema::Loader::Optional::Dependencies->req_ok_for('use_moose')) {
- die sprintf "You must install the following CPAN modules to enable the use_moose option: %s.\nYou are missing: %s.\n",
- "Moose, MooseX::NonMoose and namespace::autoclean",
+ die sprintf "You must install the following CPAN modules to enable the use_moose option: %s.\n",
DBIx::Class::Schema::Loader::Optional::Dependencies->req_missing_for('use_moose');
}
}
# determine if the existing schema was dumped with use_moose => 1
if (! defined $self->use_moose) {
- $self->use_moose(1) if $old_gen =~ /^ (?!\s*\#) use \s+ Moose/xm;
+ $self->{use_moose} = 1 if $old_gen =~ /^ (?!\s*\#) use \s+ Moose/xm;
}
my $load_classes = ($old_gen =~ /^__PACKAGE__->load_classes;/m) ? 1 : 0;
$code = $self->_rewrite_old_classnames($code);
if ($self->dynamic) { # load the class too
- # kill redefined warnings
- my $warn_handler = $SIG{__WARN__} || sub { warn @_ };
- local $SIG{__WARN__} = sub {
- $warn_handler->(@_)
- unless $_[0] =~ /^Subroutine \S+ redefined/;
- };
- eval $code;
- die $@ if $@;
+ eval_without_redefine_warnings($code);
}
$self->_ext_stmt($class,
* PLEASE RENAME THIS CLASS: from '$old_class' to '$class', as that is the
new name of the Result.
EOF
- # kill redefined warnings
- my $warn_handler = $SIG{__WARN__} || sub { warn @_ };
- local $SIG{__WARN__} = sub {
- $warn_handler->(@_)
- unless $_[0] =~ /^Subroutine \S+ redefined/;
- };
- eval $code;
- die $@ if $@;
+ eval_without_redefine_warnings($code);
}
chomp $code;
delete $INC{ $class_path };
# kill redefined warnings
- my $warn_handler = $SIG{__WARN__} || sub { warn @_ };
- local $SIG{__WARN__} = sub {
- $warn_handler->(@_)
- unless $_[0] =~ /^Subroutine \S+ redefined/;
+ eval {
+ eval_without_redefine_warnings ("require $class");
};
- eval "require $class;";
die "Failed to reload class $class: $@" if $@;
}
$custom_content .= $self->_default_custom_content;
}
}
+ elsif (defined $self->use_moose && $old_gen) {
+ croak 'It is not possible to "downgrade" a schema that was loaded with use_moose => 1 to use_moose => 0, due to differing custom content'
+ if $old_gen =~ /use \s+ MooseX?\b/x;
+ }
$custom_content = $self->_rewrite_old_classnames($custom_content);
sub _default_custom_content {
my $self = shift;
my $default = qq|\n\n# You can replace this text with custom|
- . qq| content, and it will be preserved on regeneration|;
+ . qq| code or comments, and it will be preserved on regeneration|;
if ($self->use_moose) {
$default .= $self->_default_moose_custom_content;
}
die $@ if $@;
push @methods, @{ Class::Inspector->methods($class) || [] };
+ push @methods, @{ Class::Inspector->methods('UNIVERSAL') || [] };
}
my %methods;
} elsif ( $method eq 'add_columns' ) {
$self->_pod( $class, "=head1 ACCESSORS" );
my $col_counter = 0;
- my @cols = @_;
+ my @cols = @_;
while( my ($name,$attrs) = splice @cols,0,2 ) {
- $col_counter++;
+ $col_counter++;
$self->_pod( $class, '=head2 ' . $name );
- $self->_pod( $class,
- join "\n", map {
- my $s = $attrs->{$_};
- $s = !defined $s ? 'undef' :
- length($s) == 0 ? '(empty string)' :
- ref($s) eq 'SCALAR' ? $$s :
- ref($s) ? dumper_squashed $s :
- looks_like_number($s) ? $s :
- qq{'$s'}
- ;
-
- " $_: $s"
- } sort keys %$attrs,
- );
-
- if (my $comment = $self->__column_comment($self->{_class2table}{$class}, $col_counter)) {
- $self->_pod( $class, $comment );
- }
+ $self->_pod( $class,
+ join "\n", map {
+ my $s = $attrs->{$_};
+ $s = !defined $s ? 'undef' :
+ length($s) == 0 ? '(empty string)' :
+ ref($s) eq 'SCALAR' ? $$s :
+ ref($s) ? dumper_squashed $s :
+ looks_like_number($s) ? $s : qq{'$s'};
+
+ " $_: $s"
+ } sort keys %$attrs,
+ );
+ if (my $comment = $self->__column_comment($self->{_class2table}{$class}, $col_counter, $name)) {
+ $self->_pod( $class, $comment );
+ }
}
$self->_pod_cut( $class );
} elsif ( $method =~ /^(belongs_to|has_many|might_have)$/ ) {