use Lingua::EN::Inflect::Number qw//;
use File::Temp qw//;
use Class::Unload;
+use Class::Inspector ();
require DBIx::Class;
-our $VERSION = '0.04999_14';
+our $VERSION = '0.05003';
__PACKAGE__->mk_group_ro_accessors('simple', qw/
schema
skip_relationships
skip_load_external
moniker_map
+ custom_column_info
inflect_singular
inflect_plural
debug
monikers
dynamic
naming
+ datetime_timezone
+ datetime_locale
/);
use_namespaces
result_namespace
generate_pod
+ pod_comment_mode
+ pod_comment_spillover_length
/);
=head1 NAME
Set this to C<0> to turn off all POD generation.
+=head2 pod_comment_mode
+
+Controls where table comments appear in the generated POD. Smaller table
+comments are appended to the C<NAME> section of the documentation, and larger
+ones are inserted into C<DESCRIPTION> instead. You can force a C<DESCRIPTION>
+section to be generated with the comment always, only use C<NAME>, or choose
+the length threshold at which the comment is forced into the description.
+
+=over 4
+
+=item name
+
+Use C<NAME> section only.
+
+=item description
+
+Force C<DESCRIPTION> always.
+
+=item auto
+
+Use C<DESCRIPTION> if length > L</pod_comment_spillover_length>, this is the
+default.
+
+=back
+
+=head2 pod_comment_spillover_length
+
+When pod_comment_mode is set to C<auto>, this is the length of the comment at
+which it will be forced into a separate description section.
+
+The default is C<60>
+
=head2 relationship_attrs
Hashref of attributes to pass to each generated relationship, listed
Again, you should be using version control on your schema classes. Be
careful with this option.
+=head2 custom_column_info
+
+Hook for adding extra attributes to the
+L<column_info|DBIx::Class::ResultSource/column_info> for a column.
+
+Must be a coderef that returns a hashref with the extra attributes.
+
+Receives the table name, column name and column_info.
+
+For example:
+
+ custom_column_info => sub {
+ my ($table_name, $column_name, $column_info) = @_;
+
+ if ($column_name eq 'dog' && $column_info->{default_value} eq 'snoopy') {
+ return { is_snoopy => 1 };
+ }
+ },
+
+This attribute can also be used to set C<inflate_datetime> on a non-datetime
+column so it also receives the L</datetime_timezone> and/or L</datetime_locale>.
+
+=head2 datetime_timezone
+
+Sets the timezone attribute for L<DBIx::Class::InflateColumn::DateTime> for all
+columns with the DATE/DATETIME/TIMESTAMP data_types.
+
+=head2 datetime_locale
+
+Sets the locale attribute for L<DBIx::Class::InflateColumn::DateTime> for all
+columns with the DATE/DATETIME/TIMESTAMP data_types.
+
=head1 METHODS
None of these methods are intended for direct invocation by regular
-users of L<DBIx::Class::Schema::Loader>. Anything you can find here
-can also be found via standard L<DBIx::Class::Schema> methods somehow.
+users of L<DBIx::Class::Schema::Loader>. Some are proxied via
+L<DBIx::Class::Schema::Loader>.
=cut
-use constant CURRENT_V => 'v5';
+use constant CURRENT_V => 'v5';
+
+use constant CLASS_ARGS => qw(
+ schema_base_class result_base_class additional_base_classes
+ left_base_classes additional_classes components resultset_components
+);
# ensure that a peice of object data is a valid arrayref, creating
# an empty one or encapsulating whatever's there.
resultset_components
/);
+ $self->_validate_class_args;
+
push(@{$self->{components}}, 'ResultSetManager')
if @{$self->{resultset_components}};
}
$self->{naming} ||= {};
+ if ($self->custom_column_info && ref $self->custom_column_info ne 'CODE') {
+ croak 'custom_column_info must be a CODE ref';
+ }
+
$self->_check_back_compat;
$self->use_namespaces(1) unless defined $self->use_namespaces;
$self->generate_pod(1) unless defined $self->generate_pod;
+ $self->pod_comment_mode('auto') unless defined $self->pod_comment_mode;
+ $self->pod_comment_spillover_length(60) unless defined $self->pod_comment_spillover_length;
$self;
}
close $fh;
}
+sub _validate_class_args {
+ my $self = shift;
+ my $args = shift;
+
+ foreach my $k (CLASS_ARGS) {
+ next unless $self->$k;
+
+ my @classes = ref $self->$k eq 'ARRAY' ? @{ $self->$k } : $self->$k;
+ foreach my $c (@classes) {
+ # components default to being under the DBIx::Class namespace unless they
+ # are preceeded with a '+'
+ if ( $k =~ m/components$/ && $c !~ s/^\+// ) {
+ $c = 'DBIx::Class::' . $c;
+ }
+
+ # 1 == installed, 0 == not installed, undef == invalid classname
+ my $installed = Class::Inspector->installed($c);
+ if ( defined($installed) ) {
+ if ( $installed == 0 ) {
+ croak qq/$c, as specified in the loader option "$k", is not installed/;
+ }
+ } else {
+ croak qq/$c, as specified in the loader option "$k", is an invalid class name/;
+ }
+ }
+ }
+}
+
sub _find_file_in_inc {
my ($self, $file) = @_;
foreach my $prefix (@INC) {
my $fullpath = File::Spec->catfile($prefix, $file);
return $fullpath if -f $fullpath
- and Cwd::abs_path($fullpath) ne
- (Cwd::abs_path(File::Spec->catfile($self->dump_directory, $file)) || '');
+ # abs_path throws on Windows for nonexistant files
+ and eval { Cwd::abs_path($fullpath) } ne
+ (eval { Cwd::abs_path(File::Spec->catfile($self->dump_directory, $file)) } || '');
}
return;
my $cols = $self->_table_columns($table);
my $col_info;
- eval { $col_info = $self->_columns_info_for($table) };
+ eval { $col_info = $self->__columns_info_for($table) };
if($@) {
$self->_dbic_stmt($table_class,'add_columns',@$cols);
}
}
+sub __columns_info_for {
+ my ($self, $table) = @_;
+
+ my $result = $self->_columns_info_for($table);
+
+ while (my ($col, $info) = each %$result) {
+ $info = { %$info, %{ $self->_custom_column_info ($table, $col, $info) } };
+ $info = { %$info, %{ $self->_datetime_column_info($table, $col, $info) } };
+
+ $result->{$col} = $info;
+ }
+
+ return $result;
+}
+
=head2 tables
Returns a sorted list of loaded tables, using the original database table
my $method = shift;
# generate the pod for this statement, storing it with $self->_pod
- $self->_make_pod( $class, $method, @_ );
+ $self->_make_pod( $class, $method, @_ ) if $self->generate_pod;
my $args = dump(@_);
$args = '(' . $args . ')' if @_ < 2;
my $class = shift;
my $method = shift;
- return unless $self->generate_pod;
-
if ( $method eq 'table' ) {
my ($table) = @_;
- $self->_pod( $class, "=head1 NAME" );
- my $table_descr = $class;
+ my $pcm = $self->pod_comment_mode;
+ my ($comment, $comment_overflows, $comment_in_name, $comment_in_desc);
if ( $self->can('_table_comment') ) {
- my $comment = $self->_table_comment($table);
- $table_descr .= " - " . $comment if $comment;
+ $comment = $self->_table_comment($table);
+ $comment_overflows = ($comment and length $comment > $self->pod_comment_spillover_length);
+ $comment_in_name = ($pcm eq 'name' or ($pcm eq 'auto' and !$comment_overflows));
+ $comment_in_desc = ($pcm eq 'description' or ($pcm eq 'auto' and $comment_overflows));
}
+ $self->_pod( $class, "=head1 NAME" );
+ my $table_descr = $class;
+ $table_descr .= " - " . $comment if $comment and $comment_in_name;
$self->{_class2table}{ $class } = $table;
$self->_pod( $class, $table_descr );
+ if ($comment and $comment_in_desc) {
+ $self->_pod( $class, "=head1 DESCRIPTION" );
+ $self->_pod( $class, $comment );
+ }
$self->_pod_cut( $class );
} elsif ( $method eq 'add_columns' ) {
$self->_pod( $class, "=head1 ACCESSORS" );
$self->_pod( $class,
join "\n", map {
my $s = $attrs->{$_};
- $s = !defined $s ? 'undef' :
- length($s) == 0 ? '(empty string)' :
- $s;
+ $s = !defined $s ? 'undef' :
+ length($s) == 0 ? '(empty string)' :
+ ref($s) eq 'SCALAR' ? $$s :
+ $s
+ ;
" $_: $s"
} sort keys %$attrs,
sub _is_case_sensitive { 0 }
+sub _custom_column_info {
+ my ( $self, $table_name, $column_name, $column_info ) = @_;
+
+ if (my $code = $self->custom_column_info) {
+ return $code->($table_name, $column_name, $column_info) || {};
+ }
+ return {};
+}
+
+sub _datetime_column_info {
+ my ( $self, $table_name, $column_name, $column_info ) = @_;
+ my $result = {};
+ my $type = $column_info->{data_type} || '';
+ if ((grep $_, @{ $column_info }{map "inflate_$_", qw/date datetime timestamp/})
+ or ($type =~ /date|timestamp/i)) {
+ $result->{timezone} = $self->datetime_timezone if $self->datetime_timezone;
+ $result->{locale} = $self->datetime_locale if $self->datetime_locale;
+ }
+ return $result;
+}
+
# remove the dump dir from @INC on destruction
sub DESTROY {
my $self = shift;