moved qdb here because matt is lazy
[public/www-new.git] / pub / qdb / src / modules / Chirpy / Util.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:: Util.pm 302 2007-02-08 03:07:19Z ceetee                             $ #\r
22 ###############################################################################\r
23 \r
24 =head1 NAME\r
25 \r
26 Chirpy::Util - Static utility class\r
27 \r
28 =head1 FUNCTIONS\r
29 \r
30 =over 4\r
31 \r
32 =item valid_username($username)\r
33 \r
34 Returns whether or not the given username is valid. A username is valid if it\r
35 is minimally 2, maximally 32 characters long. The characters can be letters,\r
36 numbers, underscores or dashes.\r
37 \r
38 =item valid_password($password)\r
39 \r
40 Returns whether or not the given password is valid. A password is valid if it\r
41 is minimally 4, maximally 256 characters long. The characters can be letters,\r
42 numbers, underscores or dashes.\r
43 \r
44 =item clean_up_submission($string)\r
45 \r
46 Performs various cleanup operations on the given string, which is assumed to be\r
47 filled in by the user somewhere. The operations include removal of leading and\r
48 trailing whitespaces, and trimming down sequences of more than 2 line feeds.\r
49 \r
50 =item parse_tags($tags)\r
51 \r
52 Parses the string C<$tags> into an array of valid tags and returns a reference\r
53 to it. The array may be empty.\r
54 \r
55 =item encrypt($string)\r
56 \r
57 Encrypts the given string using the MD5 algorithm. This function is used for\r
58 password encryption.\r
59 \r
60 =item format_quote_rating($rating)\r
61 \r
62 Returns a string representation of the given rating, i.e. the number prepended\r
63 with the Unicode representation of its sign.\r
64 \r
65 =item format_date_time($timestamp, $format, $gmt)\r
66 \r
67 Formats C<$timestamp> using L<the POSIX module|POSIX>'s C<strftime()> function\r
68 and C<$format> as the format. Returns Greenwich Mean Time if C<$gmt> is true.\r
69 \r
70 =item encode_xml_entities($string)\r
71 \r
72 Returns C<$string> with the character entities defined in XML encoded. The\r
73 entities and their respective codes are:\r
74  \r
75  Character Entity\r
76  ========= ======\r
77      &     &amp;\r
78      "     &quot;\r
79      <     &lt;\r
80      >     &gt;\r
81 \r
82 =item decode_utf8($string)\r
83 \r
84 Returns the given string with UTF-8 characters decoded.\r
85 \r
86 =back\r
87 \r
88 =head1 PROCEDURES\r
89 \r
90 =over 4\r
91 \r
92 =item ensure_writable_directory($path)\r
93 \r
94 Attempts to make the directory specified by C<$path> writable, creating it if it\r
95 does not exist. If, upon completion, C<$path> does represent a writable\r
96 directory, execution is aborted.\r
97 \r
98 =item abstract_method()\r
99 \r
100 Aborts execution immediately, stating that the method is abstract and must be\r
101 implemented. Hence, if you have an abstract method C<my_abstract_method()>, you\r
102 may define it as follows:\r
103 \r
104  *my_abstract_method = \&Chirpy::Util::abstract_method;\r
105 \r
106 Invoking it will then cause a fatal error unless it is overridden in the module\r
107 implementation.\r
108 \r
109 =back\r
110 \r
111 =head1 AUTHOR\r
112 \r
113 Tim De Pauw E<lt>ceetee@users.sourceforge.netE<gt>\r
114 \r
115 =head1 SEE ALSO\r
116 \r
117 L<Chirpy>, L<http://chirpy.sourceforge.net/>\r
118 \r
119 =head1 COPYRIGHT\r
120 \r
121 Copyright 2005-2007 Tim De Pauw. All rights reserved.\r
122 \r
123 This program is free software; you can redistribute it and/or modify it under\r
124 the terms of the GNU General Public License as published by the Free Software\r
125 Foundation; either version 2 of the License, or (at your option) any later\r
126 version.\r
127 \r
128 This program is distributed in the hope that it will be useful, but WITHOUT ANY\r
129 WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A\r
130 PARTICULAR PURPOSE.  See the GNU General Public License for more details.\r
131 \r
132 =cut\r
133 \r
134 package Chirpy::Util;\r
135 \r
136 use strict;\r
137 use warnings;\r
138 \r
139 use vars qw($VERSION);\r
140 \r
141 $VERSION = '0.3';\r
142 \r
143 use Chirpy 0.3;\r
144 \r
145 use POSIX qw(strftime);\r
146 \r
147 sub valid_username {\r
148         my $string = shift;\r
149         return ($string =~ /^[a-zA-Z0-9_\-]{2,32}$/);\r
150 }\r
151 \r
152 sub valid_password {\r
153         my $string = shift;\r
154         return ($string =~ /^[a-zA-Z0-9_\-]{4,256}$/);\r
155 }\r
156 \r
157 sub clean_up_submission {\r
158         my $text = shift;\r
159         for ($text) {\r
160                 s/\r\n?/\n/g;\r
161                 s/^\s+//;\r
162                 s/\s+$//;\r
163                 s/\n{3,}/\n\n/g;\r
164                 s/\t/  /g;\r
165                 # Remove low ASCII chars (\12 = \n)\r
166                 s/[\0-\11\13-\37]//g;\r
167         }\r
168         return $text;\r
169 }\r
170 \r
171 sub parse_tags {\r
172         my $tags = shift;\r
173         return [] unless (defined $tags && $tags ne '');\r
174         $tags = lc $tags;\r
175         my %tags = ();\r
176         foreach my $tag (split(/[\s;,]+/, $tags)) {\r
177                 next if (length($tag) < 2);\r
178                 $tags{$tag} = 1;\r
179         }\r
180         return [ keys %tags ];\r
181 }\r
182 \r
183 sub encrypt {\r
184         require Digest::MD5;\r
185         return Digest::MD5::md5_hex(shift);\r
186 }\r
187 \r
188 sub format_quote_rating {\r
189         my $rating = shift;\r
190         return ($rating\r
191                 ? ($rating < 0 ? "\x{2212}" . (-$rating) : '+' . $rating)\r
192                 : '0');\r
193 }\r
194 \r
195 sub format_date_time {\r
196         my ($timestamp, $format, $gmt) = @_;\r
197         return strftime($format, ($gmt\r
198                 ? gmtime($timestamp) : localtime($timestamp)));\r
199 }\r
200 \r
201 sub encode_xml_entities {\r
202         require HTML::Entities;\r
203         my $str = shift;\r
204         return HTML::Entities::encode($str, '<>&"');\r
205 }\r
206 \r
207 sub decode_utf8 {\r
208         require Encode;\r
209         return Encode::decode('utf8', shift);\r
210 }\r
211 \r
212 sub shuffle_array {\r
213         my @array = @_;\r
214         my $len = scalar @array;\r
215         for (my $i = 0; $i < $len; $i++) {\r
216                 my $j = int rand $len;\r
217                 ($array[$i], $array[$j]) = ($array[$j], $array[$i]);\r
218         }\r
219         return @array;\r
220 }\r
221 \r
222 sub ensure_writable_directory {\r
223         my $path = shift;\r
224         if (-e $path) {\r
225                 if (-d $path) {\r
226                         if (!-w $path) {\r
227                                 chmod 0777, $path;\r
228                                 if (!-w $path) {\r
229                                         Chirpy::die('Directory "' . $path . '" not writable');\r
230                                 }\r
231                         }\r
232                 }\r
233                 else {\r
234                         Chirpy::die('Path "' . $path . '" must be a directory');\r
235                 }\r
236         }\r
237         else {\r
238                 mkdir $path\r
239                         or die('Cannot create directory "' . $path . '": ' . $!);\r
240         }\r
241 }\r
242 \r
243 sub abstract_method {\r
244         Chirpy::die('Abstract method must be implemented');\r
245 }\r
246 \r
247 1;\r
248 \r
249 ###############################################################################