moved qdb here because matt is lazy
[public/www-new.git] / pub / qdb / src / modules / Chirpy / UI / WebApp.pm
1 ###############################################################################\r
2 # Chirpy! 0.3, a quote management system                                      #\r
3 # Copyright (C) 2005-2007 Tim De Pauw <ceetee@users.sourceforge.net>          #\r
4 ###############################################################################\r
5 # This program is free software; you can redistribute it and/or modify it     #\r
6 # under the terms of the GNU General Public License as published by the Free  #\r
7 # Software Foundation; either version 2 of the License, or (at your option)   #\r
8 # any later version.                                                          #\r
9 #                                                                             #\r
10 # This program is distributed in the hope that it will be useful, but WITHOUT #\r
11 # ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or       #\r
12 # FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for   #\r
13 # more details.                                                               #\r
14 #                                                                             #\r
15 # You should have received a copy of the GNU General Public License along     #\r
16 # with this program; if not, write to the Free Software Foundation, Inc., 51  #\r
17 # Franklin St, Fifth Floor, Boston, MA  02110-1301  USA                       #\r
18 ###############################################################################\r
19 \r
20 ###############################################################################\r
21 # $Id:: WebApp.pm 307 2007-02-09 01:16:00Z ceetee                           $ #\r
22 ###############################################################################\r
23 \r
24 =head1 NAME\r
25 \r
26 Chirpy::UI::WebApp - User interface class to use Chirpy! as a Web application\r
27 \r
28 =head1 REQUIREMENTS\r
29 \r
30 Apart from a proper Chirpy! installation, this module requires the following\r
31 Perl modules:\r
32  \r
33  HTML::Template\r
34  HTTP::Date\r
35  URI::Escape\r
36 \r
37 Optionally, for on-the-fly gzip compression, L<Compress::Zlib> is required. If\r
38 you wish to use captchas, you will need either L<Authen::Captcha> or\r
39 L<GD::SecurityImage>.\r
40 \r
41 =head1 CONFIGURATION\r
42 \r
43 This module uses the following values from your configuration file:\r
44 \r
45 =over 4\r
46 \r
47 =item webapp.webmaster_name\r
48 \r
49 The name of the site's webmaster.\r
50 \r
51 =item webapp.webmaster_email\r
52 \r
53 The e-mail address of the site's webmaster.\r
54 \r
55 =item webapp.site_url\r
56 \r
57 The base URL of the web site, i.e. the path to F<index.cgi>, without the\r
58 trailing forward slash.\r
59 \r
60 =item webapp.resources_url\r
61 \r
62 The base URL of the path where resources, i.e. publicly available files used\r
63 by the output pages, are stored, again without the trailing forward slash.\r
64 \r
65 =item webapp.theme\r
66 \r
67 The identifier of the theme to use.\r
68 \r
69 =item webapp.welcome_text_file\r
70 \r
71 The name of the file that contains the welcome message to display on the home\r
72 page. Use a path name relative to the base path defined in the C<general>\r
73 section.\r
74 \r
75 =item webapp.cookie_domain\r
76 \r
77 =item webapp.cookie_path\r
78 \r
79 When cookies are set, these two values are used to limit them to the correct\r
80 domain name and path. For example, if your QDB is located at\r
81 I<http://www.mysite.com/myname/qdb>, you would enter C<mysite.com> and\r
82 C</myname/qdb>.\r
83 \r
84 =item webapp.session_expiry\r
85 \r
86 To keep track of users' actions, sessions are used. These are kept around for\r
87 a while if the user is inactive. This value sets how long they should be saved.\r
88 You can use a number for the expiry time in seconds, or use a number directly\r
89 followed by one of these suffixes to indicate time units:\r
90 \r
91  m: minutes\r
92  h: hours\r
93  d: days\r
94  M: months\r
95  y: years\r
96 \r
97 This format was borrowed from L<CGI.pm|CGI>.\r
98 \r
99 =item webapp.enable_short_urls\r
100 \r
101 If you run Chirpy! on an Apache web server that has the C<mod_rewrite> module\r
102 installed, you can set this value to 1 to make URLs short, pretty and easy to\r
103 remember.\r
104 \r
105 =item webapp.enable_feeds\r
106 \r
107 Set this value to 1 to enable the RSS and Atom feeds the module offers.\r
108 \r
109 =item webapp.enable_gzip\r
110 \r
111 Apply gzip compression on output if possible.\r
112 \r
113 =item webapp.captcha_provider\r
114 \r
115 The captcha provider to use. Either C<Authen_Captcha> or C<GD_SecurityImage>,\r
116 depending on which of the corresponding modules are available. Note that captcha\r
117 providers may offer additional configuration; see\r
118 L<Chirpy::UI::WebApp::Captcha::Authen_Captcha> and\r
119 L<Chirpy::UI::WebApp::Captcha::GD_SecurityImage>. If this parameter is not set,\r
120 captchas will be disabled.\r
121 \r
122 =item webapp.captcha_path\r
123 \r
124 The physical path to the directory where public captcha data is to be stored.\r
125 \r
126 =item webapp.captcha_url\r
127 \r
128 The URL to the captcha path.\r
129 \r
130 =item webapp.captcha_expiry_time\r
131 \r
132 The number of seconds between the moment when the captcha was generated and the\r
133 moment when its code expires.\r
134 \r
135 =item webapp.enable_autolink\r
136 \r
137 Automatically turn hyperlinks and e-mail addresses in quotes into hyperlinks.\r
138 \r
139 =back\r
140 \r
141 =head1 LOCALE STRINGS\r
142 \r
143 This module uses the following strings from your locale. Please make sure they\r
144 are present before using the module.\r
145 \r
146 =over 4\r
147 \r
148 =item webapp.start_page_description\r
149 \r
150 Brief description of what the start page does, for tooltips and such.\r
151 \r
152 =item webapp.start_page_short_title\r
153 \r
154 Abbreviated version of I<Start Page>, e.g. I<Home>, for use in compact menus.\r
155 \r
156 =item webapp.quote_link_description\r
157 \r
158 Brief description of what a link to the quote is for, for tooltips and such.\r
159 \r
160 =item webapp.next_page_title\r
161 \r
162 Translation of I<Next Page>, for multi-page quote lists.\r
163 \r
164 =item webapp.previous_page_title\r
165 \r
166 Translation of I<Previous Page>, for multi-page quote lists.\r
167 \r
168 =item webapp.current_page_title\r
169 \r
170 Translation of I<Current Page>, for a link to the current page in the event log\r
171 viewer.\r
172 \r
173 =item webapp.footer_text\r
174 \r
175 Text stating that the page was generated by Chirpy! and informing the user of\r
176 the number of milliseconds used to do so. C<%1%> is replaced with the Chirpy!\r
177 product name and version, linked to the Chirpy! web site, C<%2%> with the\r
178 number of milliseconds (without a unit).\r
179 \r
180 =item webapp.footer_text_no_time\r
181 \r
182 Text stating that the page was generated by Chirpy!. C<%1%> is replaced with\r
183 the string I<Chirpy!>, possibly with formatting.\r
184 \r
185 =item webapp.manage_quote_instructions\r
186 \r
187 Message explaining to the user that, if he would like to modify or remove\r
188 a quote, the links to do so are available from the quote list.\r
189 \r
190 =item webapp.remove_quote_without_viewing_confirmation\r
191 \r
192 Question confirming the removal of a quote by entering its ID and stressing\r
193 that this is not a recommended action.\r
194 \r
195 =item webapp.manage_news_instructions\r
196 \r
197 Message explaining to the user that, if he would like to modify or remove\r
198 a news item, the links to do so are available from the list of recent news\r
199 items on the start page.\r
200 \r
201 =item webapp.session_required\r
202 \r
203 Message explaining that the session information cookie that Chirpy! tried to\r
204 store was not accepted by the user's browser and suggesting that he try again\r
205 after reviewing his cookie settings.\r
206 \r
207 =item webapp.timed_out_text\r
208 \r
209 Error message explaining that the connection has timed out while attempting to\r
210 rate the quote, and asking the user to try again.\r
211 \r
212 =item webapp.captcha_code_label\r
213 \r
214 The label text for the field where the user fills in the captcha code.\r
215 \r
216 =item webapp.captcha_image_text\r
217 \r
218 The alternate text for the captcha image.\r
219 \r
220 =item webapp.minimum_tag_usage_count_title\r
221 \r
222 The title for the tag cloud's slider label, i.e. "Minimum Quotes" followed by a\r
223 colon.\r
224 \r
225 =item webapp.top_quote_prefix\r
226 \r
227 The prefix for the "Top Quote" microsummary, i.e. "Top Quote" followed by a\r
228 colon.\r
229 \r
230 =item webapp.bottom_quote_prefix\r
231 \r
232 The prefix for the "Bottom Quote" microsummary, i.e. "Bottom Quote" followed by\r
233 a colon.\r
234 \r
235 =item webapp.latest_quote_prefix\r
236 \r
237 The prefix for the "Latest Quote" microsummary, i.e. "Latest Quote" followed by\r
238 a colon.\r
239 \r
240 =item webapp.latest_unmoderated_quote_prefix\r
241 \r
242 The prefix for the "Latest Unmoderated Quote" microsummary, i.e. "Latest\r
243 Unmoderated Quote" followed by a colon.\r
244 \r
245 =back\r
246 \r
247 =head1 TODO\r
248 \r
249 Split into smaller modules, expose more methods, tons of optimizations.\r
250 \r
251 =head1 AUTHOR\r
252 \r
253 Tim De Pauw E<lt>ceetee@users.sourceforge.netE<gt>\r
254 \r
255 =head1 SEE ALSO\r
256 \r
257 L<Chirpy::UI::WebApp::Session>, L<Chirpy::UI>, L<Chirpy>,\r
258 L<http://chirpy.sourceforge.net/>\r
259 \r
260 =head1 COPYRIGHT\r
261 \r
262 Copyright 2005-2007 Tim De Pauw. All rights reserved.\r
263 \r
264 This program is free software; you can redistribute it and/or modify it under\r
265 the terms of the GNU General Public License as published by the Free Software\r
266 Foundation; either version 2 of the License, or (at your option) any later\r
267 version.\r
268 \r
269 This program is distributed in the hope that it will be useful, but WITHOUT ANY\r
270 WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A\r
271 PARTICULAR PURPOSE.  See the GNU General Public License for more details.\r
272 \r
273 =cut\r
274 \r
275 package Chirpy::UI::WebApp;\r
276 \r
277 use strict;\r
278 use warnings;\r
279 \r
280 use vars qw($VERSION $TARGET_VERSION @ISA);\r
281 \r
282 $VERSION = '0.3';\r
283 @ISA = qw(Chirpy::UI);\r
284 \r
285 $TARGET_VERSION = '0.3';\r
286 \r
287 use Chirpy 0.3;\r
288 use Chirpy::UI 0.3;\r
289 use Chirpy::UI::WebApp::Session 0.3;\r
290 use Chirpy::Util 0.3;\r
291 \r
292 use HTML::Template;\r
293 use CGI;\r
294 \r
295 use constant ACTIONS => {\r
296         'START_PAGE' => '',\r
297         'QUOTE_RATING_UP' => 'up',\r
298         'QUOTE_RATING_DOWN' => 'down',\r
299         'REPORT_QUOTE' => 'report',\r
300         'QUOTE_BROWSER' => 'browse',\r
301         'RANDOM_QUOTES' => 'random',\r
302         'TOP_QUOTES' => 'top',\r
303         'BOTTOM_QUOTES' => 'bottom',\r
304         'QUOTES_OF_THE_WEEK' => 'qotw',\r
305         'QUOTE_SEARCH' => 'search',\r
306         'TAG_CLOUD' => 'tags',\r
307         'STATISTICS' => 'statistics',\r
308         'MODERATION_QUEUE' => 'queue',\r
309         'SUBMIT_QUOTE' => 'submit',\r
310         'ADMINISTRATION' => 'admin',\r
311         'LOGIN' => 'login',\r
312         'LOGOUT' => 'logout'\r
313 };\r
314 \r
315 use constant ADMIN_ACTIONS => {\r
316         'CHANGE_PASSWORD' => 'password',\r
317         'MANAGE_UNAPPROVED_QUOTES' => 'quote_approve',\r
318         'MANAGE_FLAGGED_QUOTES' => 'quote_flags',\r
319         'EDIT_QUOTE' => 'quote_edit',\r
320         'REMOVE_QUOTE' => 'quote_remove',\r
321         'ADD_NEWS' => 'news_add',\r
322         'EDIT_NEWS' => 'news_edit',\r
323         'REMOVE_NEWS' => 'news_remove',\r
324         'ADD_ACCOUNT' => 'accounts',\r
325         'EDIT_ACCOUNT' => 'accounts',\r
326         'REMOVE_ACCOUNT' => 'accounts',\r
327         'VIEW_EVENT_LOG' => 'log'\r
328 };\r
329 \r
330 use constant STATUS_OK                     => 1;\r
331 use constant STATUS_ALREADY_RATED          => 2;\r
332 use constant STATUS_RATING_LIMIT_EXCEEDED  => 3;\r
333 use constant STATUS_QUOTE_NOT_FOUND        => 4;\r
334 use constant STATUS_SESSION_REQUIRED       => 5;\r
335 \r
336 sub new {\r
337         my $class = shift;\r
338         my $self = $class->SUPER::new(@_);\r
339         my $path = $self->_template_cache_path();\r
340         $self->{'templates_path'}\r
341                 = $self->configuration()->get('general', 'base_path')\r
342                         . '/templates/' . $self->param('theme');\r
343         $self->{'cgi'} = new CGI();\r
344         $self->{'cookies'} = [];\r
345         my $session = new Chirpy::UI::WebApp::Session($self);\r
346         if (defined $session) {\r
347                 $self->{'session'} = $session;\r
348                 $self->_set_cookie($Chirpy::UI::WebApp::Session::NAME,\r
349                         $session->id(), $self->param('session_expiry'));\r
350         }\r
351         return $self;\r
352 }\r
353 \r
354 sub get_target_version {\r
355         return $TARGET_VERSION;\r
356 }\r
357 \r
358 sub get_current_page {\r
359         my $self = shift;\r
360         return $self->{'page'} if (exists $self->{'page'});\r
361         my $action = $self->_action();\r
362         my $page;\r
363         if (defined $action && $action) {\r
364                 while (my ($n, $v) = each %{ACTIONS()}) {\r
365                         if ($v eq $action) {\r
366                                 $page = eval 'Chirpy::UI::' . $n;\r
367                                 last;\r
368                         }\r
369                 }\r
370         }\r
371         else {\r
372                 $page = ($self->_id()\r
373                         ? Chirpy::UI::SINGLE_QUOTE : Chirpy::UI::START_PAGE);\r
374         }\r
375         $page = Chirpy::UI::START_PAGE unless (defined $page);\r
376         $self->_provide_session_if_necessary($page);\r
377         # XXX: This is sort of hackish. What to do?\r
378         if (defined $self->_feed_type()) {\r
379                 my $quotes_per_feed = $self->param('quotes_per_feed');\r
380                 $quotes_per_feed = 50\r
381                         unless (defined $quotes_per_feed && $quotes_per_feed > 0);\r
382                 $self->parent()->quotes_per_page($quotes_per_feed);\r
383         }\r
384         elsif ($self->_wants_microsummary()\r
385         && $self->_page_offers_microsummary($page)) {\r
386                 $self->parent()->quotes_per_page(1);\r
387         }\r
388         $self->{'page'} = $page;\r
389         return $page;\r
390 }\r
391 \r
392 sub get_selected_quote_id {\r
393         my $self = shift;\r
394         return $self->_id();\r
395 }\r
396 \r
397 sub get_first_quote_index {\r
398         my $self = shift;\r
399         return $self->_cgi_param('start') || 0;\r
400 }\r
401 \r
402 sub get_search_instruction {\r
403         my $self = shift;\r
404         my $query = $self->_cgi_param('query');\r
405         return ([], []) unless (defined $query);\r
406         my @queries = ();\r
407         my @tags = ();\r
408         while ($query =~ /"(.*?)"|(\S+)|"([^"]+)$/g) {\r
409                 my $literal = defined $1 ? $1 : $3;\r
410                 if (defined $literal) {\r
411                         push @queries, '*' . $literal . '*';\r
412                 }\r
413                 else {\r
414                         my $word = $2;\r
415                         if ($word =~ s/^tag://i) {\r
416                                 push @tags, $word;\r
417                         }\r
418                         else {\r
419                                 push @queries, '*' . $word . '*';\r
420                         }\r
421                 }\r
422         }\r
423         return (\@queries, \@tags);\r
424 }\r
425 \r
426 sub get_submitted_quote {\r
427         my $self = shift;\r
428         if ($self->_requires_captcha()) {\r
429                 my $code = $self->_cgi_param('captcha_code');\r
430                 my $hash = $self->_cgi_param('captcha_hash');\r
431                 return undef unless (defined $code && defined $hash\r
432                         && $self->_captcha_provider($hash)->verify($code));\r
433         }\r
434         return ($self->_cgi_param('quote'),\r
435                 $self->_cgi_param('notes'), $self->_cgi_param('tags'));\r
436 }\r
437 \r
438 sub attempting_login {\r
439         my $self = shift;\r
440         return $self->_is_post();\r
441 }\r
442 \r
443 sub get_supplied_username_and_password {\r
444         my $self = shift;\r
445         return ($self->_cgi_param('username'), $self->_cgi_param('password'));\r
446 }\r
447 \r
448 sub get_rating_history {\r
449         my $self = shift;\r
450         return undef unless (defined $self->_session());\r
451         my $hist = $self->_session()->param(-name => 'history');\r
452         return () unless (ref $hist eq 'ARRAY');\r
453         return @$hist;\r
454 }\r
455 \r
456 sub set_rating_history {\r
457         my ($self, @history) = @_;\r
458         return undef unless (defined $self->_session());\r
459         $self->_session()->param(-name => 'history', -value => \@history);\r
460 }\r
461 \r
462 sub get_rated_quotes {\r
463         my $self = shift;\r
464         return undef unless (defined $self->_session());\r
465         my $list = $self->_session()->param(-name => 'rated');\r
466         return () unless (ref $list eq 'ARRAY');\r
467         return @$list;\r
468 }\r
469 \r
470 sub set_rated_quotes {\r
471         my ($self, @list) = @_;\r
472         return undef unless (defined $self->_session());\r
473         $self->_session()->param(-name => 'rated', -value => \@list);\r
474 }\r
475 \r
476 sub get_logged_in_user {\r
477         my $self = shift;\r
478         return undef unless (defined $self->_session());\r
479         return $self->_session()->param(-name => 'user');\r
480 }\r
481 \r
482 sub set_logged_in_user {\r
483         my ($self, $id) = @_;\r
484         return undef unless (defined $self->_session());\r
485         $self->_session()->param(-name => 'user', -value => $id);\r
486 }\r
487 \r
488 sub report_unknown_action {\r
489         my $self = shift;\r
490         $self->_report_error($self->locale()->get_string('unknown_action'));\r
491 }\r
492 \r
493 sub report_no_quotes_to_display {\r
494         my ($self, $page) = @_;\r
495         my $type = $self->_feed_type();\r
496         if (defined $type) {\r
497                 $self->_generate_feed([], $type, $page);\r
498         }\r
499         elsif ($self->_wants_microsummary()\r
500         && $self->_page_offers_microsummary($page)) {\r
501                 $self->_generate_microsummary(undef, $page);\r
502         }\r
503         else {\r
504                 my $name = &_get_page_name($page);\r
505                 my $title = $self->locale()->get_string($name);\r
506                 $self->_report_message(\r
507                         &_text_to_xhtml($title),\r
508                         $self->locale()->get_string('no_quotes'));\r
509         }\r
510 }\r
511 \r
512 sub _report_message {\r
513         my ($self, $title, $text) = @_;\r
514         my $template = $self->_load_template('message');\r
515         $template->param(\r
516                 'PAGE_TITLE' => &_text_to_xhtml($title),\r
517                 'MESSAGE_TEXT' => &_text_to_xhtml($text)\r
518         );\r
519         $self->_output_template($template);\r
520 }\r
521 \r
522 sub _report_error {\r
523         my ($self, $error) = @_;\r
524         my $template = $self->_load_template('error');\r
525         $template->param(\r
526                 'PAGE_TITLE' => &_text_to_xhtml(\r
527                         $self->locale()->get_string('error_title')),\r
528                 'ERROR_MESSAGE' => &_text_to_xhtml($error)\r
529         );\r
530         $self->_output_template($template);\r
531 }\r
532 \r
533 sub welcome_user {\r
534         my ($self, $news) = @_;\r
535         my $template = $self->_load_template('start_page');\r
536         my $locale = $self->locale();\r
537         $template->param('PAGE_TITLE' => &_text_to_xhtml(\r
538                 $locale->get_string('welcome')));\r
539         $template->param('NEWS_TITLE' => &_text_to_xhtml(\r
540                 $locale->get_string('latest_news')));\r
541         if (defined $news) {\r
542                 my @news_tmpl = ();\r
543                 foreach my $item (@$news) {\r
544                         my $poster = $item->get_poster();\r
545                         push @news_tmpl, {\r
546                                 'BODY' => $self->_format_news_body($item->get_body()),\r
547                                 'AUTHOR' => defined $poster \r
548                                         ? &_text_to_xhtml($poster->get_username())\r
549                                         : undef,\r
550                                 'DATE' => &_text_to_xhtml(\r
551                                         $self->format_date_time($item->get_date())),\r
552                                 'ALLOW_EDIT'\r
553                                         => $self->administration_allowed(Chirpy::UI::EDIT_NEWS),\r
554                                 'ALLOW_REMOVE'\r
555                                         => $self->administration_allowed(Chirpy::UI::REMOVE_NEWS),\r
556                                 'EDIT' => &_text_to_xhtml(\r
557                                         $locale->get_string('edit')),\r
558                                 'REMOVE' => &_text_to_xhtml(\r
559                                         $locale->get_string('remove')),\r
560                                 'REMOVAL_CONFIRMATION' => &_text_to_xhtml(\r
561                                         $locale->get_string('news_removal_confirmation')),\r
562                                 'EDIT_URL' => $self->_url(\r
563                                         ADMIN_ACTIONS->{'EDIT_NEWS'},\r
564                                         1,\r
565                                         'id' => $item->get_id()),\r
566                                 'REMOVE_URL' => $self->_url(\r
567                                         ADMIN_ACTIONS->{'REMOVE_NEWS'},\r
568                                         1,\r
569                                         'id' => $item->get_id())\r
570                         };\r
571                 }\r
572                 $template->param('NEWS' => \@news_tmpl);\r
573         }\r
574         my $motd_path = $self->configuration()->get('general', 'base_path')\r
575                 . '/' . $self->param('welcome_text_file');\r
576         # TODO: find a better way to include this\r
577         if (-f $motd_path) {\r
578                 $template->param('MOTD' => $self->_process_template(\r
579                         new HTML::Template(\r
580                                 'filename' => $motd_path,\r
581                                 'die_on_bad_params' => 0,\r
582                                 'global_vars' => 1,\r
583                                 'file_cache' => 1,\r
584                                 'file_cache_dir' => $self->_template_cache_path(),\r
585                                 'file_cache_dir_mode' => 0777\r
586                         )\r
587                 ));\r
588         }\r
589         $self->_output_template($template);\r
590 }\r
591 \r
592 sub browse_quotes {\r
593         my ($self, $quotes, $page, $previous, $next) = @_;\r
594         my $type = $self->_feed_type();\r
595         if (defined $type) {\r
596                 $self->_generate_feed($quotes, $type, $page);\r
597         }\r
598         elsif ($self->_wants_microsummary()\r
599         && $self->_page_offers_microsummary($page)) {\r
600                 $self->_generate_microsummary($quotes->[0], $page);\r
601         }\r
602         else {\r
603                 $self->_generate_xhtml($quotes, $page, $previous, $next);\r
604         }\r
605 }\r
606 \r
607 sub _generate_microsummary {\r
608         my ($self, $quote, $page) = @_;\r
609         my $locale = $self->locale();\r
610         my $prefix;\r
611         if ($page == Chirpy::UI::TOP_QUOTES) {\r
612                 $prefix = $locale->get_string('webapp.top_quote_prefix');\r
613         }\r
614         elsif ($page == Chirpy::UI::BOTTOM_QUOTES) {\r
615                 $prefix = $locale->get_string('webapp.bottom_quote_prefix');\r
616         }\r
617         elsif ($page == Chirpy::UI::MODERATION_QUEUE) {\r
618                 $prefix = $locale->get_string('webapp.latest_unmoderated_quote_prefix');\r
619         }\r
620         else {\r
621                 $prefix = $locale->get_string('webapp.latest_quote_prefix');\r
622         }\r
623         my $summary = $prefix . ' '\r
624                 . (defined $quote\r
625                         ? $quote->get_id()\r
626                         : $locale->get_string('none'));\r
627         # Don't serve Last-Modified here, since not everything is chronological\r
628         $self->_maybe_gzip($summary, 'text/plain');\r
629 }\r
630 \r
631 sub _generate_feed {\r
632         my ($self, $quotes, $type, $page) = @_;\r
633         my $date = $self->get_parameter('webapp.quote_feed_date');\r
634         unless ($date) {\r
635                 if (@$quotes) {\r
636                         foreach my $quote (@$quotes) {\r
637                                 my $d = $quote->get_date_submitted();\r
638                                 $date = $d if (!defined($date) || $d > $date);\r
639                         }\r
640                 }\r
641                 else {\r
642                         $date = time;\r
643                 }\r
644         }\r
645         my $etag = sprintf('"%X"', $date);\r
646         require HTTP::Date;\r
647         my $ims = $self->{'cgi'}->http('If-Modified-Since');\r
648         my $inm = $self->{'cgi'}->http('If-None-Match');\r
649         if ((defined $ims || defined $inm)\r
650         && ((defined $ims && $date <= HTTP::Date::str2time($ims))\r
651         || (defined $inm && $etag eq $inm))) {\r
652                 print $self->{'cgi'}->header(-status => '304 Not Modified');\r
653                 return;\r
654         }\r
655         my $locale = $self->locale();\r
656         my $conf = $self->configuration();\r
657         my $site_title = &_text_to_xhtml(\r
658                 $conf->get('general', 'title'));\r
659         my $page_title = &_text_to_xhtml(\r
660                 $self->locale()->get_string(&_get_page_name($page)));\r
661         my $site_description = &_text_to_xhtml(\r
662                 $conf->get('general', 'description'));\r
663         my $name = &_text_to_xhtml($self->param('webmaster_name'));\r
664         my $email = &_hide_email($self->param('webmaster_email'));\r
665         my $template = new HTML::Template(\r
666                 'filename' => $self->{'templates_path'}\r
667                         . '/feeds/' . ($type eq 'atom' ? 'atom10' : 'rss20') . '.xml',\r
668                 'die_on_bad_params' => 0,\r
669                 'global_vars' => 1,\r
670                 'file_cache' => 1,\r
671                 'file_cache_dir' => $self->_template_cache_path(),\r
672                 'file_cache_dir_mode' => 0777\r
673         );\r
674         my @quotes = ();\r
675         foreach my $quote (@$quotes) {\r
676                 my $id = $quote->get_id();\r
677                 my $d = $quote->get_date_submitted();\r
678                 $date = $d if (!defined($date) || $d > $date);\r
679                 my $up_url = $self->_url(ACTIONS->{'QUOTE_RATING_UP'},\r
680                         undef, 'id' => $id);\r
681                 my $down_url = $self->_url(ACTIONS->{'QUOTE_RATING_DOWN'},\r
682                         undef, 'id' => $id);\r
683                 my $report_url = $self->_url(ACTIONS->{'REPORT_QUOTE'},\r
684                         undef, 'id' => $id);\r
685                 my ($body, $notes, $tags) = $self->_format_quote($quote);\r
686                 push @quotes, {\r
687                         'QUOTE_TITLE' => &_text_to_xhtml(\r
688                                 $locale->get_string('quote_title', $id)),\r
689                         'QUOTE_ID' => $id,\r
690                         'QUOTE_URL' => &_text_to_xhtml($self->_quote_url($id)),\r
691                         'QUOTE_BODY' => $body,\r
692                         'QUOTE_NOTES' => $notes,\r
693                         'QUOTE_TAGS' => $tags,\r
694                         'QUOTE_NOTES_TITLE' => &_text_to_xhtml(\r
695                                 $locale->get_string('quote_notes_title')),\r
696                         'QUOTE_TAGS_TITLE' => &_text_to_xhtml(\r
697                                 $locale->get_string('quote_tags_title')),\r
698                         'QUOTE_RATING'\r
699                                 => Chirpy::Util::format_quote_rating($quote->get_rating()),\r
700                         'QUOTE_VOTE_COUNT' => $quote->get_vote_count(),\r
701                         'QUOTE_RATING_UP_URL' => $up_url,\r
702                         'QUOTE_RATING_DOWN_URL' => $down_url,\r
703                         'QUOTE_REPORT_URL' => $report_url,\r
704                         'QUOTE_RATING_UP_SHORT_TITLE' => &_text_to_xhtml(\r
705                                 $locale->get_string('quote_rating_up_short_title')),\r
706                         'QUOTE_RATING_DOWN_SHORT_TITLE' => &_text_to_xhtml(\r
707                                 $locale->get_string('quote_rating_down_short_title')),\r
708                         'QUOTE_REPORT_SHORT_TITLE' => &_text_to_xhtml(\r
709                                 $locale->get_string('report_quote_short_title')),\r
710                         'QUOTE_DATE_RFC822' => sub {\r
711                                 return &_format_date_time_rfc822($d);\r
712                         },\r
713                         'QUOTE_DATE_ISO8601' => sub {\r
714                                 return &_format_date_time_iso8601($d);\r
715                         },\r
716                         'QUOTE_IS_APPROVED' => $quote->is_approved(),\r
717                         'QUOTE_IS_FLAGGED' => $quote->is_flagged()\r
718                 };\r
719         }\r
720         my $act = $self->_action();\r
721         $template->param(\r
722                 'SITE_TITLE' => $site_title,\r
723                 'PAGE_TITLE' => $page_title,\r
724                 'FEED_SUBTITLE' => $site_description,\r
725                 'FEED_URL' => $self->_feed_url($act, $type),\r
726                 'PAGE_URL' => $self->_url($act),\r
727                 'SITE_URL' => $self->_url(),\r
728                 'WEBMASTER_NAME' => $name,\r
729                 'WEBMASTER_EMAIL' => $email,\r
730                 'CHARACTER_ENCODING' => 'UTF-8',\r
731                 'CHIRPY_NAME' => Chirpy::PRODUCT_NAME,\r
732                 'CHIRPY_VERSION' => Chirpy::VERSION_STRING,\r
733                 'CHIRPY_URL' => Chirpy::URL,\r
734                 'QUOTES' => \@quotes,\r
735                 'FEED_DATE_RFC822' => sub {\r
736                         return &_format_date_time_rfc822($date);\r
737                 },\r
738                 'FEED_DATE_ISO8601' => sub {\r
739                         return &_format_date_time_iso8601($date);\r
740                 }\r
741         );\r
742         my $ctype = 'application/' . $type . '+xml';\r
743         $ctype = 'text/xml' unless ($self->_accepts($ctype));\r
744         $self->_maybe_gzip($template->output(), $ctype,\r
745                 -Last_Modified => HTTP::Date::time2str($date),\r
746                 -ETag => $etag);\r
747 }\r
748 \r
749 sub _generate_xhtml {\r
750         my ($self, $quotes, $page, $previous, $next) = @_;\r
751         $self->parent()->mark_debug_event('Build quote browser');\r
752         my $name = &_get_page_name($page);\r
753         my $locale = $self->locale();\r
754         my $page_title = &_text_to_xhtml(\r
755                 $self->locale()->get_string($name));\r
756         my $processing = &_text_to_xhtml(\r
757                 $locale->get_string('processing'));\r
758         my $timed_out = &_text_to_xhtml(\r
759                 $locale->get_string('timed_out'));\r
760         my $error = &_text_to_xhtml($locale->get_string('error'));\r
761         my $flagged = &_text_to_xhtml($locale->get_string('flagged'));\r
762         my $up = &_text_to_xhtml(\r
763                 $locale->get_string('quote_rating_up_short_title'));\r
764         my $down = &_text_to_xhtml(\r
765                 $locale->get_string('quote_rating_down_short_title'));\r
766         my $report = &_text_to_xhtml(\r
767                 $locale->get_string('report_quote_short_title'));\r
768         my $edit = &_text_to_xhtml($locale->get_string('edit'));\r
769         my $remove = &_text_to_xhtml($locale->get_string('remove'));\r
770         my $unflag = &_text_to_xhtml($locale->get_string('unflag'));\r
771         my $template = $self->_load_template('quote_list');\r
772         $template->param(\r
773                 'PAGE_TITLE' => $page_title,\r
774                 'FLAGGED' => $flagged,\r
775                 'ERROR' => $error,\r
776                 'PROCESSING' => $processing,\r
777                 'TIMED_OUT' => $timed_out,\r
778                 'QUOTE_RATING_TIMED_OUT' => &_text_to_xhtml(\r
779                         $locale->get_string('webapp.quote_rating_timed_out')),\r
780                 'LIMIT_EXCEEDED_TEXT' => &_text_to_xhtml(\r
781                         $self->_quote_rating_limit_text()),\r
782                 'QUOTE_ALREADY_RATED_TEXT' => &_text_to_xhtml(\r
783                         $self->_quote_already_rated_text()),\r
784                 'QUOTE_NOT_FOUND_TEXT' => &_text_to_xhtml(\r
785                         $locale->get_string('rated_quote_not_found_text')),\r
786                 'SESSION_REQUIRED_TEXT' => &_text_to_xhtml(\r
787                         $locale->get_string('webapp.session_required')),\r
788         );\r
789         my $query;\r
790         if ($page == Chirpy::UI::QUOTE_SEARCH) {\r
791                 $query = $self->_cgi_param('query');\r
792                 $template->param(\r
793                         'SEARCHED' => 1,\r
794                         'SEARCH_QUERY' => &_text_to_xhtml($query)\r
795                 );\r
796         }\r
797         my $link_desc = &_text_to_xhtml(\r
798                 $locale->get_string('webapp.quote_link_description'));\r
799         my $rating_up_desc = &_text_to_xhtml(\r
800                 $locale->get_string('quote_rating_up_description'));\r
801         my $rating_down_desc = &_text_to_xhtml(\r
802                 $locale->get_string('quote_rating_down_description'));\r
803         my $report_desc = &_text_to_xhtml(\r
804                 $locale->get_string('quote_report_description'));\r
805         my $rating_desc = &_text_to_xhtml(\r
806                 $locale->get_string('quote_rating_description'));\r
807         my $vote_count_desc = &_text_to_xhtml(\r
808                 $locale->get_string('quote_vote_count_description'));\r
809         my $date_desc = &_text_to_xhtml(\r
810                 $locale->get_string('quote_date_description'));\r
811         my $edit_desc = &_text_to_xhtml(\r
812                 $locale->get_string('quote_edit_description'));\r
813         my $remove_desc = &_text_to_xhtml(\r
814                 $locale->get_string('quote_remove_description'));\r
815         my $removal_conf = &_text_to_xhtml(\r
816                 $locale->get_string('quote_removal_confirmation'));\r
817         my $notes_title = &_text_to_xhtml(\r
818                 $locale->get_string('quote_notes_title'));\r
819         my $tags_title = &_text_to_xhtml(\r
820                 $locale->get_string('quote_tags_title'));\r
821         my %static_strings = (\r
822                 'RATING_UP_DESCRIPTION' => $rating_up_desc,\r
823                 'RATING_DOWN_DESCRIPTION' => $rating_down_desc,\r
824                 'REMOVE_DESCRIPTION' => $remove_desc,\r
825                 'LINK_DESCRIPTION' => $link_desc,\r
826                 'REMOVE_DESCRIPTION' => $remove_desc,\r
827                 'REPORT_DESCRIPTION' => $report_desc,\r
828                 'RATING_DESCRIPTION' => $rating_desc,\r
829                 'VOTE_COUNT_DESCRIPTION' => $vote_count_desc,\r
830                 'DATE_DESCRIPTION' => $date_desc,\r
831                 'EDIT_DESCRIPTION' => $edit_desc,\r
832                 'REMOVE_DESCRIPTION' => $remove_desc,\r
833                 'REMOVAL_CONFIRMATION' => $removal_conf,\r
834                 'UP' => $up,\r
835                 'DOWN' => $down,\r
836                 'EDIT' => $edit,\r
837                 'REMOVE' => $remove,\r
838                 'UNFLAG' => $unflag,\r
839                 'REPORT' => $report,\r
840                 'FLAGGED' => $flagged,\r
841                 'NOTES_TITLE' => $notes_title,\r
842                 'TAGS_TITLE' => $tags_title\r
843         );\r
844         my %previous_rating = ();\r
845         foreach my $rated ($self->get_rated_quotes()) {\r
846                 $previous_rating{abs($rated)} = ($rated < 0 ? -1 : 1);\r
847         }\r
848         my @quotes_tmpl = ();\r
849         $self->parent()->mark_debug_event('Parse quotes for template');\r
850         foreach my $quote (@$quotes) {\r
851                 my $up_url = $self->_url(\r
852                         ACTIONS->{'QUOTE_RATING_UP'},\r
853                         undef,\r
854                         'id' => $quote->get_id());\r
855                 my $down_url = $self->_url(\r
856                         ACTIONS->{'QUOTE_RATING_DOWN'},\r
857                         undef,\r
858                         'id' => $quote->get_id());\r
859                 my $report_url = $self->_url(\r
860                         ACTIONS->{'REPORT_QUOTE'},\r
861                         undef,\r
862                         'id' => $quote->get_id());\r
863                 $self->parent()->mark_debug_event('Parse quote body');\r
864                 my ($body, $notes, $tags) = $self->_format_quote($quote);\r
865                 $self->parent()->mark_debug_event('Quote body parsed');\r
866                 my $id = $quote->get_id();\r
867                 push @quotes_tmpl, {\r
868                         'ID' => $id,\r
869                         'TITLE' => &_text_to_xhtml(\r
870                                 $locale->get_string('quote_title', $id)),\r
871                         'BODY' => $body,\r
872                         'NOTES' => $notes,\r
873                         'TAGS' => $tags,\r
874                         'NOTES_OR_TAGS' => (defined $notes || @$tags ? 1 : 0),\r
875                         'RATING_NUMBER' => $quote->get_rating(),\r
876                         'RATING_TEXT'\r
877                                 => Chirpy::Util::format_quote_rating($quote->get_rating()),\r
878                         'VOTE_COUNT' => $quote->get_vote_count(),\r
879                         'SUBMITTED_TEXT' => &_text_to_xhtml(\r
880                                 $self->format_date_time($quote->get_date_submitted())),\r
881                         'IS_APPROVED' => $quote->is_approved(),\r
882                         'IS_FLAGGED' => $quote->is_flagged(),\r
883                         'WAS_VOTED_UP' => ($previous_rating{$id}\r
884                                 && $previous_rating{$id} > 0),\r
885                         'WAS_VOTED_DOWN' => ($previous_rating{$id}\r
886                                 && $previous_rating{$id} < 0),\r
887                         'LINK_URL' => &_text_to_xhtml(\r
888                                 $self->_quote_url($quote->get_id())),\r
889                         'RATING_UP_URL' => $up_url,\r
890                         'RATING_DOWN_URL' => $down_url,\r
891                         'REPORT_URL' => $report_url,\r
892                         'ALLOW_EDIT'\r
893                                 => $self->administration_allowed(Chirpy::UI::EDIT_QUOTE),\r
894                         'ALLOW_REMOVE'\r
895                                 => $self->administration_allowed(Chirpy::UI::REMOVE_QUOTE),\r
896                         'ALLOW_UNFLAG'\r
897                                 => $quote->is_flagged() && $self->administration_allowed(\r
898                                         Chirpy::UI::MANAGE_FLAGGED_QUOTES),\r
899                         'EDIT_URL' => sub { return $self->_url(\r
900                                 ADMIN_ACTIONS->{'EDIT_QUOTE'},\r
901                                 1,\r
902                                 'id' => $quote->get_id()) },\r
903                         'REMOVE_URL' => sub { return $self->_url(\r
904                                 ADMIN_ACTIONS->{'REMOVE_QUOTE'},\r
905                                 1,\r
906                                 'id' => $quote->get_id()) },\r
907                         'UNFLAG_URL' => sub { return $self->_url(\r
908                                 ADMIN_ACTIONS->{'MANAGE_FLAGGED_QUOTES'},\r
909                                 1,\r
910                                 'action_' . $quote->get_id() => 1) },\r
911                         'ADMINISTRATOR_LINKS'\r
912                                 => defined($self->get_logged_in_user_account()),\r
913                         %static_strings\r
914                 };\r
915         }\r
916         $self->parent()->mark_debug_event('Quotes parsed');\r
917         $template->param('QUOTES' => \@quotes_tmpl);\r
918         if (defined $previous || defined $next) {\r
919                 my %query = (defined $query ? ('query' => $query) : ());\r
920                 $template->param('BROWSER' => 1);\r
921                 $template->param('PREVIOUS_URL' => $self->_url(\r
922                                 $self->_action(),\r
923                                 undef,\r
924                                 'start' => $previous,\r
925                                 %query\r
926                         )) if (defined $previous);\r
927                 $template->param('NEXT_URL' => $self->_url(\r
928                                 $self->_action(),\r
929                                 undef,\r
930                                 'start' => $next,\r
931                                 %query\r
932                         )) if (defined $next);\r
933                 $template->param('START_URL' => $self->_url(\r
934                                 $self->_action(),\r
935                                 undef,\r
936                                 %query\r
937                         ));\r
938         }\r
939         $self->_output_template($template);\r
940         $self->parent()->mark_debug_event('Quote browser displayed');\r
941         my $dbg = $self->parent()->debug_events();\r
942         if (defined $dbg) {\r
943                 print "$/$/<!-- ";\r
944                 my $line = '=' x 80;\r
945                 print $/, $line;\r
946                 printf "$/%6s\t%6s\t%s", 'Time', 'Total', 'Event';\r
947                 print $/, $line;\r
948                 my $last_time = $self->parent()->start_time();\r
949                 my $total = 0;\r
950                 foreach my $event (@$dbg) {\r
951                         my $time = $event->[0] - $last_time;\r
952                         $total += $time;\r
953                         printf "$/%6.0f\t%6.0f\t%s",\r
954                                 $time * 1000,\r
955                                 $total * 1000,\r
956                                 $event->[1];\r
957                         $last_time = $event->[0];\r
958                 }\r
959                 print "$/$line$/-->";\r
960         }\r
961 }\r
962 \r
963 sub provide_quote_search_interface {\r
964         my $self = shift;\r
965         my $template = $self->_load_template('quote_search');\r
966         my $locale = $self->locale();\r
967         $template->param(\r
968                 'PAGE_TITLE' => &_text_to_xhtml(\r
969                         $locale->get_string('search_for_quotes'))\r
970         );\r
971         $self->_output_template($template);\r
972 }\r
973 \r
974 sub provide_tag_cloud {\r
975         my ($self, $tag_information) = @_;\r
976         my $template = $self->_load_template('tag_cloud');\r
977         my $locale = $self->locale();\r
978         my @tag_info = ();\r
979         foreach my $arrayref (@$tag_information) {\r
980                 my ($tag, $cnt, $perc) = @$arrayref;\r
981                 my $title = $self->locale()->get_string('tag_link_description', $tag);\r
982                 push @tag_info, {\r
983                         'TAG' => &_text_to_xhtml($tag),\r
984                         'USAGE_COUNT' => $cnt,\r
985                         'SIZE_PERCENTAGE' => $perc,\r
986                         'URL' => &_text_to_xhtml($self->_tag_url($tag)),\r
987                         'LINK_DESCRIPTION' => &_text_to_xhtml($title)\r
988                 };\r
989         }\r
990         $template->param(\r
991                 'PAGE_TITLE' => &_text_to_xhtml(\r
992                         $locale->get_string('tag_cloud')),\r
993                 'TAGS' => \@tag_info,\r
994                 'USAGE_SLIDER_TITLE' => &_text_to_xhtml(\r
995                         $locale->get_string('webapp.minimum_tag_usage_count_title'))\r
996         );\r
997         $self->_output_template($template);\r
998 }\r
999 \r
1000 sub report_no_tagged_quotes {\r
1001         my $self = shift;\r
1002         $self->_report_error($self->locale()->get_string('no_tagged_quotes'));\r
1003 }\r
1004 \r
1005 sub provide_statistics {\r
1006         my ($self, $quotes_by_date,\r
1007                 $quotes_by_hour, $quotes_by_weekday, $quotes_by_day, $quotes_by_month,\r
1008                 $quotes_by_rating, $quotes_by_votes, $votes_by_rating) = @_;\r
1009         if ($self->statistics_update_allowed()) {\r
1010                 $self->_output_xml('result');\r
1011                 return;\r
1012         }\r
1013         my $template = $self->_load_template('statistics');\r
1014         my $locale = $self->locale();\r
1015         my @by_date = ();\r
1016         foreach my $line (@$quotes_by_date) {\r
1017                 push @by_date, {\r
1018                         'DATE' => $line->[0],\r
1019                         'QUOTE_COUNT' => $line->[1]\r
1020                 };\r
1021         }\r
1022         my @by_hour = ();\r
1023         foreach my $h (0..23) {\r
1024                 push @by_hour, {\r
1025                         'START_HOUR' => $h,\r
1026                         'END_HOUR' => ($h == 23 ? 0 : $h + 1),\r
1027                         'QUOTE_COUNT' => $quotes_by_hour->[$h]\r
1028                 };\r
1029         }\r
1030         my @by_month = ();\r
1031         foreach my $month (0..11) {\r
1032                 my ($short, $long) = $self->format_month($month);\r
1033                 push @by_month, {\r
1034                         'MONTH_NAME_SHORT' => $short,\r
1035                         'MONTH_NAME' => $long,\r
1036                         'QUOTE_COUNT' => $quotes_by_month->[$month]\r
1037                 };\r
1038         }\r
1039         my @by_day = ();\r
1040         foreach my $day (0..30) {\r
1041                 push @by_day, {\r
1042                         'DAY' => $day + 1,\r
1043                         'QUOTE_COUNT' => $quotes_by_day->[$day]\r
1044                 };\r
1045         }\r
1046         my @by_weekday = ();\r
1047         my @days = qw(sunday monday tuesday wednesday thursday friday saturday);\r
1048         foreach my $d (0..6) {\r
1049                 push @by_weekday, {\r
1050                         'WEEKDAY' => $locale->get_string($days[$d]),\r
1051                         'QUOTE_COUNT' => $quotes_by_weekday->[$d]\r
1052                 };\r
1053         }\r
1054         my @by_rating = ();\r
1055         foreach my $line (@$quotes_by_rating) {\r
1056                 push @by_rating, {\r
1057                         'RATING' => Chirpy::Util::format_quote_rating($line->[0]),\r
1058                         'QUOTE_COUNT' => $line->[1]\r
1059                 };\r
1060         }\r
1061         my @by_votes = ();\r
1062         foreach my $line (@$quotes_by_votes) {\r
1063                 push @by_votes, {\r
1064                         'VOTE_COUNT' => $line->[0],\r
1065                         'QUOTE_COUNT' => $line->[1]\r
1066                 };\r
1067         }\r
1068         my @votes_by_rating = (\r
1069                 {\r
1070                         'RATING' => &_text_to_xhtml(\r
1071                                 $locale->get_string('quote_rating_up_short_title')),\r
1072                         'VOTE_COUNT' => $votes_by_rating->[0]\r
1073                 },\r
1074                 {\r
1075                         'RATING' => &_text_to_xhtml(\r
1076                                 $locale->get_string('quote_rating_down_short_title')),\r
1077                         'VOTE_COUNT' => $votes_by_rating->[1]\r
1078                 }\r
1079         );\r
1080         $template->param(\r
1081                 'PAGE_TITLE' => &_text_to_xhtml(\r
1082                         $locale->get_string('statistics')),\r
1083                 'QUOTES_BY_DATE' => \@by_date,\r
1084                 'QUOTES_BY_DATE_TITLE' => &_text_to_xhtml(\r
1085                         $locale->get_string('quote_count_by_date')),\r
1086                 'QUOTES_BY_HOUR' => \@by_hour,\r
1087                 'QUOTES_BY_HOUR_TITLE' => &_text_to_xhtml(\r
1088                         $locale->get_string('quote_count_by_hour')),\r
1089                 'QUOTES_BY_MONTH' => \@by_month,\r
1090                 'QUOTES_BY_MONTH_TITLE' => &_text_to_xhtml(\r
1091                         $locale->get_string('quote_count_by_month')),\r
1092                 'QUOTES_BY_DAY' => \@by_day,\r
1093                 'QUOTES_BY_DAY_TITLE' => &_text_to_xhtml(\r
1094                         $locale->get_string('quote_count_by_day')),\r
1095                 'QUOTES_BY_WEEKDAY' => \@by_weekday,\r
1096                 'QUOTES_BY_WEEKDAY_TITLE' => &_text_to_xhtml(\r
1097                         $locale->get_string('quote_count_by_weekday')),\r
1098                 'QUOTES_BY_RATING' => \@by_rating,\r
1099                 'QUOTES_BY_RATING_TITLE' => &_text_to_xhtml(\r
1100                         $locale->get_string('quote_count_by_rating')),\r
1101                 'QUOTES_BY_VOTE_COUNT' => \@by_votes,\r
1102                 'QUOTES_BY_VOTE_COUNT_TITLE' => &_text_to_xhtml(\r
1103                         $locale->get_string('quote_count_by_vote_count')),\r
1104                 'VOTES_BY_RATING' => \@votes_by_rating,\r
1105                 'VOTES_BY_RATING_TITLE' => &_text_to_xhtml(\r
1106                         $locale->get_string('vote_count_by_rating')),\r
1107                 'UPDATE_URL'\r
1108                         => $self->_url(ACTIONS->{'STATISTICS'}, 0, 'update' => 1)\r
1109         );\r
1110         $self->_output_template($template);\r
1111 }\r
1112 \r
1113 sub report_statistics_unavailable {\r
1114         my $self = shift;\r
1115         $self->_report_error($self->locale()->get_string('statistics_unavailable'));\r
1116 }\r
1117 \r
1118 sub statistics_update_allowed {\r
1119         my $self = shift;\r
1120         return $self->_url_param('update');\r
1121 }\r
1122 \r
1123 sub report_no_search_results {\r
1124         my $self = shift;\r
1125         my $type = $self->_feed_type();\r
1126         if (defined $type) {\r
1127                 $self->_generate_feed([], $type, Chirpy::UI::QUOTE_SEARCH);\r
1128         }\r
1129         else {\r
1130                 my $locale = $self->locale();\r
1131                 $self->_report_message($locale->get_string('no_search_results'),\r
1132                         $locale->get_string('no_search_results_text'));\r
1133         }\r
1134 }\r
1135 \r
1136 sub report_inexistent_quote {\r
1137         my $self = shift;\r
1138         my $locale = $self->locale();\r
1139         $self->_report_message($locale->get_string('quote_not_found'),\r
1140                 $locale->get_string('quote_not_found_text'));\r
1141 }\r
1142 \r
1143 sub provide_quote_submission_interface {\r
1144         my $self = shift;\r
1145         my $template = $self->_load_template('submit_quote');\r
1146         my $locale = $self->locale();\r
1147         $template->param(\r
1148                 'PAGE_TITLE' => &_text_to_xhtml(\r
1149                         $locale->get_string('submit_quote')),\r
1150                 'NO_APPROVAL' => $self->administration_allowed(\r
1151                         Chirpy::UI::MANAGE_UNAPPROVED_QUOTES),\r
1152                 'SUBMIT_FORM_START' => '<form method="post" action="'\r
1153                         . $self->_url(ACTIONS->{'SUBMIT_QUOTE'}) . '">',\r
1154                 'SUBMIT_FORM_END' => '</form>',\r
1155                 'QUOTE_LABEL' => &_text_to_xhtml(\r
1156                         $locale->get_string('submission_title')),\r
1157                 'NOTES_LABEL' => &_text_to_xhtml(\r
1158                         $locale->get_string('notes_title')),\r
1159                 'TAGS_LABEL' => &_text_to_xhtml(\r
1160                         $locale->get_string('tags_title')),\r
1161                 'SUBMIT_LABEL' => &_text_to_xhtml(\r
1162                         $locale->get_string('submit_button_label')),\r
1163                 'SUBMIT_LABEL_NO_APPROVAL' => &_text_to_xhtml(\r
1164                         $locale->get_string('submit_button_label_no_approval'))\r
1165         );\r
1166         if ($self->_requires_captcha()) {\r
1167                 my ($hash, $url, $width, $height) = $self->_captcha_provider()\r
1168                         ->create(time() + ($self->param('captcha_expiry_time') || 300));\r
1169                 $template->param(\r
1170                         'USE_CAPTCHA' => 1,\r
1171                         'CAPTCHA_HASH' => $hash,\r
1172                         'CAPTCHA_IMAGE_URL' => &_text_to_xhtml($url),\r
1173                         'CAPTCHA_CODE_LABEL' => &_text_to_xhtml(\r
1174                                 $locale->get_string('webapp.captcha_code_label')),\r
1175                         'CAPTCHA_IMAGE_TEXT' => &_text_to_xhtml(\r
1176                                 $locale->get_string('webapp.captcha_image_text')),\r
1177                         'CAPTCHA_IMAGE_WIDTH' => $width,\r
1178                         'CAPTCHA_IMAGE_HEIGHT' => $height\r
1179                 );\r
1180         }\r
1181         $self->_output_template($template);\r
1182 }\r
1183 \r
1184 sub confirm_quote_submission {\r
1185         my ($self, $admin) = @_;\r
1186         my $loc = $self->locale();\r
1187         if ($admin) {\r
1188                 $self->_trigger_feed_update();\r
1189                 $self->_report_message(\r
1190                         $loc->get_string('quote_submitted_no_approval'),\r
1191                         $loc->get_string('quote_submission_thanks_no_approval'));\r
1192         }\r
1193         else {\r
1194                 $self->_report_message($loc->get_string('quote_submitted'),\r
1195                         $loc->get_string('quote_submission_thanks'));\r
1196         }\r
1197 }\r
1198 \r
1199 sub quote_rating_confirmed {\r
1200         my $self = shift;\r
1201         return $self->_is_post();\r
1202 }\r
1203 \r
1204 sub request_quote_rating_confirmation {\r
1205         my ($self, $quote, $up, $revert) = @_;\r
1206         my $locale = $self->locale();\r
1207         my $action = 'quote_rating_' . ($up ? 'up' : 'down');\r
1208         $self->_confirmation_form(\r
1209                 $self->_url($self->_action(), 0, 'id' => $quote->get_id()),\r
1210                 1,\r
1211                 $locale->get_string($action . '_description'),\r
1212                 $locale->get_string($action . '_confirmation_request'),\r
1213                 $quote);\r
1214 }\r
1215 \r
1216 sub confirm_quote_rating {\r
1217         my ($self, $id, $up, $new_rating, $new_vote_count) = @_;\r
1218         $self->_trigger_feed_update();\r
1219         if ($self->_wants_xml()) {\r
1220                 $self->_output_xml('result', {\r
1221                         'status' => STATUS_OK,\r
1222                         'rating' => Chirpy::Util::format_quote_rating($new_rating),\r
1223                         'votes' => $new_vote_count\r
1224                 });\r
1225         }\r
1226         else {\r
1227                 my $loc = $self->locale();\r
1228                 $self->_report_message(\r
1229                         $loc->get_string('quote_rating_'\r
1230                                 . ($up ? 'increased' : 'decreased')),\r
1231                         $loc->get_string('quote_rating_thanks')\r
1232                 );\r
1233         }\r
1234 }\r
1235 \r
1236 sub report_rated_quote_not_found {\r
1237         my $self = shift;\r
1238         if ($self->_wants_xml()) {\r
1239                 $self->_output_xml('result', { 'status' => STATUS_QUOTE_NOT_FOUND });\r
1240         }\r
1241         else {\r
1242                 my $loc = $self->locale();\r
1243                 $self->_report_message(\r
1244                         $loc->get_string('quote_not_found'),\r
1245                         $loc->get_string('rated_quote_not_found_text')\r
1246                 );\r
1247         }\r
1248 }\r
1249 \r
1250 sub report_quote_already_rated {\r
1251         my $self = shift;\r
1252         if ($self->_wants_xml()) {\r
1253                 $self->_output_xml('result', { 'status' => STATUS_ALREADY_RATED });\r
1254         }\r
1255         else {\r
1256                 $self->_report_error($self->_quote_already_rated_text());\r
1257         }\r
1258 }\r
1259 \r
1260 sub report_quote_rating_limit_excess {\r
1261         my $self = shift;\r
1262         if ($self->_wants_xml()) {\r
1263                 $self->_output_xml('result', { 'status' => STATUS_RATING_LIMIT_EXCEEDED });\r
1264         }\r
1265         else {\r
1266                 $self->_report_error($self->_quote_rating_limit_text());\r
1267         }\r
1268 }\r
1269 \r
1270 sub quote_report_confirmed {\r
1271         my $self = shift;\r
1272         return $self->_is_post();\r
1273 }\r
1274 \r
1275 sub request_quote_report_confirmation {\r
1276         my ($self, $quote) = @_;\r
1277         my $locale = $self->locale();\r
1278         my $action = 'quote_report';\r
1279         $self->_confirmation_form(\r
1280                 $self->_url($self->_action(), 0, 'id' => $quote->get_id()),\r
1281                 1,\r
1282                 $locale->get_string($action . '_description'),\r
1283                 $locale->get_string($action . '_confirmation_request'),\r
1284                 $quote);\r
1285 }\r
1286 \r
1287 sub confirm_quote_report {\r
1288         my $self = shift;\r
1289         $self->_trigger_feed_update();\r
1290         if ($self->_wants_xml()) {\r
1291                 $self->_output_xml('result', { 'status' => STATUS_OK });\r
1292         }\r
1293         else {\r
1294                 my $loc = $self->locale();\r
1295                 $self->_report_message(\r
1296                         $loc->get_string('quote_reported'),\r
1297                         $loc->get_string('quote_report_thanks')\r
1298                 );\r
1299         }\r
1300 }\r
1301 \r
1302 sub report_reported_quote_not_found {\r
1303         my $self = shift;\r
1304         if ($self->_wants_xml()) {\r
1305                 $self->_output_xml('result', { 'status' => STATUS_QUOTE_NOT_FOUND });\r
1306         }\r
1307         else {\r
1308                 my $loc = $self->locale();\r
1309                 $self->_report_message(\r
1310                         $loc->get_string('quote_not_found'),\r
1311                         $loc->get_string('reported_quote_not_found_text')\r
1312                 );\r
1313         }\r
1314 }\r
1315 \r
1316 sub provide_login_interface {\r
1317         my ($self, $invalid) = @_;\r
1318         my $template = $self->_load_template('login');\r
1319         my $locale = $self->locale();\r
1320         $template->param(\r
1321                 'PAGE_TITLE' => &_text_to_xhtml(\r
1322                         $locale->get_string($invalid\r
1323                                 ? 'invalid_login_title'\r
1324                                 : 'login_title')),\r
1325                 'USERNAME_TITLE' => &_text_to_xhtml(\r
1326                         $locale->get_string('username_title')),\r
1327                 'PASSWORD_TITLE' => &_text_to_xhtml(\r
1328                         $locale->get_string('password_title')),\r
1329                 'LOGIN_BUTTON_LABEL' => &_text_to_xhtml(\r
1330                         $locale->get_string('login_button_label')),\r
1331                 'LOGIN_FORM_START' => '<form method="post" action="'\r
1332                         . $self->_url(ACTIONS->{'LOGIN'}) . '">',\r
1333                 'LOGIN_FORM_END' => '</form>',\r
1334                 'INVALID_LOGIN_INSTRUCTIONS' => &_text_to_xhtml(\r
1335                         $locale->get_string(\r
1336                                 'invalid_login_instructions')),\r
1337                 'INVALID_LOGIN' => $invalid\r
1338         );\r
1339         $self->_output_template($template);\r
1340 }\r
1341 \r
1342 sub report_invalid_login {\r
1343         my $self = shift;\r
1344         $self->provide_login_interface(1);\r
1345 }\r
1346 \r
1347 sub attempting_password_change {\r
1348         my $self = shift;\r
1349         return $self->_is_post();\r
1350 }\r
1351 \r
1352 sub get_supplied_passwords {\r
1353         my $self = shift;\r
1354         return ($self->_cgi_param('current_password'),\r
1355                 $self->_cgi_param('new_password'),\r
1356                 $self->_cgi_param('repeat_new_password'));\r
1357 }\r
1358 \r
1359 sub update_available {\r
1360         my ($self, $version, $released, $url) = @_;\r
1361         $self->{'available_update'} = [ $version, $released, $url ];\r
1362 }\r
1363 \r
1364 sub update_check_error {\r
1365         my ($self, $error) = @_;\r
1366         $self->{'update_check_error'} = $error;\r
1367 }\r
1368 \r
1369 sub get_current_administration_page {\r
1370         my $self = shift;\r
1371         my $action = $self->_admin_action();\r
1372         if (defined $action && $action) {\r
1373                 if ($action eq ADMIN_ACTIONS->{'ADD_ACCOUNT'}) {\r
1374                         return ($self->_cgi_param('account_remove')\r
1375                                 ? Chirpy::UI::REMOVE_ACCOUNT\r
1376                                 : $self->get_account_to_modify() < 0\r
1377                                         ? Chirpy::UI::ADD_ACCOUNT\r
1378                                         : Chirpy::UI::EDIT_ACCOUNT);\r
1379                 }\r
1380                 while (my ($n, $v) = each %{ADMIN_ACTIONS()}) {\r
1381                         if ($v eq $action) {\r
1382                                 return eval 'Chirpy::UI::' . $n;\r
1383                                 return undef;\r
1384                         }\r
1385                 }\r
1386         }\r
1387         return undef;\r
1388 }\r
1389 \r
1390 sub report_administration_user_level_insufficient {\r
1391         my ($self, $page) = @_;\r
1392         $self->_output_administration_page();\r
1393 }\r
1394 \r
1395 sub welcome_administrator {\r
1396         my $self = shift;\r
1397         $self->_output_administration_page();\r
1398 }\r
1399 \r
1400 sub get_quote_to_remove {\r
1401         my $self = shift;\r
1402         return $self->_id();\r
1403 }\r
1404 \r
1405 sub confirm_quote_removal {\r
1406         my $self = shift;\r
1407         $self->_trigger_feed_update();\r
1408         $self->_output_administration_page(\r
1409                 'quote_removed' => 1\r
1410         );\r
1411 }\r
1412 \r
1413 sub quote_removal_confirmed {\r
1414         my $self = shift;\r
1415         return $self->_cgi_param('confirm');\r
1416 }\r
1417 \r
1418 sub request_quote_removal_confirmation {\r
1419         my ($self, $quote) = @_;\r
1420         $self->_output_administration_page(\r
1421                 'confirm_quote_removal' => $quote\r
1422         );\r
1423 }\r
1424 \r
1425 sub report_quote_to_remove_not_found {\r
1426         my $self = shift;\r
1427         $self->_output_administration_page(\r
1428                 'quote_to_remove_not_found' => 1\r
1429         );\r
1430 }\r
1431 \r
1432 sub provide_quote_selection_for_removal_interface {\r
1433         my $self = shift;\r
1434         $self->_output_administration_page();\r
1435 }\r
1436 \r
1437 sub provide_quote_selection_for_modification_interface {\r
1438         my $self = shift;\r
1439         $self->_output_administration_page();\r
1440 }\r
1441 \r
1442 sub get_quote_to_edit {\r
1443         my $self = shift;\r
1444         return $self->_id();\r
1445 }\r
1446 \r
1447 sub get_modified_quote_information {\r
1448         my $self = shift;\r
1449         return ($self->_cgi_param('quote'),\r
1450                 $self->_cgi_param('notes'), $self->_cgi_param('tags'));\r
1451 }\r
1452 \r
1453 sub confirm_quote_modification {\r
1454         my $self = shift;\r
1455         $self->_trigger_feed_update();\r
1456         $self->_output_administration_page(\r
1457                 'quote_modified' => 1\r
1458         );\r
1459 }\r
1460 \r
1461 sub provide_quote_editing_interface {\r
1462         my ($self, $quote) = @_;\r
1463         $self->_output_administration_page(\r
1464                 'edit_quote' => $quote\r
1465         );\r
1466 }\r
1467 \r
1468 sub report_quote_to_edit_not_found {\r
1469         my $self = shift;\r
1470         $self->_output_administration_page(\r
1471                 'quote_to_edit_not_found' => 1\r
1472         );\r
1473 }\r
1474 \r
1475 sub provide_quote_approval_interface {\r
1476         my $self = shift;\r
1477         $self->_output_administration_page();\r
1478 }\r
1479 \r
1480 sub get_quote_flag_management_result {\r
1481         my $self = shift;\r
1482         my @unflag = ();\r
1483         my @remove = ();\r
1484         my @params = $self->_cgi_params();\r
1485         foreach my $name (@params) {\r
1486                 if ($name =~ /^action_(\d+)$/) {\r
1487                         my $id = $1;\r
1488                         my $action = $self->_cgi_param($name);\r
1489                         next unless $action;\r
1490                         if ($action == 1) {\r
1491                                 push @unflag, $id;\r
1492                         }\r
1493                         elsif ($action == 2) {\r
1494                                 push @remove, $id;\r
1495                         }\r
1496                 }\r
1497         }\r
1498         if (@unflag || @remove) {\r
1499                 $self->_trigger_feed_update();\r
1500         }\r
1501         return (\@unflag, \@remove);\r
1502 }\r
1503 \r
1504 sub provide_quote_flag_management_interface {\r
1505         my $self = shift;\r
1506         $self->_output_administration_page();\r
1507 }\r
1508 \r
1509 sub get_quote_approval_result {\r
1510         my $self = shift;\r
1511         my @approve = ();\r
1512         my @remove = ();\r
1513         my %edited = ();\r
1514         my @params = $self->_cgi_params();\r
1515         foreach my $name (@params) {\r
1516                 if ($name =~ /^(action|body|notes|tags)_(\d+)$/) {\r
1517                         my ($type, $id) = ($1, $2);\r
1518                         if ($type eq 'action') {\r
1519                                 my $action = $self->_cgi_param($name);\r
1520                                 next unless $action;\r
1521                                 if ($action == 1) {\r
1522                                         push @approve, $id;\r
1523                                 }\r
1524                                 elsif ($action == 2) {\r
1525                                         push @remove, $id;\r
1526                                 }\r
1527                         }\r
1528                         else {\r
1529                                 $edited{$id}{$type} = $self->_cgi_param($name);\r
1530                         }\r
1531                 }\r
1532         }\r
1533         # TODO: Make sure something changed.\r
1534         $self->_trigger_feed_update();\r
1535         return (\@approve, \@remove, \%edited);\r
1536 }\r
1537 \r
1538 sub get_news_item_to_add {\r
1539         my $self = shift;\r
1540         return $self->_cgi_param('news');\r
1541 }\r
1542 \r
1543 sub confirm_news_submission {\r
1544         my $self = shift;\r
1545         $self->_output_administration_page(\r
1546                 'news_item_added' => 1\r
1547         );\r
1548 }\r
1549 \r
1550 sub provide_news_submission_interface {\r
1551         my $self = shift;\r
1552         $self->_output_administration_page();\r
1553 }\r
1554 \r
1555 sub get_news_item_to_edit {\r
1556         my $self = shift;\r
1557         return $self->_id();\r
1558 }\r
1559 \r
1560 sub get_modified_news_item {\r
1561         my $self = shift;\r
1562         return ($self->_cgi_param('body'), $self->_cgi_param('poster') || undef);\r
1563 }\r
1564 \r
1565 sub confirm_news_item_modification {\r
1566         my $self = shift;\r
1567         $self->_output_administration_page(\r
1568                 'news_item_modified' => 1\r
1569         );\r
1570 }\r
1571 \r
1572 sub report_news_item_to_edit_not_found {\r
1573         my $self = shift;\r
1574         $self->_output_administration_page(\r
1575                 'news_item_to_edit_not_found' => 1\r
1576         );\r
1577 }\r
1578 \r
1579 sub provide_news_item_editing_interface {\r
1580         my ($self, $item) = @_;\r
1581         $self->_output_administration_page(\r
1582                 'edit_news_item' => $item\r
1583         );\r
1584 }\r
1585 \r
1586 sub provide_news_item_selection_for_modification_interface {\r
1587         my $self = shift;\r
1588         $self->_output_administration_page();\r
1589 }\r
1590 \r
1591 sub get_news_item_to_remove {\r
1592         my $self = shift;\r
1593         return $self->_id();\r
1594 }\r
1595 \r
1596 sub confirm_news_item_removal {\r
1597         my $self = shift;\r
1598         $self->_output_administration_page(\r
1599                 'news_item_removed' => 1\r
1600         );\r
1601 }\r
1602 \r
1603 sub report_news_item_to_remove_not_found {\r
1604         my $self = shift;\r
1605         $self->_output_administration_page(\r
1606                 'news_item_to_remove_not_found' => 1\r
1607         );\r
1608 }\r
1609 \r
1610 sub get_account_information_to_add {\r
1611         my $self = shift;\r
1612         return $self->_get_supplied_account_information();\r
1613 }\r
1614 \r
1615 sub report_invalid_new_username {\r
1616         my $self = shift;\r
1617         $self->_output_administration_page(\r
1618                 'invalid_username' => 1\r
1619         );\r
1620 }\r
1621 \r
1622 sub report_new_username_exists {\r
1623         my $self = shift;\r
1624         $self->_output_administration_page(\r
1625                 'username_exists' => 1\r
1626         );\r
1627 }\r
1628 \r
1629 sub report_invalid_new_password {\r
1630         my $self = shift;\r
1631         $self->_output_administration_page(\r
1632                 'invalid_password' => 1\r
1633         );\r
1634 }\r
1635 \r
1636 sub report_different_new_passwords {\r
1637         my $self = shift;\r
1638         $self->_output_administration_page(\r
1639                 'different_passwords' => 1\r
1640         );\r
1641 }\r
1642 \r
1643 sub report_invalid_new_user_level {\r
1644         my $self = shift;\r
1645         $self->_output_administration_page(\r
1646                 'invalid_user_level' => 1\r
1647         );\r
1648 }\r
1649 \r
1650 sub confirm_account_creation {\r
1651         my $self = shift;\r
1652         $self->_output_administration_page(\r
1653                 'account_created' => 1\r
1654         );\r
1655 }\r
1656 \r
1657 sub provide_account_creation_interface {\r
1658         my $self = shift;\r
1659         $self->_output_administration_page();\r
1660 }\r
1661 \r
1662 sub get_account_to_modify {\r
1663         my $self = shift;\r
1664         return $self->_id() || undef;\r
1665 }\r
1666 \r
1667 sub get_modified_account_information {\r
1668         my $self = shift;\r
1669         return $self->_get_supplied_account_information();\r
1670 }\r
1671 \r
1672 sub report_invalid_modified_username {\r
1673         my $self = shift;\r
1674         $self->_output_administration_page(\r
1675                 'invalid_username' => 1\r
1676         );\r
1677 }\r
1678 \r
1679 sub report_modified_username_exists {\r
1680         my $self = shift;\r
1681         $self->_output_administration_page(\r
1682                 'username_exists' => 1\r
1683         );\r
1684 }\r
1685 \r
1686 sub report_invalid_modified_password {\r
1687         my $self = shift;\r
1688         $self->_output_administration_page(\r
1689                 'invalid_password' => 1\r
1690         );\r
1691 }\r
1692 \r
1693 sub report_different_modified_passwords {\r
1694         my $self = shift;\r
1695         $self->_output_administration_page(\r
1696                 'different_passwords' => 1\r
1697         );\r
1698 }\r
1699 \r
1700 sub report_invalid_modified_user_level {\r
1701         my $self = shift;\r
1702         $self->_output_administration_page(\r
1703                 'invalid_user_level' => 1\r
1704         );\r
1705 }\r
1706 \r
1707 sub confirm_account_modification {\r
1708         my $self = shift;\r
1709         $self->_output_administration_page(\r
1710                 'account_modified' => 1\r
1711         );\r
1712 }\r
1713 \r
1714 sub report_account_to_modify_not_found {\r
1715         my $self = shift;\r
1716         $self->_output_administration_page(\r
1717                 'account_to_modify_not_found' => 1\r
1718         );\r
1719 }\r
1720 \r
1721 sub report_modified_account_information_required {\r
1722         my $self = shift;\r
1723         $self->_output_administration_page(\r
1724                 'modified_account_information_required' => 1\r
1725         );\r
1726 }\r
1727 \r
1728 sub provide_account_selection_for_modification_interface {\r
1729         my $self = shift;\r
1730         $self->_output_administration_page();\r
1731 }\r
1732 \r
1733 sub get_account_to_remove {\r
1734         my $self = shift;\r
1735         return $self->_id() || undef;\r
1736 }\r
1737 \r
1738 sub confirm_account_removal {\r
1739         my $self = shift;\r
1740         $self->_output_administration_page(\r
1741                 'account_removed' => 1\r
1742         );\r
1743 }\r
1744 \r
1745 sub report_account_to_remove_not_found {\r
1746         my $self = shift;\r
1747         $self->_output_administration_page(\r
1748                 'account_to_remove_not_found' => 1\r
1749         );\r
1750 }\r
1751 \r
1752 sub provide_account_selection_for_removal_interface {\r
1753         my $self = shift;\r
1754         $self->_output_administration_page();\r
1755 }\r
1756 \r
1757 sub report_last_owner_account_removal_error {\r
1758         my $self = shift;\r
1759         $self->_output_administration_page(\r
1760                 'last_owner_account_removal' => 1\r
1761         );\r
1762 }\r
1763 \r
1764 sub provide_password_change_interface {\r
1765         my ($self, $error) = @_;\r
1766         $self->_output_administration_page(\r
1767                 'password_change_error' => $error\r
1768         );\r
1769 }\r
1770 \r
1771 sub confirm_password_change {\r
1772         my $self = shift;\r
1773         $self->_output_administration_page(\r
1774                 'password_changed' => 1\r
1775         );\r
1776 }\r
1777 \r
1778 sub confirm_login {\r
1779         my $self = shift;\r
1780         $self->welcome_administrator();\r
1781 }\r
1782 \r
1783 sub confirm_logout {\r
1784         my $self = shift;\r
1785         $self->provide_login_interface();       \r
1786 }\r
1787 \r
1788 sub get_user_information {\r
1789         my $self = shift;\r
1790         my $cgi = $self->{'cgi'};\r
1791         return {\r
1792                 'remote_addr' => $cgi->remote_addr(),\r
1793                 'user_agent' => $cgi->user_agent()\r
1794         };\r
1795 }\r
1796 \r
1797 sub _trigger_feed_update {\r
1798         my $self = shift;\r
1799         $self->set_parameter('webapp.quote_feed_date', time);\r
1800 }\r
1801 \r
1802 sub _confirmation_form {\r
1803         my ($self, $url, $post, $title, $text, $quote) = @_;\r
1804         my $template = $self->_load_template('confirm');\r
1805         my $locale = $self->locale();\r
1806         my $body;\r
1807         if (defined $quote) {\r
1808                 $body = &_text_to_xhtml($quote->get_body());\r
1809                 $body = ($self->configuration()->get('ui', 'webapp.enable_autolink')\r
1810                         ? &_auto_link($body)\r
1811                         : &_spam_protect_email_addresses($body));\r
1812         }\r
1813         $template->param(\r
1814                 'PAGE_TITLE' => &_text_to_xhtml($title),\r
1815                 'URL' => &_text_to_xhtml($url),\r
1816                 'POST_FORM' => $post,\r
1817                 'CONFIRMATION_REQUEST' => &_text_to_xhtml($text),\r
1818                 'CONFIRMATION_TEXT' => &_text_to_xhtml(\r
1819                         $locale->get_string('ok')),\r
1820                 'CANCELATION_TEXT' => &_text_to_xhtml(\r
1821                         $locale->get_string('cancel')),\r
1822                 'QUOTE_BODY' => (defined $body\r
1823                         ? $body\r
1824                         : undef)\r
1825         );\r
1826         $self->_output_template($template);\r
1827 }\r
1828 \r
1829 sub _get_supplied_account_information {\r
1830         my $self = shift;\r
1831         my $level = $self->_cgi_param('new_level');\r
1832         return ($self->_cgi_param('new_username') || undef,\r
1833                 $self->_cgi_param('new_password') || undef,\r
1834                 $self->_cgi_param('new_password_repeat') || undef,\r
1835                 (!defined $level || $level < 0) ? undef : $level);\r
1836 }\r
1837 \r
1838 sub _output_administration_page {\r
1839         my ($self, %params) = @_;\r
1840         require Chirpy::UI::WebApp::Administration;\r
1841         my $adm = new Chirpy::UI::WebApp::Administration($self);\r
1842         $adm->output(%params);\r
1843 }\r
1844 \r
1845 sub _provide_session {\r
1846         my $self = shift;\r
1847         my $session = new Chirpy::UI::WebApp::Session($self, 1);\r
1848         $self->_set_cookie($Chirpy::UI::WebApp::Session::NAME,\r
1849                 $session->id(), $self->param('session_expiry'));\r
1850         return $session;\r
1851 }\r
1852 \r
1853 sub _provide_session_if_necessary {\r
1854         my ($self, $page) = @_;\r
1855         return if (defined $self->_session());\r
1856         my $force = &_requires_session($page);\r
1857         my $st = $self->_url_param('session_test');\r
1858         $st = 0 unless (defined $st);\r
1859         if ($force) {\r
1860                 if ($self->_wants_xml()) {\r
1861                         $self->_output_xml('result',\r
1862                                 { 'status' => STATUS_SESSION_REQUIRED });\r
1863                 }\r
1864                 elsif ($st == 2) {\r
1865                         $self->_report_error($self->locale()\r
1866                                 ->get_string('webapp.session_required'));\r
1867                 }\r
1868                 else {\r
1869                         if ($st == 1) {\r
1870                                 $self->_provide_session();\r
1871                                 $st = 2;\r
1872                         }\r
1873                         else {\r
1874                                 $st = 1;\r
1875                         }\r
1876                         my $cgi = $self->{'cgi'};\r
1877                         my $uri = $cgi->url(-path_info => 1) . '?session_test=' . $st;\r
1878                         my @params = $self->_url_params();\r
1879                         if ($self->param('enable_short_urls')) {\r
1880                                 @params = grep\r
1881                                         !/^(?:(?:admin_)?action|session_test)$/,\r
1882                                         @params;\r
1883                         }\r
1884                         else {\r
1885                                 @params = grep\r
1886                                         { $_ ne 'session_test' }\r
1887                                         @params;\r
1888                         }\r
1889                         if (@params) {\r
1890                                 require URI::Escape;\r
1891                                 foreach my $p (@params) {\r
1892                                         $uri .= '&'\r
1893                                                 . URI::Escape::uri_escape($p)\r
1894                                                 . '='\r
1895                                                 . URI::Escape::uri_escape($self->_url_param($p));\r
1896                                 }\r
1897                         }\r
1898                         print $cgi->header(\r
1899                                 -location => $uri,\r
1900                                 -cookie => $self->{'cookies'}\r
1901                         );\r
1902                 }\r
1903                 exit;\r
1904         }\r
1905         else {\r
1906                 $self->_provide_session();\r
1907         }\r
1908 }\r
1909 \r
1910 sub _get_page_name {\r
1911         my $page = shift;\r
1912         if ($page == Chirpy::UI::QUOTE_BROWSER) {\r
1913                 return 'quote_browser';\r
1914         }\r
1915         elsif ($page == Chirpy::UI::RANDOM_QUOTES) {\r
1916                 return 'random_quotes';\r
1917         }\r
1918         elsif ($page == Chirpy::UI::TOP_QUOTES) {\r
1919                 return 'top_quotes';\r
1920         }\r
1921         elsif ($page == Chirpy::UI::BOTTOM_QUOTES) {\r
1922                 return 'bottom_quotes';\r
1923         }\r
1924         elsif ($page == Chirpy::UI::QUOTES_OF_THE_WEEK) {\r
1925                 return 'quotes_of_the_week';\r
1926         }\r
1927         elsif ($page == Chirpy::UI::SINGLE_QUOTE) {\r
1928                 return 'view_quote';\r
1929         }\r
1930         elsif ($page == Chirpy::UI::QUOTE_SEARCH) {\r
1931                 return 'search_results';\r
1932         }\r
1933         elsif ($page == Chirpy::UI::TAG_CLOUD) {\r
1934                 return 'tag_cloud';\r
1935         }\r
1936         elsif ($page == Chirpy::UI::STATISTICS) {\r
1937                 return 'statistics';\r
1938         }\r
1939         elsif ($page == Chirpy::UI::MODERATION_QUEUE) {\r
1940                 return 'unmoderated_quotes';\r
1941         }\r
1942         return undef;\r
1943 }\r
1944 \r
1945 sub _get_cookie {\r
1946         my ($self, $name) = @_;\r
1947         return $self->{'cgi'}->cookie(-name => $name);\r
1948 }\r
1949 \r
1950 sub _set_cookie {\r
1951         my ($self, $name, $value, $expires) = @_;\r
1952         my $cookie = $self->{'cgi'}->cookie(\r
1953                 -name => $name,\r
1954                 -value => $value, -expires => $expires,\r
1955                 -domain => $self->param('cookie_domain'),\r
1956                 -path => $self->param('cookie_path')\r
1957         );\r
1958         push @{$self->{'cookies'}}, $cookie;\r
1959 }\r
1960 \r
1961 sub _output_xml {\r
1962         my ($self, $root, $data) = @_;\r
1963         $self->_print_http_header('text/xml');\r
1964         print '<?xml version="1.0" encoding="UTF-8"?>', $/;\r
1965         print &_to_xml($data, $root);\r
1966 }\r
1967 \r
1968 sub _to_xml {\r
1969         my ($elem, $key) = @_;\r
1970         my $content;\r
1971         if (!defined $elem) {\r
1972                 $content = '';\r
1973         }\r
1974         elsif (my $ref = ref $elem) {\r
1975                 if ($ref eq 'ARRAY') {\r
1976                         return join('', map { &_to_xml($_, $key) } @$elem);\r
1977                 }\r
1978                 elsif ($ref eq 'HASH') {\r
1979                         while (my ($key, $value) = each %$elem) {\r
1980                                 $content .= &_to_xml($value, $key);\r
1981                         }\r
1982                 }\r
1983                 else {\r
1984                         Chirpy::die('Serialization error');\r
1985                 }\r
1986         }\r
1987         else {\r
1988                 $content = $elem;\r
1989         }\r
1990         return '<' . $key . '>' . $content . '</' . $key . '>';\r
1991 }\r
1992 \r
1993 sub _load_template {\r
1994         my ($self, $name) = @_;\r
1995         my $template = new HTML::Template(\r
1996                 'filename' => $self->{'templates_path'} . '/' . $name . '.html',\r
1997                 'die_on_bad_params' => 0,\r
1998                 'global_vars' => 1,\r
1999                 'file_cache' => 1,\r
2000                 'file_cache_dir' => $self->_template_cache_path(),\r
2001                 'file_cache_dir_mode' => 0777\r
2002         );\r
2003         Chirpy::die('Failed to load template: ' . $!) unless ($template);\r
2004         return $template;\r
2005 }\r
2006 \r
2007 sub _output_template {\r
2008         my ($self, $template) = @_;\r
2009         my $output = $self->_process_template($template);\r
2010         my $ctype = 'application/xhtml+xml';\r
2011         if ($output =~ m#^<!DOCTYPE\b[^>]*\bXHTML 1\.1\b[^>]*>#\r
2012                 && $self->_accepts($ctype)) {\r
2013                         $output = '<?xml version="1.0" encoding="UTF-8"?>' . $/\r
2014                                 . $output;\r
2015         }\r
2016         else {\r
2017                 $ctype = 'text/html';\r
2018         }\r
2019         $self->_maybe_gzip($output, $ctype);\r
2020 }\r
2021 \r
2022 sub _maybe_gzip {\r
2023         my ($self, $content, $ctype, %headers) = @_;\r
2024         my $accenc = $self->{'cgi'}->http('Accept-Encoding');\r
2025         if (!defined $self->parent()->debug_events()\r
2026         && $self->param('enable_gzip')\r
2027         && defined $accenc && $accenc =~ /\bgzip\b/i) {\r
2028                 require Compress::Zlib;\r
2029                 $self->_print_http_header($ctype,\r
2030                         'Content-Encoding' => 'gzip', %headers);\r
2031                 print Compress::Zlib::memGzip($content);\r
2032         }\r
2033         else {\r
2034                 $self->_print_http_header($ctype, %headers);\r
2035                 binmode(STDOUT, ':utf8');\r
2036                 print $content;\r
2037         }\r
2038 }\r
2039 \r
2040 sub _print_http_header {\r
2041         my ($self, $ctype, %headers) = @_;\r
2042         print $self->{'cgi'}->header(-type => $ctype . '; charset=UTF-8',\r
2043                 -cookie => $self->{'cookies'},\r
2044                 %headers);\r
2045 }\r
2046 \r
2047 # TODO: make this faster\r
2048 sub _process_template {\r
2049         my ($self, $template) = @_;\r
2050         my $locale = $self->locale();\r
2051         my $url = &_text_to_xhtml(Chirpy::URL);\r
2052         my $link = '<a href="' . $url . '">' . Chirpy::FULL_PRODUCT_NAME . '</a>';\r
2053         $template->param('CHIRPY_PRODUCT_NAME' => Chirpy::PRODUCT_NAME);\r
2054         $template->param('CHIRPY_VERSION' => Chirpy::VERSION_STRING);\r
2055         $template->param('CHIRPY_FULL_PRODUCT_NAME' => Chirpy::FULL_PRODUCT_NAME);\r
2056         $template->param('CHIRPY_URL' => $url);\r
2057         $template->param('CHIRPY_LINK' => $link);\r
2058         $template->param('SITE_TITLE'\r
2059                 => &_text_to_xhtml($self->configuration()\r
2060                         ->get('general', 'title')));\r
2061         $template->param('SITE_URL' => $self->_url());\r
2062         $template->param('WEBMASTER_EMAIL'\r
2063                 => sub { return &_hide_email($self->param('webmaster_email')) });\r
2064         my $page = $self->get_current_page();\r
2065         if ($self->param('enable_feeds')) {\r
2066                 my $page_feed = $self->_page_feed($page);\r
2067                 if (defined $page_feed) {\r
2068                         my $ft = &_text_to_xhtml(\r
2069                                 $locale->get_string(&_get_page_name($page_feed)));\r
2070                         # TODO: Don't assume QotW is the default, perhaps make _page_feed\r
2071                         # supply action\r
2072                         my $action = ($page_feed == Chirpy::UI::QUOTES_OF_THE_WEEK\r
2073                                 ? ACTIONS->{'QUOTES_OF_THE_WEEK'}\r
2074                                 : $self->_action());\r
2075                         $template->param('FEEDS' => [\r
2076                                 {\r
2077                                         'FEED_URL' => $self->_feed_url($action, 'rss'),\r
2078                                         'FEED_TITLE' => $ft . ' (RSS 2.0)',\r
2079                                         'FEED_MIME_TYPE' => 'application/rss+xml'\r
2080                                 },\r
2081                                 {\r
2082                                         'FEED_URL' => $self->_feed_url($action, 'atom'),\r
2083                                         'FEED_TITLE' => $ft . ' (Atom 1.0)',\r
2084                                         'FEED_MIME_TYPE' => 'application/atom+xml'\r
2085                                 }\r
2086                         ]);\r
2087                 }\r
2088         }\r
2089         if ($self->_page_offers_microsummary($page)) {\r
2090                 $template->param('MICROSUMMARIES' => [\r
2091                         {\r
2092                                 'MICROSUMMARY_URL' => $self->_microsummary_url($self->_action())\r
2093                         }\r
2094                 ]);\r
2095         }\r
2096         $template->param('APPROVED_QUOTE_COUNT' => sub {\r
2097                 return $self->parent()->approved_quote_count();\r
2098         });\r
2099         $template->param('UNAPPROVED_QUOTE_COUNT' => sub {\r
2100                 return $self->parent()->unapproved_quote_count();\r
2101         });\r
2102         $template->param('TOTAL_QUOTE_COUNT' => sub {\r
2103                 return $self->parent()->total_quote_count();\r
2104         });\r
2105         $template->param('COOKIE_DOMAIN' => sub { return &_text_to_xhtml(\r
2106                 $self->param('cookie_domain')) });\r
2107         $template->param('COOKIE_PATH' => sub { return &_text_to_xhtml(\r
2108                 $self->param('cookie_path')) });\r
2109         $template->param('RESOURCES_URL' => sub { return &_text_to_xhtml(\r
2110                 $self->_resources_url()) });\r
2111         foreach my $action (keys %{ACTIONS()}) {\r
2112                 $template->param($action . '_URL'\r
2113                         => $self->_url(ACTIONS->{$action}));\r
2114                 foreach my $string (qw(DESCRIPTION SHORT_TITLE)) {\r
2115                         my $name = $action . '_' . $string;\r
2116                         $template->param($name => &_text_to_xhtml(\r
2117                                 $locale->get_string(\r
2118                                         ($action eq 'START_PAGE' ? 'webapp.' : '')\r
2119                                         . lc $name)));\r
2120                 }\r
2121         }\r
2122         $template->param('NEXT_PAGE_TITLE', sub { return &_text_to_xhtml(\r
2123                 $locale->get_string('webapp.next_page_title')) });\r
2124         $template->param('PREVIOUS_PAGE_TITLE', sub { return &_text_to_xhtml(\r
2125                 $locale->get_string('webapp.previous_page_title')) });\r
2126         $template->param('MODERATION_QUEUE_PUBLIC' => 1)\r
2127                 if ($self->moderation_queue_is_public());\r
2128         if (my $account = $self->get_logged_in_user_account()) {\r
2129                 $template->param('LOGGED_IN' => 1);\r
2130                 $template->param('LOGGED_IN_NOTICE' => &_text_to_xhtml(\r
2131                         $locale->get_string(\r
2132                                 'logged_in_as', $account->get_username(),\r
2133                                 $self->parent()->user_level_name($account->get_level()))));\r
2134         }\r
2135         $template->param(\r
2136                 'SEARCH_FORM_START' => ($self->param('enable_short_urls')\r
2137                         ? '<form method="get" action="'\r
2138                                 . $self->_url(ACTIONS->{'QUOTE_SEARCH'}) . '">'\r
2139                         : '<form method="get" action="' . $self->_url() . '">'\r
2140                                 . '<input type="hidden" name="action" value="'\r
2141                                 . ACTIONS->{'QUOTE_SEARCH'} . '" />'),\r
2142                 'SEARCH_FORM_END' => '</form>',\r
2143                 'SEARCH_QUERY_LABEL' => &_text_to_xhtml(\r
2144                         $locale->get_string('search_query_title')),\r
2145                 'SUBMIT_SEARCH_LABEL' => &_text_to_xhtml(\r
2146                         $locale->get_string('search_button_label'))\r
2147         );\r
2148         $template->param('FOOTER_TEXT' => ($self->parent()->timing_enabled()\r
2149                 ? sub {\r
2150                         (my $str = &_text_to_xhtml(\r
2151                                 $locale->get_string('webapp.footer_text',\r
2152                                         sprintf('%.0f', 1000 * $self->parent()->total_time()),\r
2153                                         "\0"))) =~ s/\0/$link/g;\r
2154                         return $str;\r
2155                 }\r
2156                 : sub {\r
2157                         (my $str = &_text_to_xhtml(\r
2158                                 $locale->get_string('webapp.footer_text_no_time', "\0")))\r
2159                                         =~ s/\0/$link/g;\r
2160                         return $str;\r
2161                 })\r
2162         );\r
2163         return $template->output();\r
2164 }\r
2165 \r
2166 sub _template_cache_path {\r
2167         my $self = shift;\r
2168         my $path = $self->configuration()->get('general', 'base_path')\r
2169                 . '/cache/template';\r
2170         Chirpy::Util::ensure_writable_directory($path);\r
2171         return $path;\r
2172 }\r
2173 \r
2174 sub _text_to_xhtml {\r
2175         my ($str, $leave_whitespaces) = @_;\r
2176         return undef unless (defined $str);\r
2177         return '' if ($str eq '');\r
2178         $str = Chirpy::Util::encode_xml_entities($str);\r
2179         $str = &_whitespaces_to_xhtml($str) unless ($leave_whitespaces);\r
2180         return $str;\r
2181 }\r
2182 \r
2183 sub _whitespaces_to_xhtml {\r
2184         my $str = shift;\r
2185         $str =~ s|\r?\n([ \t]*)|"<br/>\n" . ('&#xA0;' x length($1))|eg;\r
2186         $str =~ s/([ \t]{2,})/'&#xA0;' x length($1)/eg;\r
2187         $str =~ s/^([ \t]+)/'&#xA0;' x length($1)/eg;\r
2188         $str =~ s/([ \t]+)$/'&#xA0;' x length($1)/eg;\r
2189         return $str;\r
2190 }\r
2191 \r
2192 sub _quick_style_to_xhtml {\r
2193         my ($string, $quote_url_template) = @_;\r
2194         $string = &_text_to_xhtml($string, 1);\r
2195         $string =~ s{\r
2196                 &lt;\r
2197                 \s*\r
2198                 (\r
2199                         (?:mailto:|(?:https?|ftp|irc)://)\r
2200                         .*?\r
2201                 )\r
2202                 (?:\r
2203                         \s+\r
2204                         (.*?)\r
2205                 )?\r
2206                 &gt;\r
2207         }{\r
2208                 my ($url, $description) = ($1, $2);\r
2209                 unless (defined $description && $description ne '') {\r
2210                         $description = $url;\r
2211                 }\r
2212                 '<a href="' . $url . '">' . $description . '</a>';\r
2213         }esgx;\r
2214         $string = &_whitespaces_to_xhtml($string);\r
2215         1 while $string =~ s{([*_])(.*?)\1}{\r
2216                 my $tag = ($1 eq '*' ? 'strong' : 'em');\r
2217                 '<' . $tag . '>' . $2 . '</' . $tag . '>';\r
2218         }esg;\r
2219         if (defined $quote_url_template) {\r
2220                 $quote_url_template = &_text_to_xhtml($quote_url_template);\r
2221                 $string =~ s{ (#(\d+))}{\r
2222                         my ($text, $id) = ($1, $2);\r
2223                         (my $url = $quote_url_template) =~ s/\0/$id/g;\r
2224                         ' <a href="' . $url . '">' . $text . '</a>';\r
2225                 }eig;\r
2226         }\r
2227         return $string;\r
2228 }\r
2229 \r
2230 sub _quote_already_rated_text {\r
2231         my $self = shift;\r
2232         my $conf = $self->configuration();\r
2233         return $self->locale()->get_string('quote_already_rated');\r
2234 }\r
2235 \r
2236 sub _quote_rating_limit_text {\r
2237         my $self = shift;\r
2238         my $conf = $self->configuration();\r
2239         return $self->locale()->get_string(\r
2240                 'quote_rating_limit_exceeded',\r
2241                         $conf->get('general', 'rating_limit_count'),\r
2242                         $conf->get('general', 'rating_limit_time'));\r
2243 }\r
2244 \r
2245 # XXX: Move to Chirpy::Util?\r
2246 sub _format_date_time_rfc822 {\r
2247         my $timestamp = shift;\r
2248         my @parts = split /\s+/, gmtime($timestamp);\r
2249         return $parts[0] . ', ' . $parts[2] . ' ' . $parts[1] . ' ' . $parts[4]\r
2250                 . ' ' . $parts[3] . ' +0000';\r
2251 }\r
2252 \r
2253 # XXX: Move to Chirpy::Util?\r
2254 sub _format_date_time_iso8601 {\r
2255         my $timestamp = shift;\r
2256         my @time = gmtime($timestamp);\r
2257         return sprintf('%04d-%02d-%02dT%02d:%02d:%02dZ',\r
2258                 1900 + $time[5], $time[4] + 1, $time[3],\r
2259                 $time[2], $time[1], $time[0]);\r
2260 }\r
2261 \r
2262 sub _format_quote {\r
2263         my ($self, $quote) = @_;\r
2264         my $body = &_text_to_xhtml($quote->get_body());\r
2265         my $notes = &_text_to_xhtml($quote->get_notes());\r
2266         my $tags = $self->_link_tags($quote);\r
2267         if ($self->configuration()->get('ui', 'webapp.enable_autolink')) {\r
2268                 $body = &_auto_link($body);\r
2269                 $notes = &_auto_link($notes);\r
2270         }\r
2271         else {\r
2272                 $body = &_spam_protect_email_addresses($body);\r
2273                 $notes = &_spam_protect_email_addresses($notes);\r
2274         }\r
2275         return ($body, $notes, $tags);\r
2276 }\r
2277 \r
2278 sub _auto_link {\r
2279         my ($html, $no_antispam) = @_;\r
2280         return undef unless (defined $html);\r
2281         $no_antispam = 0 unless (defined $no_antispam);\r
2282         # &amp; is the only entity we allow in URLs, so we temporarily replace all\r
2283         # of them with null bytes\r
2284         $html =~ s/&amp;/\0/ig;\r
2285         $html =~ s{\r
2286                 \b\r
2287                 ((?:https?|ftp|irc)://[^\s&<>()\[\]\{\}]+)\r
2288                 |([a-z0-9._\-\+]+\@[a-z0-9][a-z0-9\-.]+\.[a-z0-9]+)\r
2289         }{\r
2290                 my ($href, $text);\r
2291                 if (defined $2) {\r
2292                         $text = ($no_antispam ? $2 : &_hide_email($2));\r
2293                         $href = 'mailto:' . $text;\r
2294                 }\r
2295                 else {\r
2296                         $text = $href = $1;\r
2297                 }\r
2298                 '<a href="' . $href . '">' . $text . '</a>';\r
2299         }eigx;\r
2300         $html =~ s/\0/&amp;/g;\r
2301         return $html;\r
2302 }\r
2303 \r
2304 sub _spam_protect_email_addresses {\r
2305         my $html = shift;\r
2306         $html =~ s/((?:mailto:)?([\w\.\+]+\@\S+\.\w+))/&_hide_email($1)/eig;\r
2307         return $html;\r
2308 }\r
2309 \r
2310 sub _hide_email {\r
2311         my $email = shift;\r
2312         $email =~ s{(.)}{\r
2313                 my $n = ord $1;\r
2314                 '&#' . (int rand 2 ? sprintf('x%X', $n) : $n) . ';';\r
2315         }eg;\r
2316         return $email;\r
2317 }\r
2318 \r
2319 sub _format_news_body {\r
2320         my ($self, $body) = @_;\r
2321         # TODO: Make all this a little more efficient\r
2322         $body = &_quick_style_to_xhtml(\r
2323                 $body,\r
2324                 $self->_quote_url("\0")\r
2325         );\r
2326         my @paragraphs = split(/(?:<\s*br\s*\/\s*>\s*){2,}/, $body);\r
2327         return join("\n", map { '<p>' . &_fix_xml($_) . '</p>' } @paragraphs);\r
2328 }\r
2329 \r
2330 sub _fix_xml {\r
2331         my $xml = shift;\r
2332         my @stack = ();\r
2333         my $out = '';\r
2334         while ($xml =~ s|^([^<]*)<\s*(/?)(\w*)(.*?)(/?)>||sg) {\r
2335                 my ($text, $closing, $element, $attributes, $selfclosing)\r
2336                         = ($1, $2, $3, $4, $5);\r
2337                 if (length($selfclosing)) {\r
2338                         $out .= $&;\r
2339                 }\r
2340                 elsif (!length($closing)) {\r
2341                         push @stack, $element;\r
2342                         $out .= $&;\r
2343                 }\r
2344                 elsif ($stack[-1] eq $element) {\r
2345                         pop @stack;\r
2346                         $out .= $text . '</' . $element . '>';\r
2347                 }\r
2348                 else {\r
2349                         $out .= $text;\r
2350                 }\r
2351         }\r
2352         $out .= $xml;\r
2353         while (my $element = pop @stack) {\r
2354                 $out .= '</' . $element . '>'; \r
2355         }\r
2356         return $out;\r
2357 }\r
2358 \r
2359 sub _link_tags {\r
2360         my ($self, $quote) = @_;\r
2361         my $tags = $quote->get_tags();\r
2362         return [] unless (defined $tags && @$tags);\r
2363         my @out = ();\r
2364         foreach my $tag (sort @$tags) {\r
2365                 my $title = $self->locale()->get_string('tag_link_description', $tag);\r
2366                 push @out, {\r
2367                         'TAG' => &_text_to_xhtml($tag),\r
2368                         'URL' => &_text_to_xhtml($self->_tag_url($tag)),\r
2369                         'LINK_DESCRIPTION' => &_text_to_xhtml($title)\r
2370                 };\r
2371         }\r
2372         return \@out;\r
2373 }\r
2374 \r
2375 sub _cgi_params {\r
2376         my $self = shift;\r
2377         return $self->{'cgi'}->param();\r
2378 }\r
2379 \r
2380 sub _cgi_param {\r
2381         my ($self, $param) = @_;\r
2382         return $self->{'cgi'}->param($param);\r
2383 }\r
2384 \r
2385 sub _url_params {\r
2386         my $self = shift;\r
2387         return $self->{'cgi'}->url_param();\r
2388 }\r
2389 \r
2390 sub _url_param {\r
2391         my ($self, $param) = @_;\r
2392         return $self->{'cgi'}->url_param($param);\r
2393 }\r
2394 \r
2395 sub _is_post {\r
2396         my $self = shift;\r
2397         return $self->_http_request_method() eq 'POST';\r
2398 }\r
2399 \r
2400 sub _http_request_method {\r
2401         my $self = shift;\r
2402         return uc $self->{'cgi'}->request_method();\r
2403 }\r
2404 \r
2405 sub _accepts {\r
2406         my $self = shift;\r
2407         my $type = lc shift;\r
2408         foreach my $a ($self->{'cgi'}->Accept()) {\r
2409                 return 1 if (lc($a) eq $type);\r
2410         }\r
2411         return 0;\r
2412 }\r
2413 \r
2414 sub _session {\r
2415         my $self = shift;\r
2416         return $self->{'session'};\r
2417 }\r
2418 \r
2419 sub _captcha_provider {\r
2420         my ($self, $hash) = @_;\r
2421         unless ($self->{'captcha'}) {\r
2422                 my $p = $self->param('captcha_provider');\r
2423                 return undef unless (defined $p);\r
2424                 my $class = 'Chirpy::UI::WebApp::Captcha::' . $p;\r
2425                 my $provider;\r
2426                 eval qq{\r
2427                         use $class;\r
2428                         \$provider = new $class(\$self);\r
2429                 };\r
2430                 Chirpy::die('Failed to load captcha provider "' . $p . '": ' . $@)\r
2431                         if ($@ || !defined $provider);\r
2432                 $self->{'captcha'} = $provider;\r
2433         }\r
2434         $self->{'captcha'}->hash($hash);\r
2435         return $self->{'captcha'};\r
2436 }\r
2437 \r
2438 sub _resources_url {\r
2439         my $self = shift;\r
2440         return $self->param('resources_url') . '/themes/' . $self->param('theme');\r
2441 }\r
2442 \r
2443 sub _feed_url {\r
2444         my ($self, $action, $type) = @_;\r
2445         return ($self->param('enable_short_urls')\r
2446                 # TODO: Update _url() for feeds\r
2447                 ? $self->_url($type . '/' . $action)\r
2448                 : $self->_url($action, undef, 'output' => $type));\r
2449 }\r
2450 \r
2451 sub _microsummary_url {\r
2452         my ($self, $action) = @_;\r
2453         return ($self->param('enable_short_urls')\r
2454                 # TODO: Update _url() for microsummaries\r
2455                 ? $self->_url('ms/' . $action)\r
2456                 : $self->_url($action, undef, 'output' => 'ms'));\r
2457 }\r
2458 \r
2459 sub _quote_url {\r
2460         my ($self, $id) = @_;\r
2461         return ($self->param('enable_short_urls')\r
2462                 ? $self->_url() . $id\r
2463                 : $self->_url(undef, undef, 'id' => $id));\r
2464 }\r
2465 \r
2466 sub _tag_url {\r
2467         my ($self, $tag) = @_;\r
2468         return $self->_url(ACTIONS->{'QUOTE_SEARCH'}, undef,\r
2469                 'query' => 'tag:' . $tag);\r
2470 }\r
2471 \r
2472 sub _url {\r
2473         my ($self, $action, $admin, %params) = @_;\r
2474         my $string;\r
2475         if (%params) {\r
2476                 require URI::Escape;\r
2477                 $string = join '&', map {\r
2478                         URI::Escape::uri_escape($_)\r
2479                                 . '=' . URI::Escape::uri_escape($params{$_})\r
2480                 } keys %params;\r
2481         }\r
2482         my $url = &_text_to_xhtml($self->param('site_url')\r
2483                 . ($self->param('enable_short_urls')\r
2484                         ? ($admin ? '/' . ACTIONS->{'ADMINISTRATION'} : '')\r
2485                                 . ($action ? '/' . $action : (!$admin ? '/' : ''))\r
2486                                 . (defined $string ? '?' . $string : '')\r
2487                         : '/index.cgi?' . ($admin\r
2488                                 ? 'action=' . ACTIONS->{'ADMINISTRATION'}\r
2489                                         . ($action\r
2490                                                 ? '&admin_action=' . $action\r
2491                                                         . (defined $string ? '&' : '')\r
2492                                                 : '')\r
2493                                 : ($action\r
2494                                         ? 'action=' . $action . (defined $string ? '&' : '')\r
2495                                         : '')\r
2496                                 ) . (defined $string ? $string : '')\r
2497                         )\r
2498                 );\r
2499 }\r
2500 \r
2501 sub _action {\r
2502         my $self = shift;\r
2503         return $self->_url_param('action') || $self->_cgi_param('action');\r
2504 }\r
2505 \r
2506 sub _admin_action {\r
2507         my $self = shift;\r
2508         return $self->_url_param('admin_action')\r
2509                 || $self->_cgi_param('admin_action');\r
2510 }\r
2511 \r
2512 sub _output_type {\r
2513         my $self = shift;\r
2514         return $self->_url_param('output') || $self->_cgi_param('output');\r
2515 }\r
2516 \r
2517 sub _id {\r
2518         my $self = shift;\r
2519         my $id = $self->_url_param('id');\r
2520         $id = $self->_cgi_param('id') unless (defined $id);\r
2521         return undef unless (defined $id);\r
2522         return eval $id if ($id =~ /^0(?:x[0-9A-Fa-f]+|b[01]+)+$/);\r
2523         return $id;\r
2524 }\r
2525 \r
2526 sub _wants_microsummary {\r
2527         my $self = shift;\r
2528         my $ot = $self->_output_type();\r
2529         return (defined $ot && $ot eq 'ms');\r
2530 }\r
2531 \r
2532 sub _wants_xml {\r
2533         my $self = shift;\r
2534         my $ot = $self->_output_type();\r
2535         return (defined $ot && $ot eq 'xml');\r
2536 }\r
2537 \r
2538 sub _feed_type {\r
2539         my $self = shift;\r
2540         my $type = $self->_output_type();\r
2541         return ($self->param('enable_feeds') && &_valid_feed_type($type)\r
2542                 ? $type : undef);\r
2543 }\r
2544 \r
2545 sub _valid_feed_type {\r
2546         my $type = shift;\r
2547         return (defined $type && ($type eq 'atom' || $type eq 'rss'));\r
2548 }\r
2549 \r
2550 sub _page_feed {\r
2551         my ($self, $page) = @_;\r
2552         if ($page == Chirpy::UI::START_PAGE\r
2553         || $page == Chirpy::UI::QUOTE_BROWSER\r
2554         || $page == Chirpy::UI::QUOTES_OF_THE_WEEK) {\r
2555                 return Chirpy::UI::QUOTES_OF_THE_WEEK;\r
2556         }\r
2557         # TODO: Provide feeds for searches\r
2558         if ($page == Chirpy::UI::RANDOM_QUOTES\r
2559         || $page == Chirpy::UI::TOP_QUOTES\r
2560         || $page == Chirpy::UI::BOTTOM_QUOTES\r
2561         || $page == Chirpy::UI::MODERATION_QUEUE) {\r
2562                 return $page;\r
2563         }\r
2564         return undef;\r
2565 }\r
2566 \r
2567 sub _page_offers_microsummary {\r
2568         my ($self, $page) = @_;\r
2569         return ($page == Chirpy::UI::QUOTE_BROWSER\r
2570                 || $page == Chirpy::UI::TOP_QUOTES\r
2571                 || $page == Chirpy::UI::BOTTOM_QUOTES\r
2572                 || $page == Chirpy::UI::MODERATION_QUEUE\r
2573                 || $page == Chirpy::UI::QUOTES_OF_THE_WEEK);\r
2574 }\r
2575 \r
2576 sub _requires_session {\r
2577         my $page = shift;\r
2578         return ($page == Chirpy::UI::QUOTE_RATING_UP\r
2579                 || $page == Chirpy::UI::QUOTE_RATING_DOWN\r
2580                 || $page == Chirpy::UI::REPORT_QUOTE\r
2581                 || $page == Chirpy::UI::LOGIN\r
2582                 || $page == Chirpy::UI::LOGOUT\r
2583                 || $page == Chirpy::UI::ADMINISTRATION);\r
2584 }\r
2585 \r
2586 sub _requires_captcha {\r
2587         my $self = shift;\r
2588         return (defined $self->param('captcha_provider')\r
2589                 && !defined $self->get_logged_in_user_account());\r
2590 }\r
2591 \r
2592 1;\r
2593 \r
2594 ###############################################################################