lib/SQL/Translator/Filter/DefaultExtra.pm

   1 package SQL::Translator::Filter::DefaultExtra;
   2
   3 # -------------------------------------------------------------------
   4 # Copyright (C) 2002-2009 SQLFairy Authors
   5 #
   6 # This program is free software; you can redistribute it and/or
   7 # modify it under the terms of the GNU General Public License as
   8 # published by the Free Software Foundation; version 2.
   9 #
  10 # This program is distributed in the hope that it will be useful, but
  11 # WITHOUT ANY WARRANTY; without even the implied warranty of
  12 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  13 # General Public License for more details.
  14 #
  15 # You should have received a copy of the GNU General Public License
  16 # along with this program; if not, write to the Free Software
  17 # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
  18 # 02111-1307  USA
  19 # -------------------------------------------------------------------
  20
  21 =head1 NAME
  22
  23 SQL::Translator::Filter::DefaultExtra - Set default extra data values for schema
  24 objects.
  25
  26 =head1 SYNOPSIS
  27
  28   use SQL::Translator;
  29
  30   my $sqlt = SQL::Translator->new(
  31       from => 'MySQL',
  32       to   => 'MySQL',
  33       filters => [
  34         DefaultExtra => {
  35             # XXX - These should really be ordered
  36
  37             # Default widget for fields to basic text edit.
  38             'field.widget' => 'text',
  39             # idea:
  40             'field(data_type=BIT).widget' => 'yesno',
  41
  42             # Default label (human formated name) for fields and tables
  43             'field.label'  => '=ucfirst($name)',
  44             'table.label'  => '=ucfirst($name)',
  45         },
  46       ],
  47   ) || die "SQLFairy error : ".SQL::Translator->error;
  48   my $sql = $sqlt->translate || die "SQLFairy error : ".$sqlt->error;
  49
  50 =cut
  51
  52 use strict;
  53 use vars qw/$VERSION/;
  54 $VERSION = '1.59';
  55
  56 sub filter {
  57     my $schema = shift;
  58     my %args = { +shift };
  59
  60     # Tables
  61     foreach ( $schema->get_tables ) {
  62         my %extra = $_->extra;
  63
  64         $extra{label} ||= ucfirst($_->name);
  65         $_->extra( %extra );
  66     }
  67
  68     # Fields
  69     foreach ( map { $_->get_fields } $schema->get_tables ) {
  70         my %extra = $_->extra;
  71
  72         $extra{label} ||= ucfirst($_->name);
  73         $_->extra( %extra );
  74     }
  75 }
  76
  77 1;
  78
  79 __END__
  80
  81 =head1 DESCRIPTION
  82
  83 Maybe I'm trying to do too much in one go. Args set a match and then an update,
  84 if you want to set lots of things, use lots of filters!
  85
  86 =head1 SEE ALSO
  87
  88 L<perl(1)>, L<SQL::Translator>
  89
  90 =head1 BUGS
  91
  92 =head1 TODO
  93
  94 =head1 AUTHOR
  95
  96 =cut