lib/SQL/Translator/Filter/DefaultExtra.pm

   1 package SQL::Translator::Filter::DefaultExtra;
   2
   3 # -------------------------------------------------------------------
   4 # $Id$
   5 # -------------------------------------------------------------------
   6 # Copyright (C) 2002-4 SQLFairy Authors
   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 =head1 NAME
  24
  25 SQL::Translator::Filter::DefaultExtra - Set default extra data values for schema
  26 objects.
  27
  28 =head1 SYNOPSIS
  29
  30   use SQL::Translator;
  31
  32   my $sqlt = SQL::Translator->new(
  33       from => 'MySQL',
  34       to   => 'MySQL',
  35       filters => [
  36         DefaultExtra => {
  37             # XXX - These should really be ordered
  38
  39             # Default widget for fields to basic text edit.
  40             'field.widget' => 'text',
  41             # idea:
  42             'field(data_type=BIT).widget' => 'yesno',
  43
  44             # Default label (human formated name) for fields and tables
  45             'field.label'  => '=ucfirst($name)',
  46             'table.label'  => '=ucfirst($name)',
  47         },
  48       ],
  49   ) || die "SQLFairy error : ".SQL::Translator->error;
  50   my $sql = $sqlt->translate || die "SQLFairy error : ".$sqlt->error;
  51
  52 =cut
  53
  54 use strict;
  55 use vars qw/$VERSION/;
  56 $VERSION=0.1;
  57
  58 sub filter {
  59     my $schema = shift;
  60     my %args = { +shift };
  61
  62     # Tables
  63     foreach ( $schema->get_tables ) {
  64         my %extra = $_->extra;
  65
  66         $extra{label} ||= ucfirst($_->name);
  67         $_->extra( %extra );
  68     }
  69
  70     # Fields
  71     foreach ( map { $_->get_fields } $schema->get_tables ) {
  72         my %extra = $_->extra;
  73
  74         $extra{label} ||= ucfirst($_->name);
  75         $_->extra( %extra );
  76     }
  77 }
  78
  79 1;
  80
  81 __END__
  82
  83 =head1 DESCRIPTION
  84
  85 Maybe I'm trying to do too much in one go. Args set a match and then an update,
  86 if you want to set lots of things, use lots of filters!
  87
  88 =head1 SEE ALSO
  89
  90 L<perl(1)>, L<SQL::Translator>
  91
  92 =head1 BUGS
  93
  94 =head1 TODO
  95
  96 =head1 AUTHOR
  97
  98 =cut