File Coverage

blib/lib/Rubric/WebApp/Entries.pm
Criterion Covered Total %
statement 70 94 74.4
branch 15 38 39.4
condition 3 6 50.0
subroutine 15 23 65.2
pod 13 13 100.0
total 116 174 66.6


line stmt bran cond sub pod time code
1 2     2   1743 use strict;
  2         4  
  2         63  
2 2     2   11 use warnings;
  2         5  
  2         130  
3             package Rubric::WebApp::Entries;
4             # ABSTRACT: process the /entries run method
5             $Rubric::WebApp::Entries::VERSION = '0.156';
6             #pod =head1 DESCRIPTION
7             #pod
8             #pod Rubric::WebApp::Entries implements a URI parser that builds a query based
9             #pod on a query URI, passes it to Rubric::Entries, and returns the rendered report
10             #pod on the results.
11             #pod
12             #pod =cut
13              
14 2     2   985 use Date::Span 1.12;
  2         863  
  2         138  
15 2     2   11 use Digest::MD5 qw(md5_hex);
  2         6  
  2         76  
16              
17 2     2   17 use Rubric::Config;
  2         4  
  2         33  
18 2     2   10 use Rubric::Entry;
  2         3  
  2         93  
19 2     2   80 use Rubric::Renderer;
  2         5  
  2         67  
20 2     2   10 use Rubric::WebApp::URI;
  2         5  
  2         2047  
