File Coverage

blib/lib/CatalystX/CRUD/Results.pm
Criterion Covered Total %
statement 20 48 41.6
branch 2 12 16.6
condition 0 3 0.0
subroutine 6 8 75.0
pod 3 3 100.0
total 31 74 41.8


line stmt bran cond sub pod time code
1             package CatalystX::CRUD::Results;
2 6     6   45 use Moose;
  6         15  
  6         48  
3             with 'MooseX::Emulate::Class::Accessor::Fast';
4 6     6   40066 use Carp;
  6         16  
  6         416  
5 6     6   638 use Data::Dump qw( dump );
  6         5776  
  6         294  
6 6     6   34 use MRO::Compat;
  6         23  
  6         195  
7 6     6   54 use mro 'c3';
  6         40  
  6         76  
8              
9             #use overload
10             # '""' => sub { return dump( $_[0]->serialize ) . "" },
11             # 'bool' => sub {1},
12             # fallback => 1;
13              
14             __PACKAGE__->mk_ro_accessors(qw( count pager query results ));
15              
16             our $VERSION = '0.58';
17              
18             =head1 NAME
19              
20             CatalystX::CRUD::Results - search results class
21              
22             =head1 SYNOPSIS
23              
24             # in .tt file
25             Your search returned [% results.count %] total hits.
26             Your query was [% results.query %].
27             You are on page [% results.pager.current_page %].
28             [% FOREACH r IN results.results %]
29             [% loop.count %]: [% r.name %]
30             [% END %]
31              
32             =head1 DESCRIPTION
33              
34             CatalystX::CRUD::Results is a class for search results from a
35             CatalystX::CRUD::Controller. See the do_search() method
36             in CatalystX::CRUD::Controller.
37              
38             =head1 METHODS
39              
40             The following read-only accessors are available:
41              
42             =head2 count
43              
44             Returns total number of results.
45              
46             =head2 pager
47              
48             Returns Data::Pageset object for paging through results.
49              
50             =head2 query
51              
52             Returns the search query.
53              
54             =head2 results
55              
56             Returns array ref of current found objects.
57              
58             =cut
59              
60             =head2 next
61              
62             Returns next result. If results() is an arrayref, shift() is used.
63             Otherwise, the results() value is assumed to act like a
64             CatalystX::CRUD::Iterator and its next() method will be called.
65              
66             =cut
67              
68             sub next {
69 10     10 1 906 my $self = shift;
70 10 50       49 return unless defined $self->results;
71              
72 10 50       64 if ( ref( $self->results ) eq 'ARRAY' ) {
73 10         57 return shift @{ $self->{results} };
  10         48  
74             }
75             else {
76 0           return $self->results->next;
77             }
78             }
79              
80             =head2 TO_JSON
81              
82             Hook for the L<JSON> module so that you can pass a Results object
83             directly to encode_json(). Calls serialize() internally.
84              
85             =cut
86              
87             sub TO_JSON {
88 0     0 1   my $self = shift;
89 0           return $self->serialize();
90             }
91              
92             =head2 serialize
93              
94             Returns object as a hash ref. Objects are overloaded to call
95             Data::Dump::dump( $results->serialize ) in string context.
96              
97             =cut
98              
99             sub serialize {
100 0     0 1   my $self = shift;
101              
102             #dump $self;
103 0           my $r = { count => $self->count };
104              
105             # what might query be?
106 0           my $q = $self->query;
107 0 0         if ( blessed($q) ) {
    0          
108 0           $r->{query} = "$q";
109             }
110             elsif ( ref $q eq 'CODE' ) {
111 0           $r->{query} = $q->();
112             }
113             else {
114             # stringify the Query object, overwrite 'query'.
115             # we do this because some internal objects do not serialize.
116 0           delete $q->{query};
117 0           $q->{where} = delete $q->{query_obj};
118 0           $q->{where} .= '';
119 0           $r->{query} = $q;
120             }
121              
122 0           my @results;
123 0 0         if ( ref( $self->results ) eq 'ARRAY' ) {
124 0           @results = @{ $self->{results} };
  0            
125             }
126             else {
127 0           while ( my $i = $self->results->next ) {
128 0           push @results, $i;
129             }
130             }
131              
132             # serialize results
133 0           my @serialized;
134 0           for my $i (@results) {
135 0           my $s;
136 0 0 0       if ( blessed($i) and $i->can('serialize') ) {
137 0           $s = $i->serialize;
138             }
139             else {
140 0           $s = "$i";
141             }
142 0           push @serialized, $s;
143             }
144 0           $r->{results} = \@serialized;
145              
146 0           return $r;
147             }
148              
149             1;
150              
151             __END__
152              
153              
154             =head1 AUTHOR
155              
156             Peter Karman, C<< <perl at peknet.com> >>
157              
158             =head1 BUGS
159              
160             Please report any bugs or feature requests to
161             C<bug-catalystx-crud at rt.cpan.org>, or through the web interface at
162             L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=CatalystX-CRUD>.
163             I will be notified, and then you'll automatically be notified of progress on
164             your bug as I make changes.
165              
166             =head1 SUPPORT
167              
168             You can find documentation for this module with the perldoc command.
169              
170             perldoc CatalystX::CRUD
171              
172             You can also look for information at:
173              
174             =over 4
175              
176             =item * Mailing List
177              
178             L<https://groups.google.com/forum/#!forum/catalystxcrud>
179              
180             =item * AnnoCPAN: Annotated CPAN documentation
181              
182             L<http://annocpan.org/dist/CatalystX-CRUD>
183              
184             =item * CPAN Ratings
185              
186             L<http://cpanratings.perl.org/d/CatalystX-CRUD>
187              
188             =item * RT: CPAN's request tracker
189              
190             L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=CatalystX-CRUD>
191              
192             =item * Search CPAN
193              
194             L<http://search.cpan.org/dist/CatalystX-CRUD>
195              
196             =back
197              
198             =head1 ACKNOWLEDGEMENTS
199              
200             =head1 COPYRIGHT & LICENSE
201              
202             Copyright 2008 Peter Karman, all rights reserved.
203              
204             This program is free software; you can redistribute it and/or modify it
205             under the same terms as Perl itself.
206              
207             =cut