lib/SQL/Translator/Object/Schema.pm

   1 use MooseX::Declare;
   2 class SQL::Translator::Object::Schema extends SQL::Translator::Object {
   3     use MooseX::Types::Moose qw(HashRef Maybe Str);
   4     use MooseX::MultiMethods;
   5     use Tie::IxHash;
   6     use SQL::Translator::Types qw(Procedure Table Trigger View ProcedureHash TableHash TriggerHash ViewHash IxHash);
   7
   8     has 'name' => (
   9         is => 'rw',
  10         isa => Maybe[Str],
  11         required => 1,
  12         default => ''
  13     );
  14
  15     has 'database' => (
  16         is => 'rw',
  17         isa => Maybe[Str],
  18     );
  19
  20     has 'tables' => (
  21         traits => ['Hash'],
  22         is => 'rw',
  23         isa => HashRef[Table],
  24         handles => {
  25             exists_table => 'exists',
  26             table_ids    => 'keys',
  27             get_tables   => 'values',
  28             get_table    => 'get',
  29             add_table    => 'set',
  30             remove_table => 'delete',
  31         },
  32         default => sub { my %hash = (); tie %hash, 'Tie::IxHash'; return \%hash },
  33     );
  34
  35     has 'views' => (
  36         traits => ['Hash'],
  37         is => 'rw',
  38         isa => HashRef[View],
  39         handles => {
  40             exists_view => 'exists',
  41             view_ids    => 'keys',
  42             get_views   => 'values',
  43             get_view    => 'get',
  44             add_view    => 'set',
  45             remove_view => 'delete',
  46         },
  47         default => sub { my %hash = (); tie %hash, 'Tie::IxHash'; return \%hash },
  48     );
  49
  50     has 'procedures' => (
  51         traits => ['Hash'],
  52         is => 'rw',
  53         isa => HashRef[Procedure],
  54         handles => {
  55             exists_procedure => 'exists',
  56             procedure_ids    => 'keys',
  57             get_procedures   => 'values',
  58             get_procedure    => 'get',
  59             add_procedure    => 'set',
  60             remove_procedure => 'delete',
  61         },
  62         default => sub { my %hash = (); tie %hash, 'Tie::IxHash'; return \%hash },
  63     );
  64
  65     has 'triggers' => (
  66         traits => ['Hash'],
  67         is => 'rw',
  68         isa => HashRef[Trigger],
  69         handles => {
  70             exists_trigger => 'exists',
  71             trigger_ids    => 'keys',
  72             get_triggers   => 'values',
  73             get_trigger    => 'get',
  74             add_trigger    => 'set',
  75             remove_trigger => 'delete',
  76         },
  77         default => sub { my %hash = (); tie %hash, 'Tie::IxHash'; return \%hash },
  78     );
  79
  80     around add_table(Table $table does coerce) {
  81         die "Can't use table name " . $table->name if $self->exists_table($table->name) || $table->name eq '';
  82         $table->schema($self);
  83         $self->$orig($table->name, $table);
  84     }
  85
  86     around add_view(View $view does coerce) {
  87         die "Can't use view name " . $view->name if $self->exists_view($view->name) || $view->name eq '';
  88         $view->schema($self);
  89         $self->$orig($view->name, $view)
  90     }
  91
  92     around add_procedure(Procedure $procedure does coerce) {
  93         $procedure->schema($self);
  94         $self->$orig($procedure->name, $procedure)
  95     }
  96
  97     around add_trigger(Trigger $trigger does coerce) {
  98         $trigger->schema($self);
  99         $self->$orig($trigger->name, $trigger);;
 100     }
 101
 102     method is_valid { return $self->get_tables ? 1 : undef }
 103
 104     around remove_table(Table|Str $table, Int :$cascade = 0) {
 105         my $name = is_Table($table) ? $table->name : $table;
 106         die "Can't drop non-existant table " . $name unless $self->exists_table($name);
 107         $self->$orig($name);
 108     }
 109
 110     around remove_view(View|Str $view) {
 111         my $name = is_View($view) ? $view->name : $view;
 112         die "Can't drop non-existant view " . $name unless $self->exists_view($name);
 113         $self->$orig($name);
 114     }
 115
 116     around remove_trigger(Trigger|Str $trigger) {
 117         my $name = is_Trigger($trigger) ? $trigger->name : $trigger;
 118 ####        die "Can't drop non-existant trigger " . $name unless $self->exists_trigger($name);
 119         $self->$orig($name);
 120     }
 121
 122     around remove_procedure(Procedure|Str $procedure) {
 123         my $name = is_Procedure($procedure) ? $procedure->name : $procedure;
 124         $self->$orig($name);
 125     }
 126
 127     method order { }
 128     method perform_action_when { }
 129     method database_events { }
 130     method fields { }
 131     method on_table { }
 132     method action { }
 133 }