/[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

Contents of /bin/pgsql2model.pl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 178 - (show annotations)
Mon Jun 16 19:11:55 2008 UTC (15 years, 9 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 #!/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