lib/SQL/Translator/Parser/Sybase.pm

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