lib/SQL/Translator/Schema/View.pm

   1 package SQL::Translator::Schema::View;
   2
   3 =pod
   4
   5 =head1 NAME
   6
   7 SQL::Translator::Schema::View - SQL::Translator view object
   8
   9 =head1 SYNOPSIS
  10
  11   use SQL::Translator::Schema::View;
  12   my $view   = SQL::Translator::Schema::View->new(
  13       name   => 'foo',                      # name, required
  14       sql    => 'select id, name from foo', # SQL for view
  15       fields => 'id, name',                 # field names in view
  16   );
  17
  18 =head1 DESCRIPTION
  19
  20 C<SQL::Translator::Schema::View> is the view object.
  21
  22 =head1 METHODS
  23
  24 =cut
  25
  26 use strict;
  27 use SQL::Translator::Utils 'parse_list_arg';
  28
  29 use base 'SQL::Translator::Schema::Object';
  30
  31 use vars qw($VERSION $TABLE_COUNT $VIEW_COUNT);
  32
  33 $VERSION = '1.59';
  34
  35 __PACKAGE__->_attributes( qw/
  36     name sql fields schema order
  37 /);
  38
  39 =pod
  40
  41 =head2 new
  42
  43 Object constructor.
  44
  45   my $view = SQL::Translator::Schema::View->new;
  46
  47 =cut
  48
  49 sub fields {
  50
  51 =pod
  52
  53 =head2 fields
  54
  55 Gets and set the fields the constraint is on.  Accepts a string, list or
  56 arrayref; returns an array or array reference.  Will unique the field
  57 names and keep them in order by the first occurrence of a field name.
  58
  59   $view->fields('id');
  60   $view->fields('id', 'name');
  61   $view->fields( 'id, name' );
  62   $view->fields( [ 'id', 'name' ] );
  63   $view->fields( qw[ id name ] );
  64
  65   my @fields = $view->fields;
  66
  67 =cut
  68
  69     my $self   = shift;
  70     my $fields = parse_list_arg( @_ );
  71
  72     if ( @$fields ) {
  73         my ( %unique, @unique );
  74         for my $f ( @$fields ) {
  75             next if $unique{ $f };
  76             $unique{ $f } = 1;
  77             push @unique, $f;
  78         }
  79
  80         $self->{'fields'} = \@unique;
  81     }
  82
  83     return wantarray ? @{ $self->{'fields'} || [] } : ($self->{'fields'} || '');
  84 }
  85
  86 sub is_valid {
  87
  88 =pod
  89
  90 =head2 is_valid
  91
  92 Determine whether the view is valid or not.
  93
  94   my $ok = $view->is_valid;
  95
  96 =cut
  97
  98     my $self = shift;
  99
 100     return $self->error('No name') unless $self->name;
 101     return $self->error('No sql')  unless $self->sql;
 102
 103     return 1;
 104 }
 105
 106 sub name {
 107
 108 =pod
 109
 110 =head2 name
 111
 112 Get or set the view's name.
 113
 114   my $name = $view->name('foo');
 115
 116 =cut
 117
 118     my $self        = shift;
 119     $self->{'name'} = shift if @_;
 120     return $self->{'name'} || '';
 121 }
 122
 123 sub order {
 124
 125 =pod
 126
 127 =head2 order
 128
 129 Get or set the view's order.
 130
 131   my $order = $view->order(3);
 132
 133 =cut
 134
 135     my ( $self, $arg ) = @_;
 136
 137     if ( defined $arg && $arg =~ /^\d+$/ ) {
 138         $self->{'order'} = $arg;
 139     }
 140
 141     return $self->{'order'} || 0;
 142 }
 143
 144 sub sql {
 145
 146 =pod
 147
 148 =head2 sql
 149
 150 Get or set the view's SQL.
 151
 152   my $sql = $view->sql('select * from foo');
 153
 154 =cut
 155
 156     my $self       = shift;
 157     $self->{'sql'} = shift if @_;
 158     return $self->{'sql'} || '';
 159 }
 160
 161 sub schema {
 162
 163 =pod
 164
 165 =head2 schema
 166
 167 Get or set the view's schema object.
 168
 169   $view->schema( $schema );
 170   my $schema = $view->schema;
 171
 172 =cut
 173
 174     my $self = shift;
 175     if ( my $arg = shift ) {
 176         return $self->error('Not a schema object') unless
 177             UNIVERSAL::isa( $arg, 'SQL::Translator::Schema' );
 178         $self->{'schema'} = $arg;
 179     }
 180
 181     return $self->{'schema'};
 182 }
 183
 184 sub equals {
 185
 186 =pod
 187
 188 =head2 equals
 189
 190 Determines if this view is the same as another
 191
 192   my $isIdentical = $view1->equals( $view2 );
 193
 194 =cut
 195
 196     my $self = shift;
 197     my $other = shift;
 198     my $case_insensitive = shift;
 199     my $ignore_sql = shift;
 200
 201     return 0 unless $self->SUPER::equals($other);
 202     return 0 unless $case_insensitive ? uc($self->name) eq uc($other->name) : $self->name eq $other->name;
 203     #return 0 unless $self->is_valid eq $other->is_valid;
 204
 205     unless ($ignore_sql) {
 206         my $selfSql = $self->sql;
 207         my $otherSql = $other->sql;
 208         # Remove comments
 209         $selfSql =~ s/--.*$//mg;
 210         $otherSql =~ s/--.*$//mg;
 211         # Collapse whitespace to space to avoid whitespace comparison issues
 212         $selfSql =~ s/\s+/ /sg;
 213         $otherSql =~ s/\s+/ /sg;
 214         return 0 unless $selfSql eq $otherSql;
 215     }
 216
 217     my $selfFields = join(":", $self->fields);
 218     my $otherFields = join(":", $other->fields);
 219     return 0 unless $case_insensitive ? uc($selfFields) eq uc($otherFields) : $selfFields eq $otherFields;
 220     return 0 unless $self->_compare_objects(scalar $self->extra, scalar $other->extra);
 221     return 1;
 222 }
 223
 224 sub DESTROY {
 225     my $self = shift;
 226     undef $self->{'schema'}; # destroy cyclical reference
 227 }
 228
 229 1;
 230
 231 =pod
 232
 233 =head1 AUTHOR
 234
 235 Ken Youens-Clark E<lt>kclark@cpan.orgE<gt>.
 236
 237 =cut