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 Moo;
  27 use SQL::Translator::Utils qw(ex2err);
  28 use SQL::Translator::Types qw(schema_obj);
  29 use SQL::Translator::Role::ListAttr;
  30 use Sub::Quote qw(quote_sub);
  31
  32 extends 'SQL::Translator::Schema::Object';
  33
  34 our $VERSION = '1.59_01';
  35
  36 =head2 new
  37
  38 Object constructor.
  39
  40   my $view = SQL::Translator::Schema::View->new;
  41
  42 =head2 fields
  43
  44 Gets and set the fields the constraint is on.  Accepts a string, list or
  45 arrayref; returns an array or array reference.  Will unique the field
  46 names and keep them in order by the first occurrence of a field name.
  47
  48   $view->fields('id');
  49   $view->fields('id', 'name');
  50   $view->fields( 'id, name' );
  51   $view->fields( [ 'id', 'name' ] );
  52   $view->fields( qw[ id name ] );
  53
  54   my @fields = $view->fields;
  55
  56 =cut
  57
  58 with ListAttr fields => ( uniq => 1 );
  59
  60 =head2 tables
  61
  62 Gets and set the tables the SELECT mentions.  Accepts a string, list or
  63 arrayref; returns an array or array reference.  Will unique the table
  64 names and keep them in order by the first occurrence of a field name.
  65
  66   $view->tables('foo');
  67   $view->tables('foo', 'bar');
  68   $view->tables( 'foo, bar' );
  69   $view->tables( [ 'foo', 'bar' ] );
  70   $view->tables( qw[ foo bar ] );
  71
  72   my @tables = $view->tables;
  73
  74 =cut
  75
  76 with ListAttr tables => ( uniq => 1 );
  77
  78 =head2 options
  79
  80 Gets or appends a list of options on the view.
  81
  82   $view->options('ALGORITHM=UNDEFINED');
  83
  84   my @options = $view->options;
  85
  86 =cut
  87
  88 with ListAttr options => ( uniq => 1, append => 1 );
  89
  90 sub is_valid {
  91
  92 =pod
  93
  94 =head2 is_valid
  95
  96 Determine whether the view is valid or not.
  97
  98   my $ok = $view->is_valid;
  99
 100 =cut
 101
 102     my $self = shift;
 103
 104     return $self->error('No name') unless $self->name;
 105     return $self->error('No sql')  unless $self->sql;
 106
 107     return 1;
 108 }
 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 has name => ( is => 'rw', default => quote_sub(q{ '' }) );
 119
 120 =head2 order
 121
 122 Get or set the view's order.
 123
 124   my $order = $view->order(3);
 125
 126 =cut
 127
 128 has order => ( is => 'rw', default => quote_sub(q{ 0 }) );
 129
 130 around order => sub {
 131     my ( $orig, $self, $arg ) = @_;
 132
 133     if ( defined $arg && $arg =~ /^\d+$/ ) {
 134         return $self->$orig($arg);
 135     }
 136
 137     return $self->$orig;
 138 };
 139
 140 =head2 sql
 141
 142 Get or set the view's SQL.
 143
 144   my $sql = $view->sql('select * from foo');
 145
 146 =cut
 147
 148 has sql => ( is => 'rw', default => quote_sub(q{ '' }) );
 149
 150 =head2 schema
 151
 152 Get or set the view's schema object.
 153
 154   $view->schema( $schema );
 155   my $schema = $view->schema;
 156
 157 =cut
 158
 159 has schema => ( is => 'rw', isa => schema_obj('Schema'), weak_ref => 1 );
 160
 161 around schema => \&ex2err;
 162
 163 =head2 equals
 164
 165 Determines if this view is the same as another
 166
 167   my $isIdentical = $view1->equals( $view2 );
 168
 169 =cut
 170
 171 around equals => sub {
 172     my $orig = shift;
 173     my $self = shift;
 174     my $other = shift;
 175     my $case_insensitive = shift;
 176     my $ignore_sql = shift;
 177
 178     return 0 unless $self->$orig($other);
 179     return 0 unless $case_insensitive ? uc($self->name) eq uc($other->name) : $self->name eq $other->name;
 180     #return 0 unless $self->is_valid eq $other->is_valid;
 181
 182     unless ($ignore_sql) {
 183         my $selfSql = $self->sql;
 184         my $otherSql = $other->sql;
 185         # Remove comments
 186         $selfSql =~ s/--.*$//mg;
 187         $otherSql =~ s/--.*$//mg;
 188         # Collapse whitespace to space to avoid whitespace comparison issues
 189         $selfSql =~ s/\s+/ /sg;
 190         $otherSql =~ s/\s+/ /sg;
 191         return 0 unless $selfSql eq $otherSql;
 192     }
 193
 194     my $selfFields = join(":", $self->fields);
 195     my $otherFields = join(":", $other->fields);
 196     return 0 unless $case_insensitive ? uc($selfFields) eq uc($otherFields) : $selfFields eq $otherFields;
 197     return 0 unless $self->_compare_objects(scalar $self->extra, scalar $other->extra);
 198     return 1;
 199 };
 200
 201 # Must come after all 'has' declarations
 202 around new => \&ex2err;
 203
 204 1;
 205
 206 =pod
 207
 208 =head1 AUTHOR
 209
 210 Ken Youens-Clark E<lt>kclark@cpan.orgE<gt>.
 211
 212 =cut