A3C/bin/pgsql2model.pl

#!/usr/bin/perl
use warnings;
use strict;

=head1 NAME

pgsql2model.pl - convert SQL query into Jifty model

=head1 DESCRIPTION

Create model from SQL query

  ./bin/pgsql2model.pl --model StrixSites --instance new --table site

With C<--debug> switch all output will go to C<STDOUT>
instead to files.

=cut

use lib 'lib';

use Jifty;
use Strix;
use File::Slurp;
use Data::Dump qw/dump/;
use Getopt::Long;

my ( $ModelName, $table, $instance, $debug ) = ( 'StrixSite', 'site', 'new' );

GetOptions(
        'model=s'               => \$ModelName,
        'instance=s'    => \$instance,
        'debug+'                => \$debug,
);

die "usage: $0 --model StrixSites --sql 'select * from site'\n" unless $ModelName;

my $model = qq/package A3C::Model::$ModelName;
use strict;
use warnings;

use Jifty::DBI::Schema;

use A3C::Record schema {

/;

my $methods;
my $create;
my $columns;

my $dbh = Strix->dbh( $instance );

sub model_columns {
        my $ModelName = shift;
        my $model;
        warn "Creating columns for model $ModelName\n";

        my $aliases = qq/\n=head1 $ModelName helper methods\n=cut\n\n/;

        sub entry {
                my ( $e, $add ) = @_;
                warn "# entry ",dump( $e, $add );
                my $name = delete($e->{name}) || die "no name?";

                if ( $columns->{$name} ) {
                        warn "WARNING: column $name found again, skipping...\n";
                        return '';
                }
                $columns->{$name}++;

                $aliases .= qq/sub $_ { \$_[0]->$name }\n/ foreach delete($e->{aliases});

                my $label = delete($e->{label}) || ucfirst($name);
                $label =~ s/_/ /g;

                my $out = qq/\tcolumn $name =>\n\t\tlabel is _('$label')/;

                foreach my $n ( keys %$e ) {
                        # filters
                        my $v = $e->{$n};
                        if ( ref($v) eq 'ARRAY' ) {
                                $out .= qq/,\n\t\t$n are / . dump($v);
                        } elsif ( $n eq 'mandatory' ) {
                                if ( $v ) {
                                        $out .= qq/,\n\t\tis $n/;
                                        $create->{$name} = $e->{type} =~ m/int/ ? 42 : $label;
                                }
                        } elsif ( $v =~ m/^\d+$/ ) {
                                $out .= qq/,\n\t\t$n is $v/;
                        } else {
                                $out .= qq/,\n\t\t$n is '$v'/;
                        }
                }

                $out .= qq/;\n\n/;
                return $out;
        }

        my $sth = $dbh->column_info ( undef, undef, $table, '%' );

        while ( my $row = $sth->fetchrow_hashref ) {
                warn "# column_info ",dump( $row );
                $model .= entry({
                        name => $row->{COLUMN_NAME},
                        type => $row->{TYPE_NAME},
                        mandatory => ! $row->{NULLABLE},
                });
        }

        $methods .= $aliases unless $aliases;

        return $model;
}

$model .= model_columns( $ModelName );

$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};

$model .= qq/

};

$methods

=head2 ACL

We use L<A3C::DefaultACL> for access control

=cut

use A3C::DefaultACL;

1;
/;

if ( $debug ) {
        print "##### ----- start of created model $ModelName\n\n$model\n\n#### ---- END of created model $ModelName\n";
} else {
        my $model_path = "lib/A3C/Model/$ModelName.pm";
        write_file( $model_path, $model );
        print "Created $model_path\n";
}

my $test = <<'__END_OF_TEST__';
#!/usr/bin/env perl
use warnings;
use strict;

=head1 DESCRIPTION

A basic test harness for the _ModelName_ model.

=cut

use Jifty::Test tests => 11;

# Make sure we can load the model
use_ok('A3C::Model::_ModelName_');

# Grab a system user
my $system_user = A3C::CurrentUser->superuser;
ok($system_user, "Found a system user");

# Try testing a create
my $o = A3C::Model::_ModelName_->new(current_user => $system_user);
my ($id) = $o->create(
_create_1_);
ok($id, "_ModelName_ create returned success");
ok($o->id, "New _ModelName_ has valid id set");
is($o->id, $id, "Create returned the right id");

# And another
$o->create(
_create_2_);
ok($o->id, "_ModelName_ create returned another value");
isnt($o->id, $id, "And it is different from the previous one");

# Searches in general
my $collection =  A3C::Model::_ModelName_Collection->new(current_user => $system_user);
$collection->unlimit;
is($collection->count, 2, "Finds two records");

# Searches in specific
$collection->limit(column => 'id', value => $o->id);
is($collection->count, 1, "Finds one record with specific id");

# Delete one of them
$o->delete;
$collection->redo_search;
is($collection->count, 0, "Deleted row is gone");

# And the other one is still there
$collection->unlimit;
is($collection->count, 1, "Still one left");
__END_OF_TEST__

$test =~ s/_ModelName_/$ModelName/gs;

foreach my $round ( 1 .. 2 ) {
        my $data;
        $data .= qq/\t\t'$_' => / . dump( $create->{$_} ) . qq/,\n/ foreach keys %$create;
        warn "$round data = $data\n" if $debug;
        $test =~ s/_create_${round}_/$data/gs;
}

if ( $debug ) {
        print "##### ----- template test\n$test\n";
} else {
        my $test_path = "t/00-model-$ModelName.t";
        write_file( $test_path, $test );
        print "Created $test_path\n";
        chmod 0755, $test_path;
}
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			}