/[A3C]/bin/pgsql2model.pl
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Annotation of /bin/pgsql2model.pl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 178 - (hide annotations)
Mon Jun 16 19:11:55 2008 UTC (11 years, 3 months ago) by dpavlin
File MIME type: text/plain
File size: 4675 byte(s)
Simple model creator from PostgreSQL schema

$dbh->column_info doesn't give me enough useful data, so I will
have to ask PostgreSQL directly
1 dpavlin 178 #!/usr/bin/perl
2     use warnings;
3     use strict;
4    
5     =head1 NAME
6    
7     pgsql2model.pl - convert SQL query into Jifty model
8    
9     =head1 DESCRIPTION
10    
11     Create model from SQL query
12    
13     ./bin/pgsql2model.pl --model StrixSites --instance new --table site
14    
15     With C<--debug> switch all output will go to C<STDOUT>
16     instead to files.
17    
18     =cut
19    
20     use lib 'lib';
21    
22     use Jifty;
23     use Strix;
24     use File::Slurp;
25     use Data::Dump qw/dump/;
26     use Getopt::Long;
27    
28     my ( $ModelName, $table, $instance, $debug ) = ( 'StrixSite', 'site', 'new' );
29    
30     GetOptions(
31     'model=s' => \$ModelName,
32     'instance=s' => \$instance,
33     'debug+' => \$debug,
34     );
35    
36     die "usage: $0 --model StrixSites --sql 'select * from site'\n" unless $ModelName;
37    
38     my $model = qq/package A3C::Model::$ModelName;
39     use strict;
40     use warnings;
41    
42     use Jifty::DBI::Schema;
43    
44     use A3C::Record schema {
45    
46     /;
47    
48     my $methods;
49     my $create;
50     my $columns;
51    
52     my $dbh = Strix->dbh( $instance );
53    
54     sub model_columns {
55     my $ModelName = shift;
56     my $model;
57     warn "Creating columns for model $ModelName\n";
58    
59     my $aliases = qq/\n=head1 $ModelName helper methods\n=cut\n\n/;
60    
61     sub entry {
62     my ( $e, $add ) = @_;
63     warn "# entry ",dump( $e, $add );
64     my $name = delete($e->{name}) || die "no name?";
65    
66     if ( $columns->{$name} ) {
67     warn "WARNING: column $name found again, skipping...\n";
68     return '';
69     }
70     $columns->{$name}++;
71    
72     $aliases .= qq/sub $_ { \$_[0]->$name }\n/ foreach delete($e->{aliases});
73    
74     my $label = delete($e->{label}) || ucfirst($name);
75     $label =~ s/_/ /g;
76    
77     my $out = qq/\tcolumn $name =>\n\t\tlabel is _('$label')/;
78    
79     foreach my $n ( keys %$e ) {
80     # filters
81     my $v = $e->{$n};
82     if ( ref($v) eq 'ARRAY' ) {
83     $out .= qq/,\n\t\t$n are / . dump($v);
84     } elsif ( $n eq 'mandatory' ) {
85     if ( $v ) {
86     $out .= qq/,\n\t\tis $n/;
87     $create->{$name} = $e->{type} =~ m/int/ ? 42 : $label;
88     }
89     } elsif ( $v =~ m/^\d+$/ ) {
90     $out .= qq/,\n\t\t$n is $v/;
91     } else {
92     $out .= qq/,\n\t\t$n is '$v'/;
93     }
94     }
95    
96     $out .= qq/;\n\n/;
97     return $out;
98     }
99    
100     my $sth = $dbh->column_info ( undef, undef, $table, '%' );
101    
102     while ( my $row = $sth->fetchrow_hashref ) {
103     warn "# column_info ",dump( $row );
104     $model .= entry({
105     name => $row->{COLUMN_NAME},
106     type => $row->{TYPE_NAME},
107     mandatory => ! $row->{NULLABLE},
108     });
109     }
110    
111     $methods .= $aliases unless $aliases;
112    
113     return $model;
114     }
115    
116     $model .= model_columns( $ModelName );
117    
118     $methods .= qq/\n=head2 name\n\nAuto-generated human readable id for generic access to name\n\n=cut\n\nsub name { \$_[0]->id }\n/ unless $columns->{name};
119    
120     $model .= qq/
121    
122     };
123    
124     $methods
125    
126     =head2 ACL
127    
128     We use L<A3C::DefaultACL> for access control
129    
130     =cut
131    
132     use A3C::DefaultACL;
133    
134     1;
135     /;
136    
137     if ( $debug ) {
138     print "##### ----- start of created model $ModelName\n\n$model\n\n#### ---- END of created model $ModelName\n";
139     } else {
140     my $model_path = "lib/A3C/Model/$ModelName.pm";
141     write_file( $model_path, $model );
142     print "Created $model_path\n";
143     }
144    
145     my $test = <<'__END_OF_TEST__';
146     #!/usr/bin/env perl
147     use warnings;
148     use strict;
149    
150     =head1 DESCRIPTION
151    
152     A basic test harness for the _ModelName_ model.
153    
154     =cut
155    
156     use Jifty::Test tests => 11;
157    
158     # Make sure we can load the model
159     use_ok('A3C::Model::_ModelName_');
160    
161     # Grab a system user
162     my $system_user = A3C::CurrentUser->superuser;
163     ok($system_user, "Found a system user");
164    
165     # Try testing a create
166     my $o = A3C::Model::_ModelName_->new(current_user => $system_user);
167     my ($id) = $o->create(
168     _create_1_);
169     ok($id, "_ModelName_ create returned success");
170     ok($o->id, "New _ModelName_ has valid id set");
171     is($o->id, $id, "Create returned the right id");
172    
173     # And another
174     $o->create(
175     _create_2_);
176     ok($o->id, "_ModelName_ create returned another value");
177     isnt($o->id, $id, "And it is different from the previous one");
178    
179     # Searches in general
180     my $collection = A3C::Model::_ModelName_Collection->new(current_user => $system_user);
181     $collection->unlimit;
182     is($collection->count, 2, "Finds two records");
183    
184     # Searches in specific
185     $collection->limit(column => 'id', value => $o->id);
186     is($collection->count, 1, "Finds one record with specific id");
187    
188     # Delete one of them
189     $o->delete;
190     $collection->redo_search;
191     is($collection->count, 0, "Deleted row is gone");
192    
193     # And the other one is still there
194     $collection->unlimit;
195     is($collection->count, 1, "Still one left");
196     __END_OF_TEST__
197    
198     $test =~ s/_ModelName_/$ModelName/gs;
199    
200     foreach my $round ( 1 .. 2 ) {
201     my $data;
202     $data .= qq/\t\t'$_' => / . dump( $create->{$_} ) . qq/,\n/ foreach keys %$create;
203     warn "$round data = $data\n" if $debug;
204     $test =~ s/_create_${round}_/$data/gs;
205     }
206    
207     if ( $debug ) {
208     print "##### ----- template test\n$test\n";
209     } else {
210     my $test_path = "t/00-model-$ModelName.t";
211     write_file( $test_path, $test );
212     print "Created $test_path\n";
213     chmod 0755, $test_path;
214     }

Properties

Name Value
svn:executable *

  ViewVC Help
Powered by ViewVC 1.1.26