21              
22             #pod =head1 METHODS
23             #pod
24             #pod =head2 entries($webapp)
25             #pod
26             #pod This method is called by Rubric::WebApp. It returns the rendered template for
27             #pod return to the user's browser.
28             #pod
29             #pod =cut
30              
31             sub entries {
32 30     30 1 70 my ($self, $webapp) = @_;
33 30         62 my %arg;
34              
35 30         131 while (my $param = $webapp->next_path_part) {
36 22         415 my $value = $webapp->next_path_part;
37 22         378 $arg{$param} = $self->get_arg($param, $value);
38             }
39 30 50       550 if (my $uri = $webapp->query->param('uri')) {
40 0 0       0 $arg{urimd5} = md5_hex($uri) unless $arg{urimd5};
41             }
42              
43 30         784 for (qw(like desc_like body_like)) {
44 90 50       1457 if (my $param = $webapp->query->param($_)) {
45 0         0 $arg{$_} = $self->get_arg($_, $param);
46             }
47             }
48              
49 30 100       726 unless (%arg) {
50 9         114 $webapp->param(recent_tags => Rubric::Entry->recent_tags_counted);
51 9 50       228 $arg{first_only} = 1 unless %arg;
52             }
53              
54 30         115 my $user = $webapp->param('current_user');
55 30         481 my $order_by = $webapp->query->param('order_by');
56              
57 30         919 my $entries = Rubric::Entry->query(\%arg,
58             { user => $user, order_by => $order_by });
59 30         22231 $webapp->param(query_description => $self->describe_query(\%arg));
60              
61 30         750 $webapp->page_entries($entries)->render_entries(\%arg);
62             }
63              
64             #pod =head2 describe_query(\%arg)
65             #pod
66             #pod returns a human-readable description of the query described by C<%args>
67             #pod
68             #pod =cut
69              
70             sub describe_query {
71 30     30 1 70 my ($self, $arg) = @_;
72 30         57 my $desc;
73 30 100       116 $desc .= "$arg->{user}'s " if $arg->{user};
74 30         1754 $desc .= "entries";
75 30         97 for (qw(body link)) {
76 60 50       208 if (defined $arg->{"has_$_"}) {
77 0 0       0 $desc .= " with" . ($arg->{"has_$_"} ? "" : "out") . " a $_,";
78             }
79             }
80 30 50 66     204 if ($arg->{exact_tags}) {
    100          
81 0 0       0 if (%{ $arg->{exact_tags} }) {
  0         0  
82             $desc .= " filed under { "
83             . join(', ',
84 0 0       0 map { defined $arg->{exact_tags}{$_}
85             ? "$_:$arg->{exact_tags}{$_}"
86             : $_ }
87 0         0 keys %{$arg->{exact_tags}}) . " } exactly";
  0         0  
88             } else {
89 0         0 $desc .= " without tags"
90             }
91 13         101 } elsif ($arg->{tags} and %{ $arg->{tags} }) {
92             $desc .= " filed under { "
93             . join(', ',
94 13 50       85 map { defined $arg->{tags}{$_} ? "$_:$arg->{tags}{$_}" : $_ }
95 13         26 keys %{$arg->{tags}}) . " }";
  13         46  
96             }
97 30         79 $desc =~ s/,\Z//;
98 30         128 return $desc;
99             }
100              
101             #pod =head2 get_arg($param => $value)
102             #pod
103             #pod Given a name/value pair from the path, this method will attempt to
104             #pod generate part of hash to send to << Rubric::Entry->query >>. To do this, it
105             #pod looks for and calls a method called "arg_for_NAME" where NAME is the passed
106             #pod value of C<$param>. If no clause can be generated, it returns undef.
107             #pod
108             #pod =cut
109              
110             sub get_arg {
111 22     22 1 79 my ($self, $param, $value) = @_;
112              
113 22 50       220 return unless my $code = $self->can("arg_for_$param");
114 22         118 $code->($self, $value);
115             }
116              
117             #pod =head2 arg_for_NAME
118             #pod
119             #pod Each of these functions returns the proper value to put in the hash passed to
120             #pod C<< Rubric::Entries->query >>. If given an invalid argument, they will return
121             #pod undef.
122             #pod
123             #pod =head3 arg_for_user($username)
124             #pod
125             #pod Given a username, this method returns the associated Rubric::User object.
126             #pod
127             #pod =cut
128              
129             sub arg_for_user {
130 8     8 1 23 my ($self, $user) = @_;
131 8 50       29 return unless $user;
132 8   33     82 return Rubric::User->retrieve($user) || ();
133             }
134              
135             #pod =head3 arg_for_tags($tagstring)
136             #pod
137             #pod =head3 arg_for_exact_tags($tagstring)
138             #pod
139             #pod Given "happy fuzzy bunnies" this returns C< [ qw(happy fuzzy bunnies) ] >
140             #pod
141             #pod =cut
142              
143             sub arg_for_tags {
144 13     13 1 33 my ($self, $tagstring) = @_;
145              
146 13         27 my $tags;
147 13         25 eval { $tags = Rubric::Entry->tags_from_string($tagstring) };
  13         149  
148 13         6517 return $tags;
149             }
150              
151 0     0 1 0 sub arg_for_exact_tags { (shift)->arg_for_tags(@_) }
152              
153             #pod =head3 arg_for_desc_like
154             #pod
155             #pod =cut
156              
157             sub arg_for_desc_like {
158 0     0 1 0 my ($self, $value) = @_;
159 0         0 return $value;
160             }
161              
162             #pod =head3 arg_for_body_like
163             #pod
164             #pod =cut
165              
166             sub arg_for_body_like {
167 0     0 1 0 my ($self, $value) = @_;
168 0         0 return $value;
169             }
170              
171             #pod =head3 arg_for_like
172             #pod
173             #pod =cut
174              
175             sub arg_for_like {
176 0     0 1 0 my ($self, $value) = @_;
177 0         0 return $value;
178             }
179              
180             #pod =head3 arg_for_has_body($bool)
181             #pod
182             #pod Returns the given boolean as 0 or 1.
183             #pod
184             #pod =cut
185              
186             sub arg_for_has_body {
187 0     0 1 0 my ($self, $bool) = @_;
188 0 0       0 return $bool ? 1 : 0;
189             }
190              
191             #pod =head3 arg_for_has_link($bool)
192             #pod
193             #pod Returns the given boolean as 0 or 1.
194             #pod
195             #pod =cut
196              
197             sub arg_for_has_link {
198 0     0 1 0 my ($self, $bool) = @_;
199 0 0       0 return $bool ? 1 : 0;
200             }
201              
202             #pod =head3 arg_for_first_only($bool)
203             #pod
204             #pod Returns the given boolean as 0 or 1.
205             #pod
206             #pod =cut
207              
208             sub arg_for_first_only {
209 0     0 1 0 my ($self, $bool) = @_;
210 0 0       0 return $bool ? 1 : 0;
211             }
212              
213             #pod =head3 arg_for_urimd5($md5sum)
214             #pod
215             #pod This method returns the passed value, if that value is a valid 32-character
216             #pod md5sum.
217             #pod
218             #pod =cut
219              
220             sub arg_for_urimd5 {
221 1     1 1 4 my ($self, $md5) = @_;
222 1 50       8 return unless $md5 =~ /\A[a-z0-9]{32}\Z/i;
223 1         6 return $md5;
224             }
225              
226             #pod =head3 arg_for_{timefield}_{preposition}($datetime)
227             #pod
228             #pod These methods correspond to those described in L.
229             #pod
230             #pod They return the passed string unchanged.
231             #pod
232             #pod =cut
233              
234             ## more date-arg handling code
235             {
236             ## no critic (ProhibitNoStrict)
237 2     2   18 no strict 'refs';
  2         3  
  2         225  
238             for my $field (qw(created modified)) {
239             for my $prep (qw(after before on)) {
240             *{"arg_for_${field}_${prep}"} = sub {
241 0     0     my ($self, $datetime) = @_;
242 0           return $datetime;
243             }
244             }
245             }
246             }
247              
248             1;
249              
250             __END__