lib/SQL/Translator/Parser/Sybase.pm

   1 package SQL::Translator::Parser::Sybase;
   2
   3 # -------------------------------------------------------------------
   4 # $Id: Sybase.pm,v 1.3 2002-11-22 03:03:40 kycl4rk Exp $
   5 # -------------------------------------------------------------------
   6 # Copyright (C) 2002 Ken Y. Clark <kclark@cpan.org>,
   7 #                    darren chamberlain <darren@cpan.org>
   8 #
   9 # This program is free software; you can redistribute it and/or
  10 # modify it under the terms of the GNU General Public License as
  11 # published by the Free Software Foundation; version 2.
  12 #
  13 # This program is distributed in the hope that it will be useful, but
  14 # WITHOUT ANY WARRANTY; without even the implied warranty of
  15 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  16 # General Public License for more details.
  17 #
  18 # You should have received a copy of the GNU General Public License
  19 # along with this program; if not, write to the Free Software
  20 # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
  21 # 02111-1307  USA
  22 # -------------------------------------------------------------------
  23
  24 =head1 NAME
  25
  26 SQL::Translator::Parser::Sybase - parser for Sybase
  27
  28 =head1 SYNOPSIS
  29
  30   use SQL::Translator::Parser::Sybase;
  31
  32 =head1 DESCRIPTION
  33
  34 Parses the output of "dbschema.pl," a Perl script freely available from
  35 www.midsomer.org.
  36
  37 =cut
  38
  39 my $grammar = q{
  40
  41     { our ( %tables ) }
  42
  43     file         : statement(s) { \%tables }
  44 #        { print "statements: ", join("\n", @{$item[1]}), "\n" }
  45 #                   | <error>
  46
  47     statement    : create
  48                    | junk
  49 #        {
  50 #            print "statement: ", join("\n", @{$item[1]}), "\n";
  51 #            $return = @{$item[1]};
  52 #            print "statement: '", $item[1], "'\n";
  53 #            $return = $item[1];
  54 #        }
  55                    | <error>
  56
  57     junk         : comment
  58                    | use
  59                    | setuser
  60                    | if
  61                    | print
  62                    | else
  63                    | begin
  64                    | end
  65                    | grant
  66                    | exec
  67                    | GO
  68
  69     GO           : /go/
  70 #        { print "GO: ", $item[1], "\n" }
  71
  72     use          : /use/i /.*/
  73 #        { print "USE: ", $item[2], "\n" }
  74
  75     setuser      : /setuser/i /.*/
  76 #        { print "SETUSER: ", $item[2], "\n" }
  77
  78     if           : /if/i /.*/
  79 #        { print "IF: ", $item[2], "\n" }
  80
  81     print        : /\s*/ /print/i /.*/
  82 #       { print "PRINT: ", $item[3], "\n" }
  83
  84     else        : /else/i /.*/
  85 #        { print "ELSE: ", $item[2], "\n" }
  86
  87     begin       : /begin/i
  88 #        { print "BEGIN\n" }
  89
  90     end         : /end/i
  91 #        { print "END\n" }
  92
  93     grant       : /grant/i /.*/
  94 #        { print "GRANT: ", $item[2], "\n" }
  95
  96     exec        : /exec/i /.*/
  97 #        { print "EXEC: ", $item[2], "\n" }
  98
  99     comment      : /^\s*\/\*.*\*\//m
 100 #        { print "COMMENT: ", $item[-1], "\n" }
 101
 102     create       : create_table table_name '(' field(s /,/) ')' lock(?)
 103                 {
 104 #                    print "TABLE $item[2]: ",
 105 #                        join(', ', map{$_->{'name'}}@{$item[4]}), "\n";
 106                     my $i = 0;
 107                     for my $line ( @{ $item[4] } ) {
 108                         if ( $line->{'type'} eq 'field' ) {
 109                             my $field_name = $line->{'name'};
 110                             $tables{ $item{'table_name'} }
 111                                 {'fields'}{$field_name} =
 112                                 { %$line, order => $i };
 113                             $i++;
 114
 115                             if ( $line->{'is_primary_key'} ) {
 116                                 push
 117                                 @{ $tables{ $item{'table_name'} }{'indices'} },
 118                                 {
 119                                     type   => 'primary_key',
 120                                     fields => [ $field_name ],
 121                                 };
 122                             }
 123                         }
 124                         else {
 125                             push @{ $tables{ $item{'table_name'} }{'indices'} },
 126                                 $line;
 127                         }
 128                         $tables{ $item{'table_name'} }{'type'} =
 129                             $item{'table_type'}[0];
 130                     }
 131                 }
 132                    | <error>
 133
 134     blank        : /\s*/
 135
 136     field        : field_name data_type null(?)
 137                    {
 138                         $return = {
 139                             type           => 'field',
 140                             name           => $item{'field_name'},
 141                             data_type      => $item{'data_type'}{'type'},
 142                             size           => $item{'data_type'}{'size'},
 143                             null           => $item{'null'}[0],
 144 #                            default        => $item{'default_val'}[0],
 145 #                            is_auto_inc    => $item{'auto_inc'}[0],
 146 #                            is_primary_key => $item{'primary_key'}[0],
 147                        }
 148                    }
 149                 | <error>
 150
 151     index        : primary_key_index
 152                    | unique_index
 153                    | normal_index
 154
 155     table_name   : WORD '.' WORD
 156         { $return = $item[3] }
 157
 158     field_name   : WORD
 159
 160     index_name   : WORD
 161
 162     data_type    : WORD field_size(?)
 163         {
 164             $return = {
 165                 type => $item[1],
 166                 size => $item[2][0]
 167             }
 168         }
 169
 170     lock         : /lock/i /datarows/i
 171
 172     field_type   : WORD
 173
 174     field_size   : '(' num_range ')' { $item{'num_range'} }
 175
 176     num_range    : DIGITS ',' DIGITS
 177         { $return = $item[1].','.$item[3] }
 178                    | DIGITS
 179         { $return = $item[1] }
 180
 181
 182     create_table : /create/i /table/i
 183
 184     null         : /not/i /null/i
 185         { $return = 0 }
 186                    | /null/i
 187         { $return = 1 }
 188
 189     default_val  : /default/i /(?:')?[\w\d.-]*(?:')?/ { $item[2]=~s/'//g; $return=$item[2] }
 190
 191     auto_inc     : /auto_increment/i { 1 }
 192
 193     primary_key  : /primary/i /key/i { 1 }
 194
 195     primary_key_index : primary_key index_name(?) '(' field_name(s /,/) ')'
 196         {
 197             $return = {
 198                 name   => $item{'index_name'}[0],
 199                 type   => 'primary_key',
 200                 fields => $item[4],
 201             }
 202         }
 203
 204     normal_index      : key index_name(?) '(' field_name(s /,/) ')'
 205         {
 206             $return = {
 207                 name   => $item{'index_name'}[0],
 208                 type   => 'normal',
 209                 fields => $item[4],
 210             }
 211         }
 212
 213     unique_index      : /unique/i key index_name(?) '(' field_name(s /,/) ')'
 214         {
 215             $return = {
 216                 name   => $item{'index_name'}[0],
 217                 type   => 'unique',
 218                 fields => $item[5],
 219             }
 220         }
 221
 222     key          : /key/i
 223                    | /index/i
 224
 225     table_type   : /TYPE=/i /\w+/ { $item[2] }
 226
 227     WORD         : /[\w#]+/
 228
 229     DIGITS       : /\d+/
 230
 231     COMMA        : ','
 232
 233 };
 234
 235 1;
 236
 237 #-----------------------------------------------------
 238 # Every hero becomes a bore at last.
 239 # Ralph Waldo Emerson
 240 #-----------------------------------------------------
 241
 242 =pod
 243
 244 =head1 AUTHOR
 245
 246 Ken Y. Clark E<lt>kclark@cpan.orgE<gt>
 247
 248 =head1 SEE ALSO
 249
 250 perl(1).
 251
 252 =cut