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 JiftyModelCreator;
use Strix;
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 $columns;
my $create;

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

JiftyModelCreator->write( $ModelName, $model, $create );

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	dpavlin	181	use JiftyModelCreator;
23	dpavlin	178	use Strix;
24			use Data::Dump qw/dump/;
25			use Getopt::Long;
26
27			my ( $ModelName, $table, $instance, $debug ) = ( 'StrixSite', 'site', 'new' );
28
29			GetOptions(
30			'model=s' => \$ModelName,
31			'instance=s' => \$instance,
32			'debug+' => \$debug,
33			);
34
35			die "usage: $0 --model StrixSites --sql 'select * from site'\n" unless $ModelName;
36
37			my $model = qq/package A3C::Model::$ModelName;
38			use strict;
39			use warnings;
40
41			use Jifty::DBI::Schema;
42
43			use A3C::Record schema {
44
45			/;
46
47			my $methods;
48	dpavlin	179	my $columns;
49	dpavlin	178	my $create;
50
51			my $dbh = Strix->dbh( $instance );
52
53			sub model_columns {
54			my $ModelName = shift;
55			my $model;
56			warn "Creating columns for model $ModelName\n";
57
58			my $aliases = qq/\n=head1 $ModelName helper methods\n=cut\n\n/;
59
60			sub entry {
61			my ( $e, $add ) = @_;
62			warn "# entry ",dump( $e, $add );
63			my $name = delete($e->{name}) \|\| die "no name?";
64
65			if ( $columns->{$name} ) {
66			warn "WARNING: column $name found again, skipping...\n";
67			return '';
68			}
69			$columns->{$name}++;
70
71			$aliases .= qq/sub $_ { \$_[0]->$name }\n/ foreach delete($e->{aliases});
72
73			my $label = delete($e->{label}) \|\| ucfirst($name);
74			$label =~ s/_/ /g;
75
76			my $out = qq/\tcolumn $name =>\n\t\tlabel is _('$label')/;
77
78			foreach my $n ( keys %$e ) {
79			# filters
80			my $v = $e->{$n};
81			if ( ref($v) eq 'ARRAY' ) {
82			$out .= qq/,\n\t\t$n are / . dump($v);
83			} elsif ( $n eq 'mandatory' ) {
84			if ( $v ) {
85			$out .= qq/,\n\t\tis $n/;
86			$create->{$name} = $e->{type} =~ m/int/ ? 42 : $label;
87			}
88			} elsif ( $v =~ m/^\d+$/ ) {
89			$out .= qq/,\n\t\t$n is $v/;
90			} else {
91			$out .= qq/,\n\t\t$n is '$v'/;
92			}
93			}
94
95			$out .= qq/;\n\n/;
96			return $out;
97			}
98
99			my $sth = $dbh->column_info ( undef, undef, $table, '%' );
100
101			while ( my $row = $sth->fetchrow_hashref ) {
102			warn "# column_info ",dump( $row );
103			$model .= entry({
104			name => $row->{COLUMN_NAME},
105			type => $row->{TYPE_NAME},
106			mandatory => ! $row->{NULLABLE},
107			});
108			}
109
110			$methods .= $aliases unless $aliases;
111
112			return $model;
113			}
114
115			$model .= model_columns( $ModelName );
116
117			$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};
118
119			$model .= qq/
120
121			};
122
123			$methods
124
125			=head2 ACL
126
127			We use L<A3C::DefaultACL> for access control
128
129			=cut
130
131			use A3C::DefaultACL;
132
133			1;
134			/;
135
136	dpavlin	179	JiftyModelCreator->write( $ModelName, $model, $create );
137	dpavlin	178