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__ |