initial checkin of module files for proper perl installation
[freeside.git] / bin / dbdef-create
1 #!/usr/bin/perl -Tw
2 #
3 # $Id: dbdef-create,v 1.2 1998-11-19 11:17:44 ivan Exp $
4 #
5 # create dbdef file for existing mySQL database (needs SHOW|DESCRIBE command
6 # not in Pg) based on fs-setup
7 #
8 # ivan@sisd.com 98-jun-2
9 #
10 # $Log: dbdef-create,v $
11 # Revision 1.2  1998-11-19 11:17:44  ivan
12 # adminsuidsetup requires argument
13 #
14
15 use strict;
16 use DBI;
17 use FS::dbdef;
18 use FS::UID qw(adminsuidsetup datasrc);
19
20 my $user = shift or die &usage;
21
22 my($dbh)=adminsuidsetup $user;
23
24 #needs to match FS::Record
25 my($dbdef_file) = "/usr/local/etc/freeside/dbdef.". datasrc;
26
27 my($tables_sth)=$dbh->prepare("SHOW TABLES");
28 my($tables_rv)=$tables_sth->execute;
29
30 my(@tables);
31 foreach ( @{$tables_sth->fetchall_arrayref} ) {
32   my($table)=${$_}[0]; 
33   #print "TABLE\t$table\n";
34
35   my($index_sth)=$dbh->prepare("SHOW INDEX FROM $table");
36   my($primary_key)='';
37   my(%index,%unique);
38   for ( 1 .. $index_sth->execute ) {
39     my($row)=$index_sth->fetchrow_hashref;
40     if ( ${$row}{'Key_name'} eq "PRIMARY" ) {
41       $primary_key=${$row}{'Column_name'};
42       next;
43     }
44     if ( ${$row}{'Non_unique'} ) { #index
45       push @{$index{${$row}{'Key_name'}}}, ${$row}{'Column_name'};
46     } else { #unique
47       push @{$unique{${$row}{'Key_name'}}}, ${$row}{'Column_name'};
48     }
49   }
50
51   my(@index)=values %index;
52   my(@unique)=values %unique;
53   #print "\tPRIMARY KEY $primary_key\n";
54   foreach (@index) {
55     #print "\tINDEX\t", join(', ', @{$_}), "\n";
56   }
57   foreach (@unique) {
58     #print "\tUNIQUE\t", join(', ', @{$_}), "\n";
59   }
60
61   my($columns_sth)=$dbh->prepare("SHOW COLUMNS FROM $table");
62   my(@columns);
63   for ( 1 .. $columns_sth->execute ) {
64     my($row)=$columns_sth->fetchrow_hashref;
65     #print "\t", ${$row}{'Field'}, "\n";
66     ${$row}{'Type'} =~ /^(\w+)\(?([\d\,]+)?\)?( unsigned)?$/
67       or die "Illegal type ${$row}{'Type'}\n";
68     my($type,$length)=($1,$2);
69     my($null)=${$row}{'Null'};
70     $null =~ s/YES/NULL/;
71     push @columns, new FS::dbdef_column (
72       ${$row}{'Field'},
73       $type,
74       $null,
75       $length,
76     );
77   }
78
79   #print "\n";
80   push @tables, new FS::dbdef_table (
81     $table,
82     $primary_key,
83     new FS::dbdef_unique (\@unique),
84     new FS::dbdef_index (\@index),
85     @columns,
86   );
87
88 }
89
90 my($dbdef) = new FS::dbdef ( @tables );
91
92 #important
93 $dbdef->save($dbdef_file);
94
95 sub usage {
96   die "Usage:\n  dbdef-create user\n";
97 }