lib/SQL/Translator/Producer/YAML.pm

   1 package SQL::Translator::Producer::YAML;
   2
   3 # -------------------------------------------------------------------
   4 # $Id: YAML.pm,v 1.1 2003-10-08 16:33:13 dlc Exp $
   5 # -------------------------------------------------------------------
   6 # Copyright (C) 2003 darren chamberlain <darren@cpan.org>,
   7 #
   8 # This program is free software; you can redistribute it and/or
   9 # modify it under the terms of the GNU General Public License as
  10 # published by the Free Software Foundation; version 2.
  11 #
  12 # This program is distributed in the hope that it will be useful, but
  13 # WITHOUT ANY WARRANTY; without even the implied warranty of
  14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  15 # General Public License for more details.
  16 #
  17 # You should have received a copy of the GNU General Public License
  18 # along with this program; if not, write to the Free Software
  19 # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
  20 # 02111-1307  USA
  21 # -------------------------------------------------------------------
  22
  23 use strict;
  24 use vars qw($VERSION);
  25 $VERSION = sprintf "%d.%02d", q$Revision: 1.1 $ =~ /(\d+)\.(\d+)/;
  26
  27 use SQL::Translator::Utils qw(header_comment);
  28
  29 sub produce {
  30     my $translator  = shift;
  31     my $schema      = $translator->schema;
  32
  33     return
  34         join "\n" =>
  35             '--- #YAML:1.0',
  36             #header_comment('', '# '),
  37             map { view_table($_) } $schema->get_tables;
  38 }
  39
  40 sub view_table {
  41     my $table = shift;
  42
  43     return
  44         sprintf "%s:\n%s\n",
  45             $table->name,
  46             join "\n" =>
  47                 map { "    $_" }
  48                 map { view_field($_) } $table->get_fields;
  49 }
  50
  51 sub view_field {
  52     my $field = shift;
  53
  54     return
  55         sprintf("%s: %s" => $field->name),
  56         map {
  57             sprintf "    %s: %s" => $_->[0], view($_->[1])
  58         } (
  59             [ 'order' =>   $field->order        ],
  60             [ 'name'  =>   $field->name         ],
  61             [ 'type'  =>   $field->data_type    ],
  62             [ 'size'  => [ $field->size  ]      ],
  63             [ 'extra' => { $field->extra }      ],
  64         );
  65 }
  66
  67 sub view {
  68     my $thingie = shift;
  69
  70     {   ''       => sub { $_[0] },
  71         'SCALAR' => sub { ${$_[0]} },
  72         'ARRAY'  => sub { join "\n    - $_", @{$_[0]} },
  73         'HASH'   => sub { join "\n    " => map { "$_: $_[0]->{$_}" } keys %{$_[0]} },
  74     }->{ref $thingie}->($thingie);
  75 }
  76
  77 1;