Frey/DBIC/Browser.pm

package Frey::DBIC::Browser;
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 => '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

1;
1	dpavlin	1014	package Frey::DBIC::Browser;
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	dpavlin	1019	required => 1,
13	dpavlin	1020	default => 'Reblog::Schema',
14	dpavlin	1014	);
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	dpavlin	1020	has result_set => (
24	dpavlin	1015	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 => 'timestamp desc',
35			);
36
37	dpavlin	1014	has page => (
38			is => 'rw',
39			isa => 'Int',
40			required => 1,
41			default => 1,
42			);
43
44			sub as_sponge {
45			my ($self) = @_;
46
47			my $dbic_class = $self->dbic_class;
48			my $dsn = $self->dsn;
49			my $schema;
50
51			my $code = qq{
52			use $dbic_class ;
53			\$schema = $dbic_class->connect("$dsn", '', '');
54			};
55
56			eval $code;
57			die $@ if $@;
58
59	dpavlin	1015	$schema->storage->debug(1); # XXX dump storage generated SQL
60	dpavlin	1014
61	dpavlin	1015	my $attrs;
62	dpavlin	1014
63	dpavlin	1015	$attrs->{ $_ } = $self->$_ foreach ( grep { $self->$_ } ( qw/page order_by/ ) );
64			warn "# attrs ", $self->dump( $attrs );
65
66	dpavlin	1020	my $rs = $schema->resultset( $self->result_set )
67			->published
68			->search( undef, $attrs )
69			;
70			=for published
71	dpavlin	1015	->search({
72			'userdata.label' => 'published',
73			'userdata.value_numeric' => 1,
74			}, {
75			join => [ 'userdata' ],
76	dpavlin	1020	%$attrs,
77	dpavlin	1015	})
78			;
79	dpavlin	1020	=cut
80	dpavlin	1015
81	dpavlin	1014	my @rows;
82			my @name;
83			my $name_pos;
84
85	dpavlin	1015	while ( my $feed = $rs->next ) {
86	dpavlin	1014	my %row = $feed->get_columns;
87
88			my @row;
89
90			foreach my $name ( $feed->columns ) {
91			if ( ! defined $name_pos->{$name} ) {
92			push @name, $name;
93			$name_pos->{$name} = $#name;
94			warn "## name_pos: ", $self->dump( $name_pos ) if $self->debug;
95			}
96
97			my $pos = $name_pos->{$name};
98			$row[$pos] = $row{$name};
99			}
100
101			push @rows, [ @row ];
102			}
103
104			return {
105			rows => \@rows,
106			NAME => \@name,
107	dpavlin	1015	total_entries => $rs->pager->total_entries,
108	dpavlin	1014	}
109			}
110
111	dpavlin	1020	=head1 SEE ALSO
112
113			DBIx::Master Class
114
115			L<http://www.shadowcat.co.uk/catalyst/-talks/yapc-na-2008/dbix-masterclass.xul> presentation
116
117			L<http://www.shadowcat.co.uk/archive/conference-video/yapc-eu-2008/dbic-masterclass/> video
118
119			=cut
120
121	dpavlin	1014	1;