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 our $VERSION = '1.59';
  37
  38 sub filter {
  39     my $schema = shift;
  40     my %args = { +shift };
  41
  42     # Tables
  43     foreach ( $schema->get_tables ) {
  44         my %extra = $_->extra;
  45
  46         $extra{label} ||= ucfirst($_->name);
  47         $_->extra( %extra );
  48     }
  49
  50     # Fields
  51     foreach ( map { $_->get_fields } $schema->get_tables ) {
  52         my %extra = $_->extra;
  53
  54         $extra{label} ||= ucfirst($_->name);
  55         $_->extra( %extra );
  56     }
  57 }
  58
  59 1;
  60
  61 __END__
  62
  63 =head1 DESCRIPTION
  64
  65 Maybe I'm trying to do too much in one go. Args set a match and then an update,
  66 if you want to set lots of things, use lots of filters!
  67
  68 =head1 SEE ALSO
  69
  70 L<perl(1)>, L<SQL::Translator>
  71
  72 =head1 BUGS
  73
  74 =head1 TODO
  75
  76 =head1 AUTHOR
  77
  78 =cut