Frey/DBIC/Browser.pm

package Frey::DBIC::Browser;
use Moose;

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

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 => 'timestamp desc',
);

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

sub as_sponge {
        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 )
                ;
=for published
                ->search({
                        'userdata.label' => 'published',
                        'userdata.value_numeric' => 1,
                }, {
                        join => [ 'userdata' ],
                        %$attrs,
                })
                ;
=cut

        my @rows;
        my @name;
        my $name_pos;

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

                my @row;

                foreach my $name ( $feed->columns ) {
                        if ( ! defined $name_pos->{$name} ) {
                                push @name, $name;
                                $name_pos->{$name} = $#name;
                                warn "## name_pos: ", $self->dump( $name_pos ) if $self->debug;
                        }

                        my $pos = $name_pos->{$name};
                        $row[$pos] = $row{$name};
                }

                push @rows, [ @row ];
        }

        return {
                rows => \@rows,
                NAME => \@name,
                total_entries => $rs->pager->total_entries,
        }
}

=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

__PACKAGE__->meta->make_immutable;
no Moose;

1;
1	package Frey::DBIC::Browser;
2	use Moose;
3
4	extends 'Frey';
5	with 'Frey::Web', 'Frey::Config';
6
7	has dbic_class => (
8	is => 'rw',
9	isa => 'Str',
10	required => 1,
11	default => 'Reblog::Schema',
12	);
13
14	has dsn => (
15	is => 'rw',
16	isa => 'Str',
17	required => 1,
18	default => 'DBI:mysql:database=reblog;host=127.0.0.1;port=13306',
19	);
20
21	has result_set => (
22	is => 'rw',
23	isa => 'Str',
24	required => 1,
25	default => 'Items',
26	);
27
28	has order_by => (
29	is => 'rw',
30	isa => 'Str',
31	required => 1,
32	default => 'timestamp desc',
33	);
34
35	has page => (
36	is => 'rw',
37	isa => 'Int',
38	required => 1,
39	default => 1,
40	);
41
42	sub as_sponge {
43	my ($self) = @_;
44
45	my $dbic_class = $self->dbic_class;
46	my $dsn = $self->dsn;
47	my $schema;
48
49	my $code = qq{
50	use $dbic_class ;
51	\$schema = $dbic_class->connect("$dsn", '', '');
52	};
53
54	eval $code;
55	die $@ if $@;
56
57	$schema->storage->debug(1); # XXX dump storage generated SQL
58
59	my $attrs;
60
61	$attrs->{ $_ } = $self->$_ foreach ( grep { $self->$_ } ( qw/page order_by/ ) );
62	warn "# attrs ", $self->dump( $attrs );
63
64	my $rs = $schema->resultset( $self->result_set )
65	->published
66	->search( undef, $attrs )
67	;
68	=for published
69	->search({
70	'userdata.label' => 'published',
71	'userdata.value_numeric' => 1,
72	}, {
73	join => [ 'userdata' ],
74	%$attrs,
75	})
76	;
77	=cut
78
79	my @rows;
80	my @name;
81	my $name_pos;
82
83	while ( my $feed = $rs->next ) {
84	my %row = $feed->get_columns;
85
86	my @row;
87
88	foreach my $name ( $feed->columns ) {
89	if ( ! defined $name_pos->{$name} ) {
90	push @name, $name;
91	$name_pos->{$name} = $#name;
92	warn "## name_pos: ", $self->dump( $name_pos ) if $self->debug;
93	}
94
95	my $pos = $name_pos->{$name};
96	$row[$pos] = $row{$name};
97	}
98
99	push @rows, [ @row ];
100	}
101
102	return {
103	rows => \@rows,
104	NAME => \@name,
105	total_entries => $rs->pager->total_entries,
106	}
107	}
108
109	=head1 SEE ALSO
110
111	DBIx::Master Class
112
113	L<http://www.shadowcat.co.uk/catalyst/-talks/yapc-na-2008/dbix-masterclass.xul> presentation
114
115	L<http://www.shadowcat.co.uk/archive/conference-video/yapc-eu-2008/dbic-masterclass/> video
116
117	=cut
118
119	__PACKAGE__->meta->make_immutable;
120	no Moose;
121
122	1;