Frey/DBIC/Designer.pm

package Frey::DBIC::Designer;
use Moose;

extends 'Frey';
with 'Frey::Web';
with 'Frey::Config';
with 'Frey::Storage';

has dbic_class => (
        is => 'rw',
        isa => 'Str',
        required => 1,
        default => 'Reblog::Schema',
);

has dsn => (
        is => 'rw',
        isa => 'Str',
        required => 1,
        default => 'DBI:mysql:database=reblog;host=127.0.0.1;port=13306',
);

has result_set => (
        is => 'rw',
        isa => 'Str',
        required => 1,
        default => 'Items',
);

has order_by => (
        is => 'rw',
        isa => 'Str',
        required => 1,
        default => 'insert_timestamp desc',
);

has page => (
        is => 'rw',
        isa => 'Int',
        required => 1,
        default => 1,
);

has remove_column => (
        is => 'rw',
        isa => 'Str',
);

sub as_markup {
        my ($self) = @_;

        my $dbic_class  = $self->dbic_class;
        my $dsn                 = $self->dsn;
        my $schema;

        my $code = qq{
                use $dbic_class ;
                \$schema = $dbic_class->connect("$dsn", '', '');
        };

        eval $code;
        die $@ if $@;

        $schema->storage->debug(1); # XXX dump storage generated SQL

        my $attrs;

        $attrs->{ $_ } = $self->$_ foreach ( grep { $self->$_ } ( qw/page order_by/ ) );
        warn "# attrs ", $self->dump( $attrs );

        my $rs = $schema->resultset( $self->result_set )
                ->published
                ->search( undef, $attrs )
                ;

        my $path = 'var/DBIC/' . $self->result_set . '.yaml';
        my @columns;
        {
                my $c = $self->load( $path );
                @columns = @$c if $c;
        }
        warn "# load $path columns ", $self->dump( @columns );
        @columns = $rs->first->columns unless @columns;

        @columns = grep { $_ ne $self->remove_column } @columns if $self->remove_column;

        warn "# columns ", $self->dump( @columns );
        $self->store( $path, [ @columns ] );

        my $rows;

        while ( my $feed = $rs->next ) {
#               my %row = $feed->get_columns;

                my $row;

                foreach my $name ( @columns ) {
                        my $v = $feed->$name;
                        $v = '<code>NULL</code>' if ! defined $v;
                        $row .= qq|<td title="$name">$v</td>|;
                }

                $rows .= qq|<tr>$row</tr>\n|;
        }

        my $total = $rs->pager->total_entries;

        sub form {
                my $column = shift || die;
                qq|
                <form>
                <input type="submit" value="-">
                <input type="hidden" name="remove_column" value="$column">
                </form>
                |
        }

        my $header = qq|<tr><th>| . join(qq|</th><th>|, map { $_ . form($_) } @columns) . qq|</th></tr>|;

        my $html = qq|
                Rows: <b>$total</b>
                <table>
                $header
                $rows
                </table>
        |;

        return $html;
}

=head1 SEE ALSO

DBIx::Master Class

L<http://www.shadowcat.co.uk/catalyst/-talks/yapc-na-2008/dbix-masterclass.xul> presentation

L<http://www.shadowcat.co.uk/archive/conference-video/yapc-eu-2008/dbic-masterclass/> video

=cut

1;
1	dpavlin	1024	package Frey::DBIC::Designer;
2			use Moose;
3
4			extends 'Frey';
5			with 'Frey::Web';
6			with 'Frey::Config';
7			with 'Frey::Storage';
8
9			has dbic_class => (
10			is => 'rw',
11			isa => 'Str',
12			required => 1,
13			default => 'Reblog::Schema',
14			);
15
16			has dsn => (
17			is => 'rw',
18			isa => 'Str',
19			required => 1,
20			default => 'DBI:mysql:database=reblog;host=127.0.0.1;port=13306',
21			);
22
23			has result_set => (
24			is => 'rw',
25			isa => 'Str',
26			required => 1,
27			default => 'Items',
28			);
29
30			has order_by => (
31			is => 'rw',
32			isa => 'Str',
33			required => 1,
34			default => 'insert_timestamp desc',
35			);
36
37			has page => (
38			is => 'rw',
39			isa => 'Int',
40			required => 1,
41			default => 1,
42			);
43
44			has remove_column => (
45			is => 'rw',
46			isa => 'Str',
47			);
48
49			sub as_markup {
50			my ($self) = @_;
51
52			my $dbic_class = $self->dbic_class;
53			my $dsn = $self->dsn;
54			my $schema;
55
56			my $code = qq{
57			use $dbic_class ;
58			\$schema = $dbic_class->connect("$dsn", '', '');
59			};
60
61			eval $code;
62			die $@ if $@;
63
64			$schema->storage->debug(1); # XXX dump storage generated SQL
65
66			my $attrs;
67
68			$attrs->{ $_ } = $self->$_ foreach ( grep { $self->$_ } ( qw/page order_by/ ) );
69			warn "# attrs ", $self->dump( $attrs );
70
71			my $rs = $schema->resultset( $self->result_set )
72			->published
73			->search( undef, $attrs )
74			;
75
76			my $path = 'var/DBIC/' . $self->result_set . '.yaml';
77			my @columns;
78			{
79			my $c = $self->load( $path );
80			@columns = @$c if $c;
81			}
82			warn "# load $path columns ", $self->dump( @columns );
83			@columns = $rs->first->columns unless @columns;
84
85			@columns = grep { $_ ne $self->remove_column } @columns if $self->remove_column;
86
87			warn "# columns ", $self->dump( @columns );
88			$self->store( $path, [ @columns ] );
89
90			my $rows;
91
92			while ( my $feed = $rs->next ) {
93			# my %row = $feed->get_columns;
94
95			my $row;
96
97			foreach my $name ( @columns ) {
98			my $v = $feed->$name;
99			$v = '<code>NULL</code>' if ! defined $v;
100			$row .= qq\|<td title="$name">$v</td>\|;
101			}
102
103			$rows .= qq\|<tr>$row</tr>\n\|;
104			}
105
106			my $total = $rs->pager->total_entries;
107
108			sub form {
109			my $column = shift \|\| die;
110			qq\|
111			<form>
112			<input type="submit" value="-">
113			<input type="hidden" name="remove_column" value="$column">
114			</form>
115			\|
116			}
117
118			my $header = qq\|<tr><th>\| . join(qq\|</th><th>\|, map { $_ . form($_) } @columns) . qq\|</th></tr>\|;
119
120			my $html = qq\|
121			Rows: <b>$total</b>
122			<table>
123			$header
124			$rows
125			</table>
126			\|;
127
128			return $html;
129			}
130
131			=head1 SEE ALSO
132
133			DBIx::Master Class
134
135			L<http://www.shadowcat.co.uk/catalyst/-talks/yapc-na-2008/dbix-masterclass.xul> presentation
136
137			L<http://www.shadowcat.co.uk/archive/conference-video/yapc-eu-2008/dbic-masterclass/> video
138
139			=cut
140
141			1;