Contenido Project
version 7
SVN-репозиторий
Line # Revision Author
1 8 ahitrov@rambler.ru package Utils;
2
3 use strict;
4 use vars qw ($VERSION @ISA @EXPORT);
5 use base 'Utils::HTML';
6
7 require Exporter;
8 @ISA = qw(Exporter);
9 @EXPORT = qw( &eval_config_file
10 &dump_config_file
11 &_mkdir
12 &looks_like_id
13 &time_unix_to_timestamp
14 &time_timestamp_to_unix
15 &abort404
16 &abort403
17 &abort503
18 &http_abort
19 );
20 $VERSION = '0.1';
21
22 use Data::Dumper;
23 use CGI;
24 use locale;
25 use File::Find;
26 use Time::Local;
27 use URI::Escape;
28 use Contenido::Init;
29 use Convert::Cyrillic;
30
31 sub looks_like_id { shift =~ /^\d+$/ ? 1 : 0 }
32
33
34 # ----------------------------------------------------------------------------
35 # Рекурсивное создание директории
36 # ----------------------------------------------------------------------------
37 sub _mkdir
38 {
39 my $directory = shift;
40
41 return -1 if (! defined($directory));
42
43 # Создаем необходимые промежуточные директории
44 if (! -d $directory) {
45 my $e = `mkdir -p $directory`;
46 unless(-d $directory) {
47 warn "Contenido Warning: Не могу создать директорию $directory по причине $! ($e)";
48 return -1;
49 }
50 }
51
52 return 1;
53 }
54
55 sub eval_config_file
56 {
57 my $config_file = shift;
58
59 open (FILE, "< $config_file") || do {
60 warn "Utils: Не могу прочитать файл $config_file по причине $!\n";
61 return undef;
62 };
63 my @CFILE = <FILE>;
64 my $eval_line = join(' ', @CFILE);
65 close (FILE);
66
67 my $CONFIG = {};
68 {
69 local $SIG{'__DIE__'};
70 $CONFIG = eval ('use vars qw($VAR1); '. $eval_line);
71
72 };
73 if ($@)
74 {
75 warn "Utils: При обработке файла $config_file произошла ошибка $@\n";
76 return undef;
77 }
78
79 return $CONFIG;
80 }
81
82
83
84
85
86 sub dump_config_file
87 {
88 my ($config_file, $data) = @_;
89 my $DumpStr = Dumper($data);
90
91 # Осуществляем моментальный dump...
92
93 open (FILE, "> $config_file") || do {
94 warn "Utils: Не могу открыть файл $config_file по причине $!\n";
95 return -100;
96 };
97 print FILE $DumpStr;
98 close (FILE);
99
100 return 1;
101 }
102
103
104 sub query_string
105 {
106 my ($args, $newargs, $no_urlencode) = @_;
107 return '' unless ($args || $newargs || $no_urlencode);
108
109 my %Args = ref($args) eq 'HASH' ? %$args: @_; # Возмем аргументы
110 %Args = () unless %Args;
111 my %no_encode;
112
113 if (ref($args) eq 'HASH')
114 {
115 @Args{ keys %$newargs } = values %$newargs; # Наложим на них новые
116 %no_encode = map { $_ => 1; } @$no_urlencode if $no_urlencode ;
117 }
118
119 my $one_param = sub { my ($k,$v)=@_; "$k=". ($no_encode{$k} ? $v : CGI::escape($v)) };
120
121 my $params = join('&',
122 map { my $k=$_; ref ($Args{$k}) eq 'ARRAY' ? join('&', map { &$one_param($k, $_) } @{$Args{$k}}) : &$one_param($k, $Args{$k}) }
123 grep { $Args{$_} =~ /\S/ }
124 keys %Args
125 );
126
127 $params = '?'.$params if $params; # Припишем вопросительный знак, если строка непуста
128 return $params;
129 }
130
131
132
133 # ----------------------------------------------------------------------------
134 # Вспомогательная процедура. Получает массив в PostgreSQL-формате, а
135 # возвращает простой массив
136 # ----------------------------------------------------------------------------
137 sub split_array
138 {
139 my $array_string = shift;
140
141 my @R = ();
142 if ($array_string =~ /^{([^}]+)}$/)
143 {
144 my (@S) = split(/,/,$1);
145 @R = @S;
146 }
147
148 return @R;
149 }
150
151 # Перекодировка параметров запроса из WIN|UTF в KOI8
152 sub recode_args {
153 my $opts = shift;
154 my %args = (
155 to_charset => 'UTF8',
156 @_
157 );
158
159 return undef unless $opts && ref($opts) eq 'HASH';
160
161 if ( $opts->{'control_charset'} ) {
162
163 my $charset = undef;
164 my $is_escaped = undef;
165
166 if ( $opts->{'control_charset'} eq 'Контроль' ) {
167 $charset = 'UTF8';
168
169 } elsif ( recode_string('WIN', 'UTF8', $opts->{'control_charset'}) eq 'Контроль' ) {
170 $charset = 'WIN';
171
172 } elsif ( recode_string('KOI', 'UTF8', $opts->{'control_charset'}) eq 'Контроль' ) {
173 $charset = 'KOI';
174
175 } elsif ( url_unescape($opts->{'control_charset'}) eq 'Контроль' ) {
176 $charset = 'UTF8';
177 $is_escaped = 1;
178
179 } elsif ( recode_string('WIN', 'UTF8', url_unescape($opts->{'control_charset'})) eq 'Контроль' ) {
180 $charset = 'WIN';
181 $is_escaped = 1;
182
183 } elsif ( recode_string('KOI', 'UTF8', url_unescape($opts->{'control_charset'})) eq 'Контроль' ) {
184 $charset = 'KOI';
185 $is_escaped = 1;
186 }
187
188 if ($charset && ($is_escaped || $charset ne $args{'to_charset'})) {
189 while ( my ($key, $val) = each %$opts ) {
190 if ( ref($val) eq 'ARRAY' ) {
191 foreach ( @{$val} ) {
192 $_ = recode_string( $charset, $args{'to_charset'}, $is_escaped ? url_unescape($_) : $_ );
193 }
194 } else {
195 $opts->{$key} = recode_string( $charset, $args{'to_charset'}, $is_escaped ? url_unescape($val) : $val );
196 }
197 }
198 }
199 }
200 return $opts;
201 }
202
203 # Перекодировка строки
204 sub recode_string {
205 my ($from, $to, $str) = @_;
206 return Convert::Cyrillic::cstocs($from, $to, $str);
207 }
208
209
210 # загрузка модулей
211 sub load_modules {
212 my $list = shift;
213 unless (ref($list) eq 'ARRAY') {
214 return undef;
215 }
216 foreach my $module (@$list) {
217 eval ("use $module");
218 if ( $@ ) {
219 die __PACKAGE__.": ошибка загрузки модуля $module.\n $@";
220 }
221 {
222 package HTML::Mason::Commands;
223 eval ("use $module");
224 }
225 }
226 return 1;
227 }
228
229 # поиск модулей в заданной директории
230 # абсолютной, относительно установочной директории Contenido
231 sub find_modules {
232 my %opts = @_;
233
234 my $relative_dir = $opts{relative_dir};
235 my $recursive_flag = $opts{recursive};
236 my $absolute_dir = $opts{absolute_dir};
237
238 $relative_dir .= '/' unless $relative_dir =~ /\/$/;
239
240 my $dir = $absolute_dir.'/'.$relative_dir;
241
242 return undef unless -d $dir;
243
244 my @res = ();
245 $relative_dir =~ s/\//::/g;
246
247 if ($recursive_flag) {
248
249 my $sub = sub {if (/\.pm$/i) { s/\.pm//i; my $d = $File::Find::dir.'/'; $d =~ s/$dir//; $d =~ s/\//::/g; push @res, $relative_dir.$d.$_; } };
250 File::Find::find({ wanted => $sub, no_chdir => 0}, $dir);
251
252 } else {
253 opendir(DIR, $dir) || do { warn __PACKAGE__.": не могу прочесть директорию модулей $dir."; return undef; } ;
254 my @modules = grep {/\.pm$/} readdir(DIR);
255 closedir(DIR);
256
257
258 foreach my $module (@modules) {
259 $module =~ /(.*)\.pm/;
260 push @res, $relative_dir.$1;
261 }
262 }
263 return @res ? \@res : undef;
264 }
265 #-------------------------------------------------------------------------------
266 # Время из unixtime в timestamp
267 sub time_unix_to_timestamp {
268 my ($time) = @_;
269 $time ||= time;
270 my @localtime = localtime($time);
271 my $timestamp = ($localtime[5] + 1900).'-'.(sprintf('%02d', $localtime[4] + 1)).'-'.(sprintf('%02d', $localtime[3])).' '.(sprintf('%02d', $localtime[2])).':'.(sprintf('%02d', $localtime[1])).':'.(sprintf('%02d', $localtime[0]));
272 return $timestamp;
273 }
274 #-------------------------------------------------------------------------------
275 # Время из timestamp в unixtime
276 sub time_timestamp_to_unix {
277 my ($time) = @_;
278 return undef unless $time;
279 my @time = $time =~ /(\d+)/g;
280 @time = reverse @time;
281 shift @time if $time =~ /\.\d+$/;
282 $time[4]--;
283 $time = timelocal(@time);
284 return $time
285 }
286
287 sub abort404 {
288 http_abort(404);
289 }
290
291 sub abort403 {
292 http_abort(403);
293 }
294
295 sub abort503 {
296 http_abort(503);
297 }
298
299 sub http_abort {
300 my $code = shift;
301 my $m = $HTML::Mason::Commands::m;
302 $m->clear_buffer();
303 $m->abort($code);
304 }
305
306 1;

Небольшая справка по веткам

cnddist – контейнер, в котором хранятся все дистрибутивы всех библиотек и программных пакетов, которые использовались при построении различных версий Contenido. Если какой-то библиотеки в данном хранилище нет, инсталлятор сделает попытку "подтянуть" ее с веба (например, с CPAN). Если библиотека слишком старая, есть очень большая вероятность, что ее там уже нет. Поэтому мы храним весь хлам от всех сборок. Если какой-то дистрибутив вдруг отсутствует в cnddist - напишите нам, мы положим его туда.

koi8 – отмирающая ветка, чей код, выдача и все внутренние библиотеки заточены на кодировку KOI8-R. Вносятся только те дополнения, которые касаются внешнего вида и функционала админки, баги ядра, обязательные обновления портов и мелочи, которые легко скопипастить. В дальнейшем планируется полная остановка поддержки по данной ветке.

utf8 – актуальная ветка, заточенная под UTF-8.

Внутри каждой ветки: core – исходники ядра; install – скрипт установки инсталляции; plugins – плагины; samples – "готовые к употреблению" проекты, которые можно поставить, запустить и посмотреть, как они работают.
© 2003 – 2009 «Рамблер»
© 2010 – 2024 «Андрей (Handy) Хитров»