moved qdb here because matt is lazy
[public/www-new.git] / pub / qdb / src / modules / Chirpy.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:: Chirpy.pm 291 2007-02-05 21:24:46Z ceetee                           $ #\r
22 ###############################################################################\r
23 \r
24 =head1 NAME\r
25 \r
26 Chirpy - Main coordination class\r
27 \r
28 =head1 REQUIREMENTS\r
29 \r
30 Chirpy! uses the UTF-8 character encoding, and because of that, I<Perl 5.8> is\r
31 required. A lot of systems still have Perl 5.6 and, unfortunately, Chirpy! will\r
32 not run there. This might change in future releases.\r
33 \r
34 It also relies on a couple of Perl modules, most of which are part of standard\r
35 Perl distributions. The base classes require these modules:\r
36 \r
37  Carp\r
38  Digest::MD5\r
39  Encode\r
40  POSIX\r
41  Storable\r
42 \r
43 Additionally, the default data manager and user interface classes have their\r
44 own requirements. Before using them, please consult\r
45 L<the data manager's requirements|Chirpy::DataManager::MySQL/REQUIREMENTS>\r
46 and L<the user interface's requirements|Chirpy::UI::WebApp/REQUIREMENTS>.\r
47 \r
48 =head1 SYNOPSIS\r
49 \r
50  use Chirpy 0.3;\r
51  \r
52  chirpy();\r
53 \r
54  chirpy($configuration_file, $data_manager_type);\r
55  \r
56  $chirpy = new Chirpy();\r
57  $chirpy->run();\r
58 \r
59  $chirpy = new Chirpy($configuration_file, $data_manager_type);\r
60  $chirpy->run();\r
61 \r
62 =head1 DESCRIPTION\r
63 \r
64 This module is Chirpy!'s main coordination class and the only one that scripts\r
65 that use it should access directly. Everything else is part of the inner\r
66 workings of Chirpy!.\r
67 \r
68 An instance of this module really represents an entire Chirpy! configuration,\r
69 along with everything it uses at runtime. This means that you can have several\r
70 instances of it simultaneously and exchange information between them.\r
71 \r
72 =head1 USAGE\r
73 \r
74 There are two ways to use the class:\r
75 \r
76 =over 4\r
77 \r
78 =item Procedural Interface\r
79 \r
80 The easiest way is to just run the C<chirpy()> procedure, which is exported by\r
81 default. The code below will attempt to run Chirpy! with a configuration file\r
82 located at either of the default paths F<src/chirpy.ini> and F<chirpy.ini>,\r
83 relative to the current working directory.\r
84 \r
85  chirpy;\r
86 \r
87 That's it! Now, if you wanted to specify your own configuration file, you would\r
88 just pass it as the first parameter, like so:\r
89  \r
90  chirpy('/home/joe/chirpy.ini');\r
91 \r
92 The path can also be relative, but make sure the working directory is correct.\r
93 \r
94 =item Object-Oriented Interface\r
95 \r
96 As you may want to distinguish between different installations, you can have\r
97 several instances of this module in the same script. Instantiating the module\r
98 is a lot like invoking C<chirpy()>, except that it doesn't create and run the\r
99 user interface instance yet.\r
100 \r
101  $chirpy = new Chirpy();\r
102 \r
103  $chirpy = new Chirpy('/home/joe/chirpy.ini');\r
104 \r
105 If you wanted to create and run the configured user interface, you would just:\r
106 \r
107  $chirpy->run();\r
108 \r
109 Simple as that.\r
110 \r
111 In addition, you can add a second parameter to the constructor to override the\r
112 data manager type specified in the configuration file, which can be useful for\r
113 migration:\r
114 \r
115  $chirpy_old = new Chirpy('/home/joe/chirpy.ini');\r
116  $chirpy_new = new Chirpy('/home/joe/chirpy.ini', 'MyNewDataManager');\r
117 \r
118 While the C<chirpy()> procedure also takes that parameter, I don't see any real\r
119 use for it.\r
120 \r
121 Note that if you want to use the default configuration file path, but with an\r
122 alternate data manager, you just pass C<undef> as the first parameter:\r
123 \r
124  $chirpy = new Chirpy(undef, 'MyNewDataManager');\r
125 \r
126 =back\r
127 \r
128 =head1 CONFIGURATION FILE\r
129 \r
130 A Chirpy! configuration file is a standard INI file, so it looks a little\r
131 something like this:\r
132 \r
133  [general]\r
134  title=My Little QDB\r
135  description=A place for my quotes\r
136  locale=en-US\r
137  ...\r
138 \r
139  [data]\r
140  type=MySQL\r
141  ...\r
142 \r
143 Chirpy! adds a third level of parameter nesting to this format by separating\r
144 the class and parameter name by a dot. For instance, the password for the\r
145 MySQL data manager is stored like:\r
146 \r
147  [data]\r
148  mysql.password=mypassword\r
149 \r
150 Now, let's go over the default configuration values.\r
151 \r
152 =head2 General Section\r
153 \r
154 The C<general> section configures ... general settings!\r
155 \r
156 =over 4\r
157 \r
158 =item base_path\r
159 \r
160 The local path (on the file system) where locales, templates, etc. are stored.\r
161 Do I<not> include a trailing slash.\r
162 \r
163 =item title\r
164 \r
165 The title of your QDB.\r
166 \r
167 =item description\r
168 \r
169 A brief description of the purpose of your QDB.\r
170 \r
171 =item locale\r
172 \r
173 The code of the locale to use.\r
174 \r
175 =item rating_limit_count\r
176 \r
177 =item rating_limit_time\r
178 \r
179 Limit the maximum number of votes per time frame using these two parameters.\r
180 The former sets the maximum number, the latter sets the time period in seconds.\r
181 \r
182 =item quote_score_calculation_mode\r
183 \r
184 Since Chirpy! 0.3, quote scores, which are used to order the quotes for the Top\r
185 and Bottom Quotes pages, are calculated using the following formula:\r
186 \r
187            positive votes + 1\r
188   score = --------------------\r
189            negative votes + 1\r
190 \r
191 This results in a fairly decent distribution. However, if you prefer the old\r
192 way, based on a quote's rating, i.e.\r
193 \r
194   rating = positive votes - negative votes\r
195 \r
196 you can set C<quote_score_calculation_mode> to C<1>. Note that the default way\r
197 corresponds with a value of C<0>; this value may correspond with a different\r
198 formula in future releases.\r
199 \r
200 =back\r
201 \r
202 =head2 Data Section\r
203 \r
204 The C<data> section configures everything related to the data manager, or the\r
205 backend, if you will.\r
206 \r
207 This section only has one default parameter, namely C<type>. It contains the\r
208 name of the data manager to use. This will be translated to\r
209 C<Chirpy::DataManager::I<Name>>, so that module will need to be installed.\r
210 \r
211 Apart from that, there are parameters specific to the data manager of your\r
212 choice. Please refer to its documentation for an explanation. If you use the\r
213 default data manager, L<MySQL|Chirpy::DataManager::MySQL>, you can find the\r
214 parameters in L<its documentation|Chirpy::DataManager::MySQL/CONFIGURATION>.\r
215 \r
216 =head2 UI Section\r
217 \r
218 The C<ui> section configures the frontend or user interface. It includes these\r
219 parameters by default:\r
220 \r
221 =over 4\r
222 \r
223 =item type\r
224 \r
225 Similar to the C<type> parameter under the C<data> section, this one sets the\r
226 name of the user interface module and will be translated to\r
227 C<Chirpy::UI::I<Name>>.\r
228 \r
229 =item date_time_format\r
230 \r
231 The string that describes the format in which to display a date along with the\r
232 time. This string is passed to the C<strftime> method of\r
233 L<the POSIX module|POSIX>.\r
234 \r
235 =item date_format\r
236 \r
237 Similar to the above, but for dates only.\r
238 \r
239 =item time_format\r
240 \r
241 Similar to the above, but for times only.\r
242 \r
243 =item use_gmt\r
244 \r
245 Set this parameter to 0 if you wish to display times in local time instead of\r
246 Greenwich Mean Time. For GMT, set it to 1.\r
247 \r
248 =item quotes_per_page\r
249 \r
250 The maximum number of quotes to display per page.\r
251 \r
252 =item recent_news_items\r
253 \r
254 How many news items to display on the home page.\r
255 \r
256 =item moderation_queue_public\r
257 \r
258 Set this to C<1> if you want to make the list of unmoderated quotes available to\r
259 the public. To hide the list from everybody except moderators, set it to 0.\r
260 \r
261 =item tag_cloud_logarithmic\r
262 \r
263 Set this to C<1> if you want to determine the tag cloud's font sizes using a\r
264 logarithmic algorithm instead of a linear one. Most people will probably prefer\r
265 this, as it gives better results if some of the tags are used extremely often.\r
266 \r
267 =back\r
268 \r
269 Apart from that, there are parameters specific to the user interface of your\r
270 choice. Please refer to its documentation for an explanation. If you use the\r
271 default user interface, L<WebApp|Chirpy::UI::WebApp>, you can find the\r
272 parameters in L<its documentation|Chirpy::UI::WebApp/CONFIGURATION>.\r
273 \r
274 =head1 AUTHOR\r
275 \r
276 Tim De Pauw E<lt>ceetee@users.sourceforge.netE<gt>\r
277 \r
278 =head1 SEE ALSO\r
279 \r
280 L<Chirpy::DataManager>, L<Chirpy::UI>, L<Chirpy::Configuration>,\r
281 L<Chirpy::Locale>, L<http://chirpy.sourceforge.net/>\r
282 \r
283 =head1 COPYRIGHT\r
284 \r
285 Copyright 2005-2007 Tim De Pauw. All rights reserved.\r
286 \r
287 This program is free software; you can redistribute it and/or modify it under\r
288 the terms of the GNU General Public License as published by the Free Software\r
289 Foundation; either version 2 of the License, or (at your option) any later\r
290 version.\r
291 \r
292 This program is distributed in the hope that it will be useful, but WITHOUT ANY\r
293 WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A\r
294 PARTICULAR PURPOSE.  See the GNU General Public License for more details.\r
295 \r
296 =cut\r
297 \r
298 package Chirpy;\r
299 \r
300 require 5.008;\r
301 \r
302 use strict;\r
303 use warnings;\r
304 require Exporter;\r
305 \r
306 BEGIN {\r
307         use vars qw($VERSION @EXPORT @ISA $DEBUG $hires_timing);\r
308         $VERSION = '0.3';\r
309         @ISA = qw(Exporter);\r
310         @EXPORT = qw(chirpy);\r
311         eval 'use Time::HiRes qw//';\r
312         $DEBUG = 0;\r
313         $hires_timing = 1 unless ($@);\r
314 }\r
315 \r
316 use constant PRODUCT_NAME => 'Chirpy!';\r
317 use constant VERSION_STRING => 'v0.3';\r
318 use constant FULL_PRODUCT_NAME => PRODUCT_NAME . ' ' . VERSION_STRING;\r
319 use constant URL => 'http://chirpy.sourceforge.net/';\r
320 \r
321 use Chirpy::Configuration 0.3;\r
322 use Chirpy::Locale 0.3;\r
323 \r
324 use Chirpy::Quote 0.3;\r
325 use Chirpy::NewsItem 0.3;\r
326 use Chirpy::Account 0.3;\r
327 use Chirpy::Event 0.3;\r
328 \r
329 use constant USER_LEVELS => [\r
330         Chirpy::Account::USER_LEVEL_9,\r
331         Chirpy::Account::USER_LEVEL_6,\r
332         Chirpy::Account::USER_LEVEL_3\r
333 ];\r
334 \r
335 use Carp qw/croak confess/;\r
336 \r
337 sub new {\r
338         my ($class, $configuration_file, $dm_override) = @_;\r
339         my $st = ($hires_timing ? Time::HiRes::time() : undef);\r
340         my $self = bless {}, $class;\r
341         $self->{'start_time'} = $st;\r
342         $self->{'debug_events'} = [] if ($DEBUG && $hires_timing);\r
343         unless (defined $configuration_file) {\r
344                 foreach my $file (qw(src/chirpy.ini chirpy.ini)) {\r
345                         next unless (-f $file);\r
346                         $configuration_file = $file;\r
347                         last;\r
348                 }\r
349                 Chirpy::die('No valid configuration file found')\r
350                         unless (defined $configuration_file);\r
351         }\r
352         $self->mark_debug_event('Load configuration');\r
353         my $configuration = new Chirpy::Configuration(\r
354                 defined $configuration_file ? $configuration_file : 'chirpy.ini');\r
355         $self->mark_debug_event('Configuration loaded');\r
356         $self->{'configuration'} = $configuration;\r
357         $self->mark_debug_event('Load locale');\r
358         my $locale = new Chirpy::Locale($configuration->get('general', 'base_path')\r
359                 . '/locales/' . $configuration->get('general', 'locale') . '.ini');\r
360         $self->mark_debug_event('Locale loaded');\r
361         $self->{'locale'} = $locale;\r
362         my $locale_version = $locale->get_target_version();\r
363         Chirpy::die('Locale outdated: wanted target version ' . $Chirpy::VERSION\r
364                 . ', got ' . $locale_version)\r
365                         unless ($locale_version ge $Chirpy::VERSION);\r
366         my $dm_type = defined $dm_override\r
367                 ? $dm_override : $configuration->get('data', 'type');\r
368         $self->{'data_manager_type'} = $dm_type;\r
369         my $dm_params = $configuration->get_parameter_hash('data', $dm_type);\r
370         $self->mark_debug_event('Create data manager');\r
371         my $dm = &_create_data_manager($dm_type, $dm_params);\r
372         $self->mark_debug_event('Data manager created');\r
373         $self->{'data_manager'} = $dm;\r
374         my $ui_type = $configuration->get('ui', 'type');\r
375         $self->{'ui_type'} = $ui_type;\r
376         return $self;\r
377 }\r
378 \r
379 sub run {\r
380         my $self = shift;\r
381         my $configuration = $self->configuration();\r
382         my $ui_type = $self->{'ui_type'};\r
383         my $ui_params = $configuration->get_parameter_hash('ui', $ui_type);\r
384         $self->mark_debug_event('Create user interface');\r
385         $self->{'ui'} = &_create_ui($ui_type, $self, $ui_params);\r
386         $self->mark_debug_event('User interface created');\r
387         $self->{'ui'}->run();\r
388 }\r
389 \r
390 sub chirpy {\r
391         new Chirpy(@_)->run();\r
392 }\r
393 \r
394 sub configuration {\r
395         my $self = shift;\r
396         return $self->{'configuration'};\r
397 }\r
398 \r
399 sub locale {\r
400         my $self = shift;\r
401         return $self->{'locale'};\r
402 }\r
403 \r
404 sub get_parameter {\r
405         my ($self, $name) = @_;\r
406         return $self->{'data_manager'}->get_parameter($name);\r
407 }\r
408 \r
409 sub set_parameter {\r
410         my ($self, $name, $value) = @_;\r
411         $self->{'data_manager'}->set_parameter($name, $value);\r
412 }\r
413 \r
414 sub user_level_name {\r
415         my ($self, $id) = @_;\r
416         $self->locale->get_string('user_level_' . $id);\r
417 }\r
418 \r
419 sub user_levels {\r
420         return @{USER_LEVELS()};\r
421 }\r
422 \r
423 sub get_quotes {\r
424         my ($self, $start, $count, $sort) = @_;\r
425         $self->mark_debug_event('Request quotes');\r
426         return $self->_data_manager()->get_quotes({\r
427                 'approved' => 1,\r
428                 'sort'     => (defined $sort ? $sort : [ [ 'id', 1 ] ]),\r
429                 'first'    => $start,\r
430                 'count'    => (defined $count ? $count : $self->quotes_per_page())\r
431         });\r
432 }\r
433 \r
434 sub approved_quote_count {\r
435         my $self = shift;\r
436         return $self->_data_manager()->quote_count({ 'approved' => 1 });\r
437 }\r
438 \r
439 sub unapproved_quote_count {\r
440         my $self = shift;\r
441         return $self->_data_manager()->quote_count({ 'approved' => 0 });\r
442 }\r
443 \r
444 sub total_quote_count {\r
445         my $self = shift;\r
446         return $self->_data_manager()->quote_count();\r
447 }\r
448 \r
449 sub get_matching_quotes {\r
450         my ($self, $start, $queries, $tags) = @_;\r
451         return $self->_data_manager()->get_quotes({\r
452                 'approved' => 1,\r
453                 'contains' => $queries,\r
454                 'sort'     => [ [ 'id', 1 ] ],\r
455                 'first'    => $start,\r
456                 'count'    => $self->quotes_per_page(),\r
457                 'tags'     => $tags\r
458         });\r
459 }\r
460 \r
461 sub get_quotes_of_the_week {\r
462         my ($self, $start) = @_;\r
463         return $self->_data_manager()->get_quotes({\r
464                 'approved' => 1,\r
465                 'since'    => time - 7 * 24 * 60 * 60,\r
466                 'sort'     => [ [ 'id', 1 ] ],\r
467                 'first'    => $start,\r
468                 'count'    => $self->quotes_per_page()\r
469         });\r
470 }\r
471 \r
472 sub get_quote {\r
473         my ($self, $id) = @_;\r
474         return undef unless (defined $id);\r
475         my $quotes = $self->_data_manager()->get_quotes({\r
476                 'id'       => $id\r
477         });\r
478         return undef unless (defined $quotes);\r
479         return $quotes->[0];\r
480 }\r
481 \r
482 sub get_random_quotes {\r
483         my $self = shift;\r
484         return $self->_data_manager()->get_quotes({\r
485                 'approved' => 1,\r
486                 'count'    => $self->quotes_per_page(),\r
487                 'random'   => 1\r
488         });\r
489 }\r
490 \r
491 sub get_top_quotes {\r
492         my ($self, $start) = @_;\r
493         my $cm = $self->quote_score_calculation_mode();\r
494         return $self->_data_manager()->get_quotes({\r
495                 'approved' => 1,\r
496                 'sort'     => [ [ ($cm == 1 ? 'rating' : 'score'), 1 ], [ 'id', 1 ] ],\r
497                 'first'    => $start,\r
498                 'count'    => $self->quotes_per_page()\r
499         });\r
500 }\r
501 \r
502 sub get_bottom_quotes {\r
503         my ($self, $start) = @_;\r
504         my $cm = $self->quote_score_calculation_mode();\r
505         return $self->_data_manager()->get_quotes({\r
506                 'approved' => 1,\r
507                 'sort'     => [ [ ($cm == 1 ? 'rating' : 'score'), 0 ], [ 'id', 1 ] ],\r
508                 'first'    => $start,\r
509                 'count'    => $self->quotes_per_page()\r
510         });\r
511 }\r
512 \r
513 sub get_flagged_quotes {\r
514         my ($self, $start) = @_;\r
515         return $self->_data_manager()->get_quotes({\r
516                 'flagged' => 1,\r
517                 'sort'    => [ [ 'id', 1 ] ],\r
518                 'first'    => $start,\r
519                 'count'    => (defined $start ? $self->quotes_per_page() : undef)\r
520         });\r
521 }\r
522 \r
523 sub get_unapproved_quotes {\r
524         my ($self, $start) = @_;\r
525         return $self->_data_manager()->get_quotes({\r
526                 'approved' => 0,\r
527                 'sort'     => [ [ 'id', 1 ] ],\r
528                 'first'    => $start,\r
529                 'count'    => (defined $start ? $self->quotes_per_page() : undef)\r
530         });\r
531 }\r
532 \r
533 sub add_quote {\r
534         my ($self, $body, $notes, $approved, $tags) = @_;\r
535         my $quote = new Chirpy::Quote(\r
536                 undef,\r
537                 $body,\r
538                 $notes,\r
539                 0,\r
540                 0,\r
541                 undef,\r
542                 $approved,\r
543                 0,\r
544                 $tags\r
545         );\r
546         $self->_data_manager()->add_quote($quote);\r
547         return $quote;\r
548 }\r
549 \r
550 sub modify_quote {\r
551         my ($self, $quote, $text, $notes, $tags) = @_;\r
552         Chirpy::die('Not a Chirpy::Quote')\r
553                 unless (ref $quote eq 'Chirpy::Quote');\r
554         $quote->set_body(Chirpy::Util::clean_up_submission($text));\r
555         $quote->set_notes($notes\r
556                 ? Chirpy::Util::clean_up_submission($notes)\r
557                 : undef);\r
558         $quote->set_tags($tags) if (defined $tags);\r
559         return $self->_data_manager->modify_quote($quote);\r
560 }\r
561 \r
562 sub remove_quotes {\r
563         my ($self, @ids) = @_;\r
564         return $self->_data_manager()->remove_quotes(@ids);\r
565 }\r
566 \r
567 sub increase_quote_rating {\r
568         my ($self, $id, $revert) = @_;\r
569         return undef unless (defined $id);\r
570         my ($rating, $votes) = $self->_data_manager()\r
571                 ->increase_quote_rating($id, $revert);\r
572         return ($rating, $votes);\r
573 }\r
574 \r
575 sub decrease_quote_rating {\r
576         my ($self, $id, $revert) = @_;\r
577         return undef unless (defined $id);\r
578         my ($rating, $votes) = $self->_data_manager()\r
579                 ->decrease_quote_rating($id, $revert);\r
580         return ($rating, $votes);\r
581 }\r
582 \r
583 sub get_tag_use_counts {\r
584         my $self = shift;\r
585         return $self->_data_manager()->get_tag_use_counts();\r
586 }\r
587 \r
588 sub flag_quotes {\r
589         my ($self, @ids) = @_;\r
590         return $self->_data_manager()->flag_quotes(@ids);\r
591 }\r
592 \r
593 sub unflag_quotes {\r
594         my ($self, @ids) = @_;\r
595         return $self->_data_manager()->unflag_quotes(@ids);\r
596 }\r
597 \r
598 sub approve_quotes {\r
599         my ($self, @ids) = @_;\r
600         return $self->_data_manager()->approve_quotes(@ids);\r
601 }\r
602 \r
603 sub get_news_item {\r
604         my ($self, $id) = @_;\r
605         return undef unless (defined $id);\r
606         my $items = $self->_data_manager()->get_news_items({ 'id' => $id });\r
607         return (defined $items ? $items->[0] : undef);\r
608 }\r
609 \r
610 sub get_latest_news_items {\r
611         my $self = shift;\r
612         return $self->_data_manager()->get_news_items(\r
613                 { 'count' => $self->configuration()->get('ui', 'recent_news_items') });\r
614 }\r
615 \r
616 sub add_news_item {\r
617         my ($self, $text, $author) = @_;\r
618         my $item = new Chirpy::NewsItem(\r
619                 undef,\r
620                 Chirpy::Util::clean_up_submission($text),\r
621                 $author\r
622         );\r
623         $self->_data_manager()->add_news_item($item);\r
624         return $item;\r
625 }\r
626 \r
627 sub modify_news_item {\r
628         my ($self, $item, $text, $poster) = @_;\r
629         Chirpy::die('Not a Chirpy::NewsItem')\r
630                 unless (ref $item eq 'Chirpy::NewsItem');\r
631         $item->set_body($text);\r
632         $item->set_poster($poster);\r
633         return $self->_data_manager()->modify_news_item($item);\r
634 }\r
635 \r
636 sub remove_news_items {\r
637         my ($self, @ids) = @_;\r
638         return $self->_data_manager()->remove_news_items(@ids);\r
639 }\r
640 \r
641 sub get_accounts {\r
642         my $self = shift;\r
643         return $self->_data_manager()->get_accounts();\r
644 }\r
645 \r
646 sub get_accounts_by_level {\r
647         my ($self, @levels) = @_;\r
648         return $self->_data_manager()->get_accounts({ 'levels' => \@levels });\r
649 }\r
650 \r
651 sub get_account_by_id {\r
652         my ($self, $id) = @_;\r
653         return undef unless (defined $id);\r
654         my $accounts = $self->_data_manager()->get_accounts({ 'id' => $id });\r
655         return (defined $accounts ? $accounts->[0] : undef);\r
656 }\r
657 \r
658 sub get_account_by_username {\r
659         my ($self, $username) = @_;\r
660         my $accounts = $self->_data_manager()->get_accounts(\r
661                 { 'username' => $username });\r
662         return (defined $accounts ? $accounts->[0] : undef);\r
663 }\r
664 \r
665 sub account_count {\r
666         my $self = shift;\r
667         return $self->_data_manager()->account_count();\r
668 }\r
669 \r
670 sub account_count_by_level {\r
671         my ($self, $level) = @_;\r
672         return $self->_data_manager()->account_count({ 'levels' => [ $level ] });\r
673 }\r
674 \r
675 sub username_exists {\r
676         my ($self, $username) = @_;\r
677         return $self->_data_manager()->username_exists($username);\r
678 }\r
679 \r
680 sub add_account {\r
681         my ($self, $username, $password, $level) = @_;\r
682         my $account = new Chirpy::Account(\r
683                 undef,\r
684                 $username,\r
685                 Chirpy::Util::encrypt($password),\r
686                 $level\r
687         );\r
688         $self->_data_manager()->add_account($account);\r
689         return $account;\r
690 }\r
691 \r
692 sub modify_account {\r
693         my ($self, $account, $username, $password, $level) = @_;\r
694         Chirpy::die('Not a Chirpy::Account')\r
695                 unless (ref $account eq 'Chirpy::Account');\r
696         if (defined $username) {\r
697                 Chirpy::die('Invalid username')\r
698                         unless (Chirpy::Util::valid_username($username));\r
699                 $account->set_username($username);\r
700         }\r
701         if (defined $password) {\r
702                 Chirpy::die('Invalid password')\r
703                         unless (Chirpy::Util::valid_password($password));\r
704                 $account->set_password(Chirpy::Util::encrypt($password));\r
705         }\r
706         if (defined $level) {\r
707                 $account->set_level($level);\r
708         }\r
709         return $self->_data_manager()->modify_account($account);\r
710 }\r
711 \r
712 sub remove_accounts {\r
713         my ($self, @ids) = @_;\r
714         return $self->_data_manager()->remove_accounts(@ids);\r
715 }\r
716 \r
717 sub log_event {\r
718         my ($self, $code, $user, $data) = @_;\r
719         return $self->_data_manager()->log_event(\r
720                 new Chirpy::Event(undef, undef, $code, $user, $data)\r
721         );\r
722 }\r
723 \r
724 sub get_events {\r
725         my ($self, $start, $count, $desc, $code, $user, $data) = @_;\r
726         $self->mark_debug_event('Request events');\r
727         return $self->_data_manager()->get_events({\r
728                 'reverse' => $desc,\r
729                 'first'   => $start,\r
730                 'count'   => $count,\r
731                 'code'    => $code,\r
732                 'user'    => $user,\r
733                 'data'    => $data\r
734         });\r
735 }\r
736 \r
737 sub attempt_login {\r
738         my ($self, $username, $password) = @_;\r
739         my $account = $self->get_account_by_username($username);\r
740         return undef unless (defined $account);\r
741         return ($account->get_password() eq Chirpy::Util::encrypt($password)\r
742                 ? $account : undef);\r
743 }\r
744 \r
745 sub quotes_per_page {\r
746         my ($self, $value) = @_;\r
747         $self->{'quotes_per_page'} = $value if ($value);\r
748         return $self->{'quotes_per_page'} if (defined $self->{'quotes_per_page'});\r
749         return $self->configuration()->get('ui', 'quotes_per_page');\r
750 }\r
751 \r
752 sub quote_score_calculation_mode {\r
753         my $self = shift;\r
754         my $mode = $self->configuration()->get('general',\r
755                 'quote_score_calculation_mode');\r
756         return (defined $mode && $mode == 1 ? 1 : 0);\r
757 }\r
758 \r
759 sub timing_enabled {\r
760         return $hires_timing;\r
761 }\r
762 \r
763 sub start_time {\r
764         my $self = shift;\r
765         return $self->{'start_time'};\r
766 }\r
767 \r
768 sub total_time {\r
769         my $self = shift;\r
770         return ($hires_timing\r
771                 ? Time::HiRes::time() - $self->{'start_time'}\r
772                 : undef);\r
773 }\r
774 \r
775 sub set_up {\r
776         my ($self, $accounts, $news, $quotes) = @_;\r
777         $self->_data_manager()->set_up($accounts, $news, $quotes);\r
778 }\r
779 \r
780 sub remove {\r
781         my $self = shift;\r
782         $self->_data_manager()->remove();\r
783 }\r
784 \r
785 sub die {\r
786         my $message = shift;\r
787         $message = 'Unknown error' unless (defined $message);\r
788         if ($DEBUG) {\r
789                 confess $message;\r
790         }\r
791         else {\r
792                 croak $message;\r
793         }\r
794 }\r
795 \r
796 sub mark_debug_event {\r
797         my ($self, $event) = @_;\r
798         if (exists $self->{'debug_events'}) {\r
799                 my $now = Time::HiRes::time();\r
800                 push @{$self->{'debug_events'}}, [ $now, $event ];\r
801         }\r
802 }\r
803 \r
804 sub debug_events {\r
805         my $self = shift;\r
806         return $self->{'debug_events'};\r
807 }\r
808 \r
809 sub _data_manager {\r
810         my $self = shift;\r
811         return $self->{'data_manager'};\r
812 }\r
813 \r
814 sub _create_data_manager {\r
815         my ($type, $params) = @_;\r
816         my $dm;\r
817         eval qq{\r
818                 use Chirpy::DataManager::$type;\r
819                 \$dm = new Chirpy::DataManager::$type(\$params);\r
820         };\r
821         Chirpy::die('Failed to load data manager "' . $type . '": ' . $@)\r
822                 if ($@ || !defined $dm);\r
823         &_check_version($dm);\r
824         return $dm;\r
825 }\r
826 \r
827 sub _create_ui {\r
828         my ($type, $parent, $params) = @_;\r
829         my $ui;\r
830         eval qq{\r
831                 use Chirpy::UI::$type;\r
832                 \$ui = new Chirpy::UI::$type(\$parent, \$params);\r
833         };\r
834         Chirpy::die('Failed to load UI "' . $type . '": ' . $@)\r
835                 if ($@ || !defined $ui);\r
836         &_check_version($ui);\r
837         return $ui;\r
838 }\r
839 \r
840 sub _check_version {\r
841         my $obj = shift;\r
842         my $version = (defined $obj ? $obj->get_target_version() : undef);\r
843         Chirpy::die(ref($obj) . ' incompatible: wanted target version '\r
844                 . $Chirpy::VERSION . ', got ' . $version)\r
845                         unless ($version eq $Chirpy::VERSION);\r
846 }\r
847 \r
848 1;\r
849 \r
850 ###############################################################################