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

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

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

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

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

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