lib/SQL/Translator/Filter/DefaultExtra.pm

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