lib/DBIx/Class/Schema/Loader/DBObject.pm

   1 package DBIx::Class::Schema::Loader::DBObject;
   2
   3 use strict;
   4 use warnings;
   5 use base 'Class::Accessor::Grouped';
   6 use Carp::Clan qw/^DBIx::Class/;
   7 use Scalar::Util 'weaken';
   8 use namespace::clean;
   9
  10 =head1 NAME
  11
  12 DBIx::Class::Schema::Loader::DBObject - Base Class for Database Objects Such as
  13 Tables and Views in L<DBIx::Class::Schema::Loader>
  14
  15 =head1 METHODS
  16
  17 =head2 loader
  18
  19 The loader object this object is associated with, this is a required parameter
  20 to L</new>.
  21
  22 =head2 name
  23
  24 Name of the object. The object stringifies to this value.
  25
  26 =cut
  27
  28 __PACKAGE__->mk_group_accessors(simple => qw/
  29     loader
  30     name
  31     _schema
  32     ignore_schema
  33 /);
  34
  35 use overload
  36     '""' => sub { $_[0]->name };
  37
  38 =head2 new
  39
  40 The constructor, takes L</loader>, L</name>, L</schema>, and L</ignore_schema>
  41 as key-value parameters.
  42
  43 =cut
  44
  45 sub new {
  46     my $class = shift;
  47
  48     my $self = { @_ };
  49
  50     croak "loader is required" unless ref $self->{loader};
  51
  52     weaken $self->{loader};
  53
  54     $self->{_schema} = delete $self->{schema};
  55
  56     return bless $self, $class;
  57 }
  58
  59 =head2 clone
  60
  61 Make a shallow copy of the object.
  62
  63 =cut
  64
  65 sub clone {
  66     my $self = shift;
  67
  68     return bless { %$self }, ref $self;
  69 }
  70
  71 =head2 schema
  72
  73 The schema (or owner) of the object. Returns nothing if L</ignore_schema> is
  74 true.
  75
  76 =head2 ignore_schema
  77
  78 Set to true to make L</schema> and L</sql_name> not use the defined L</schema>.
  79 Does not affect L</dbic_name> (for
  80 L<qualify_objects|DBIx::Class::Schema::Loader::Base/qualify_objects> testing on
  81 SQLite.)
  82
  83 =cut
  84
  85 sub schema {
  86     my $self = shift;
  87
  88     return $self->_schema(@_) unless $self->ignore_schema;
  89
  90     return undef;
  91 }
  92
  93 sub _quote {
  94     my ($self, $identifier) = @_;
  95
  96     $identifier = '' if not defined $identifier;
  97
  98     my $qt = $self->loader->quote_char || '';
  99
 100     if (length $qt > 1) {
 101         my @qt = split //, $qt;
 102         return $qt[0] . $identifier . $qt[1];
 103     }
 104
 105     return "${qt}${identifier}${qt}";
 106 }
 107
 108 =head1 sql_name
 109
 110 Returns the properly quoted full identifier with L</schema> and L</name>.
 111
 112 =cut
 113
 114 sub sql_name {
 115     my $self = shift;
 116
 117     my $name_sep = $self->loader->name_sep;
 118
 119     if ($self->schema) {
 120         return $self->_quote($self->schema)
 121             . $name_sep
 122             . $self->_quote($self->name);
 123     }
 124
 125     return $self->_quote($self->name);
 126 }
 127
 128 =head1 dbic_name
 129
 130 Returns a value suitable for the C<< __PACKAGE__->table >> call in L<DBIx::Class> Result files.
 131
 132 =cut
 133
 134 sub dbic_name {
 135     my $self = shift;
 136
 137     my $name_sep = $self->loader->name_sep;
 138
 139     if ($self->loader->qualify_objects && $self->_schema) {
 140         if ($self->_schema =~ /\W/ || $self->name =~ /\W/) {
 141             return \ $self->sql_name;
 142         }
 143
 144         return $self->_schema . $name_sep . $self->name;
 145     }
 146
 147     if ($self->name =~ /\W/) {
 148         return \ $self->_quote($self->name);
 149     }
 150
 151     return $self->name;
 152 }
 153
 154 =head1 SEE ALSO
 155
 156 L<DBIx::Class::Schema::Loader::Table>, L<DBIx::Class::Schema::Loader>,
 157 L<DBIx::Class::Schema::Loader::Base>
 158
 159 =head1 AUTHOR
 160
 161 See L<DBIx::Class::Schema::Loader/AUTHOR> and L<DBIx::Class::Schema::Loader/CONTRIBUTORS>.
 162
 163 =head1 LICENSE
 164
 165 This library is free software; you can redistribute it and/or modify it under
 166 the same terms as Perl itself.
 167
 168 =cut
 169
 170 1;
 171 # vim:et sts=4 sw=4 tw=0: