use DBIx::Class ();
use Encode qw/encode decode/;
use List::MoreUtils qw/all firstidx/;
-use IPC::Open2;
-use Symbol 'gensym';
+use File::Temp 'tempfile';
use namespace::clean;
-our $VERSION = '0.07010';
+our $VERSION = '0.07011';
__PACKAGE__->mk_group_ro_accessors('simple', qw/
schema
L</force_ascii> is set; this is only significant for names with non-C<\w>
characters such as C<.>.
+CamelCase identifiers with words in all caps, e.g. C<VLANValidID> are supported
+correctly in this mode.
+
For relationships, belongs_to accessors are made from column names by stripping
-postfixes other than C<_id> as well, just C<id>, C<_?ref>, C<_?cd>, C<_?code>
-and C<_num>.
+postfixes other than C<_id> as well, for example just C<Id>, C<_?ref>, C<_?cd>,
+C<_?code> and C<_?num>, case insensitively.
=item preserve
=head2 preserve_case
-Usually column names are lowercased, to make them easier to work with in
-L<DBIx::Class>. This option lets you turn this behavior off, if the driver
-supports it.
+Normally database names are lowercased and split by underscore, use this option
+if you have CamelCase database names.
Drivers for case sensitive databases like Sybase ASE or MSSQL with a
case-sensitive collation will turn this option on unconditionally.
-Currently the drivers for SQLite, mysql, MSSQL and Firebird/InterBase support
-setting this option.
+B<NOTE:> L</naming> = C<v8> is highly recommended with this option as the
+semantics of this mode are much improved for CamelCase database names.
+
+L</naming> = C<v7> or greater is required with this option.
=head2 qualify_objects
my $custom_content = $old_custom || '';
- # prepend extra custom content from a *renamed* class (singularization effect)
+ # Use custom content from a renamed class, the class names in it are
+ # rewritten below.
if (my $renamed_class = $self->_upgrading_classes->{$class}) {
my $old_filename = $self->_get_dump_filename($renamed_class);
if (-f $old_filename) {
- my $extra_custom = ($self->_parse_generated_file ($old_filename))[4];
-
- $extra_custom =~ s/\n\n# You can replace.*\n1;\n//;
-
- $custom_content = join ("\n", '', $extra_custom, $custom_content)
- if $extra_custom;
+ $custom_content = ($self->_parse_generated_file ($old_filename))[4];
unlink $old_filename;
}
);
}
else {
- my ($out, $in) = (gensym, gensym);
+ my ($fh, $temp_file) = tempfile();
- my $pid = open2($out, $in, $filter)
- or croak "Could not open pipe to $filter: $!";
-
- print $in $text;
+ binmode $fh, ':encoding(UTF-8)';
+ print $fh $text;
+ close $fh;
- close $in;
+ open my $out, qq{$filter < "$temp_file"|}
+ or croak "Could not open pipe to $filter: $!";
$text = decode('UTF-8', do { local $/; <$out> });
$text =~ s/$CR?$LF/\n/g;
- waitpid $pid, 0;
+ close $out;
my $exit_code = $? >> 8;
+ unlink $temp_file
+ or croak "Could not remove temporary file '$temp_file': $!";
+
if ($exit_code != 0) {
croak "filter '$filter' exited non-zero: $exit_code";
}
sub _default_column_accessor_name {
my ( $self, $column_name ) = @_;
- my $accessor_name = $self->_to_identifier('column_accessors', $column_name, '_');
+ my $preserve = ($self->naming->{column_accessors}||'') eq 'preserve';
+
+ my $v = $self->_get_naming_v('column_accessors');
+
+ my $accessor_name = $preserve ?
+ $self->_to_identifier('column_accessors', $column_name) # assume CamelCase
+ :
+ $self->_to_identifier('column_accessors', $column_name, '_');
$accessor_name =~ s/\W+/_/g; # only if naming < v8, otherwise to_identifier
# takes care of it
- if ((($self->naming->{column_accessors}||'') =~ /(\d+)/ && $1 < 7) || (not $self->preserve_case)) {
+ if ($preserve) {
+ return $accessor_name;
+ }
+ elsif ($v < 7 || (not $self->preserve_case)) {
# older naming just lc'd the col accessor and that's all.
return lc $accessor_name;
}
- elsif (($self->naming->{column_accessors}||'') eq 'preserve') {
- return $accessor_name;
- }
- return join '_', map lc, split_name $column_name;
+ return join '_', map lc, split_name $column_name, $v;
}
sub _make_column_accessor_name {
}
sub _to_identifier {
- my ($self, $naming_key, $name, $sep_char) = @_;
+ my ($self, $naming_key, $name, $sep_char, $force) = @_;
my $v = $self->_get_naming_v($naming_key);
\&String::ToIdentifier::EN::to_identifier
: \&String::ToIdentifier::EN::Unicode::to_identifier;
- return $v >= 8 ? $to_identifier->($name, $sep_char) : $name;
+ return $v >= 8 || $force ? $to_identifier->($name, $sep_char) : $name;
}
# Make a moniker from a table
my $part = $name_parts[$i];
if ($i != $name_idx || $v >= 8) {
- $part = $self->_to_identifier('monikers', $part, '_');
+ $part = $self->_to_identifier('monikers', $part, '_', 1);
}
if ($i == $name_idx && $v == 5) {
$part = Lingua::EN::Inflect::Number::to_S($part);
}
- my @part_parts = map lc, $v > 6 ? split_name $part : split /[\W_]+/, $part;
+ my @part_parts = map lc, $v > 6 ?
+ # use v8 semantics for all moniker parts except name
+ ($i == $name_idx ? split_name $part, $v : split_name $part)
+ : split /[\W_]+/, $part;
if ($i == $name_idx && $v >= 6) {
my $as_phrase = join ' ', @part_parts;