lib/SQL/Translator/Producer/YAML.pm

   1 use MooseX::Declare;
   2 role SQL::Translator::Producer::YAML {
   3 use YAML qw(Dump);
   4 use SQL::Translator::Types qw(Table);
   5
   6 method produce {
   7     my $translator = $self;
   8     my $schema     = $translator->schema;
   9 #    use Data::Dumper; warn Dumper($schema);
  10
  11     my $r = Dump({
  12         schema => {
  13             tables => {
  14                 map { ($_->name => view_table($_)) }
  15                     $schema->get_tables,
  16             },
  17             views => {
  18 #                map { ($_->name => view_view($_)) }
  19 #                    $schema->get_views,
  20             },
  21             triggers => {
  22 #                map { ($_->name => view_trigger($_)) }
  23 #                    $schema->get_triggers,
  24             },
  25             procedures => {
  26 #                map { ($_->name => view_procedure($_)) }
  27 #                    $schema->get_procedures,
  28             },
  29         },
  30 #        translator => {
  31 #            add_drop_table => $translator->add_drop_table,
  32 #            filename       => $translator->filename,
  33 #            no_comments    => $translator->no_comments,
  34 #            parser_args    => $translator->parser_args,
  35 #            producer_args  => $translator->producer_args,
  36 #            parser_type    => $translator->parser_type,
  37 #            producer_type  => $translator->producer_type,
  38 #            show_warnings  => $translator->show_warnings,
  39 #            trace          => $translator->trace,
  40 #            version        => $translator->version,
  41 #        },
  42 #        keys %{$schema->extra} ? ('extra' => { $schema->extra } ) : (),
  43     });
  44 #    use Data::Dumper; warn Dumper($r);
  45     $r;
  46 }
  47
  48 sub view_table {
  49     my ($table) = shift;
  50
  51     return {
  52         'name'        => $table->name,
  53 #        'order'       => $table->order,
  54         'options'     => $table->options  || [],
  55         $table->comments ? ('comments'    => $table->comments ) : (),
  56         'constraints' => [
  57             map { view_constraint($_) } $table->get_constraints
  58         ],
  59         'indices'     => [
  60             map { view_index($_) } $table->get_indices
  61         ],
  62         'fields'      => {
  63             map { ($_->name => view_field($_)) }
  64                 $table->get_fields
  65         },
  66         #keys %{$table->extra} ? ('extra' => { $table->extra } ) : (),
  67     };
  68 }
  69
  70 sub view_constraint {
  71     my $constraint = shift;
  72
  73     return {
  74         'deferrable'       => scalar $constraint->deferrable,
  75         'expression'       => scalar $constraint->expression,
  76         'fields'           => [ map { ref $_ ? $_->name : $_ } $constraint->field_names ],
  77         'match_type'       => scalar $constraint->match_type,
  78         'name'             => scalar $constraint->name,
  79         'options'          => scalar $constraint->options,
  80 #        'on_delete'        => scalar $constraint->on_delete,
  81 #        'on_update'        => scalar $constraint->on_update,
  82 #        'reference_fields' => [ map { ref $_ ? $_->name : $_ } $constraint->reference_fields ],
  83 #        'reference_table'  => scalar $constraint->reference_table,
  84         'type'             => scalar $constraint->type,
  85         #keys %{$constraint->extra} ? ('extra' => { $constraint->extra } ) : (),
  86     };
  87 }
  88
  89 sub view_field {
  90     my $field = shift;
  91
  92     return {
  93         'order'             => scalar $field->order,
  94         'name'              => scalar $field->name,
  95         'data_type'         => scalar $field->data_type,
  96         'size'              => [ $field->size ],
  97         'default_value'     => scalar $field->default_value,
  98         'is_nullable'       => scalar $field->is_nullable,
  99         'is_primary_key'    => scalar $field->is_primary_key,
 100         'is_unique'         => scalar $field->is_unique,
 101         $field->is_auto_increment ? ('is_auto_increment' => 1) : (),
 102         $field->comments ? ('comments' => $field->comments) : (),
 103         #keys %{$field->extra} ? ('extra' => { $field->extra } ) : (),
 104     };
 105 }
 106
 107 sub view_procedure {
 108     my $procedure = shift;
 109
 110     return {
 111         'order'      => scalar $procedure->order,
 112         'name'       => scalar $procedure->name,
 113         'sql'        => scalar $procedure->sql,
 114         'parameters' => scalar $procedure->parameters,
 115         'owner'      => scalar $procedure->owner,
 116         'comments'   => scalar $procedure->comments,
 117         #keys %{$procedure->extra} ? ('extra' => { $procedure->extra } ) : (),
 118     };
 119 }
 120
 121 sub view_trigger {
 122     my $trigger = shift;
 123
 124     return {
 125         'order'               => scalar $trigger->order,
 126         'name'                => scalar $trigger->name,
 127         'perform_action_when' => scalar $trigger->perform_action_when,
 128         'database_events'     => scalar $trigger->database_events,
 129         'fields'              => scalar $trigger->fields,
 130         'on_table'            => scalar $trigger->on_table,
 131         'action'              => scalar $trigger->action,
 132         #keys %{$trigger->extra} ? ('extra' => { $trigger->extra } ) : (),
 133     };
 134 }
 135
 136 sub view_view {
 137     my $view = shift;
 138
 139     return {
 140         'order'  => scalar $view->order,
 141         'name'   => scalar $view->name,
 142         'sql'    => scalar $view->sql,
 143         'fields' => scalar $view->fields,
 144         #keys %{$view->extra} ? ('extra' => { $view->extra } ) : (),
 145     };
 146 }
 147
 148 sub view_index {
 149     my $index = shift;
 150
 151     return {
 152         'name'      => scalar $index->name,
 153         'type'      => scalar $index->type,
 154         'fields'    => scalar $index->fields,
 155         'options'   => scalar $index->options,
 156         #keys %{$index->extra} ? ('extra' => { $index->extra } ) : (),
 157     };
 158 }
 159 }