Revision 142
Date:
2011/09/29 12:19:53
Author:
ahitrov
Revision Log:
Image::Info in image loader
Files:
Legend:
Added
Removed
Modified
utf8/core/config.mk
7
7
CORE_REQUIRED += BSD-Resource
8
8
CORE_REQUIRED += Digest-MD5
9
9
CORE_REQUIRED += Image-Size
10
CORE_REQUIRED += Image-Info
10
11
CORE_REQUIRED += String-CRC32
11
12
CORE_REQUIRED += Time-HiRes
12
13
CORE_REQUIRED += Time-modules
utf8/core/lib/Contenido/File.pm
11
11
use Contenido::File::Scheme::HTTP;
12
12
use Contenido::File::Scheme::FILE;
13
13
use Contenido::DateTime;
14
use Image::Info qw(image_info dim);
14
15
15
16
our $IgnoreErrors = 1;
16
17
…
…
209
210
210
211
undef $fh_tmp;
211
212
213
my $image_info = image_info($filename_tmp.'.'.$ext);
214
if ( ref $image_info && $image_info->{file_ext} ne $ext ) {
215
rename $filename_tmp.'.'.$ext, $filename_tmp.'.'.$image_info->{file_ext};
216
$ext = $image_info->{file_ext};
217
}
218
212
219
my $IMAGE;
213
220
if ( store($filename.'.'.$ext, $filename_tmp.'.'.$ext) ) {
214
221
$IMAGE = {};
utf8/core/lib/Contenido/Parser.pm
42
42
$self->{headers} = $res->headers;
43
43
my $content_length = $res->headers->header('content-length');
44
44
my $content_type = $res->headers->header('content-type');
45
my $headers_string = $res->headers->as_string;
46
# warn $res->content_type_charset."\n\n";
47
# warn Dumper($res->headers) if $DEBUG;
45
48
$self->{content_type} = $content_type;
46
if ( $content_type =~ /charset\s*=\s*([a-z\d\-]+)/i ) {
47
$encoding = $1;
49
if ( $res->content_type_charset ) {
50
$encoding = Encode::find_encoding($res->content_type_charset)->name;
48
51
}
49
52
my $base_url = $input =~ /^([a-z]+:\/\/[a-z\.\d]+)/ ? $1 : '';
50
53
$self->{base_url} = $base_url if $base_url;
51
$content = $res->content;
54
$content = $res->decoded_content( charset => 'none' );
55
# warn "Charset: ".$res->content_charset."\n";
52
56
} else {
53
57
warn $res->status_line." \n";
54
58
$self->{success} = 0;
…
…
73
77
$content = <$fh>;
74
78
}
75
79
if ( $content ) {
76
unless ( $encoding ) {
77
$encoding = $self->__try_content_encoding( substr($content, 0, 350) );
78
}
79
if ( $encoding && $encoding ne 'utf-8' ) {
80
warn "Encoding from $encoding\n..." if $DEBUG;
81
Encode::from_to($content, $encoding, 'utf-8');
82
if ( exists $self->{headers} ) {
83
foreach my $header ( keys %{$self->{headers}} ) {
84
if ( ref $self->{headers}{$header} eq 'ARRAY' ) {
85
foreach my $val ( @{$self->{headers}{$header}} ) {
86
Encode::from_to($val, $encoding, 'utf-8');
80
warn "starting content decoding...\n";
81
if ( exists $self->{headers} && ref $self->{headers} && ($self->{headers}->content_is_html || $self->{headers}->content_is_xhtml || $self->{headers}->content_is_xml) ) {
82
unless ( $encoding ) {
83
$encoding = $self->__try_content_encoding( substr($content, 0, 350) );
84
}
85
if ( $encoding && $encoding ne 'utf-8' && $encoding ne 'utf-8-strict' ) {
86
warn "Encoding from $encoding\n..." if $DEBUG;
87
Encode::from_to($content, $encoding, 'utf-8');
88
if ( exists $self->{headers} ) {
89
foreach my $header ( keys %{$self->{headers}} ) {
90
if ( ref $self->{headers}{$header} eq 'ARRAY' ) {
91
foreach my $val ( @{$self->{headers}{$header}} ) {
92
Encode::from_to($val, $encoding, 'utf-8');
93
}
94
} else {
95
Encode::from_to($self->{headers}{$header}, $encoding, 'utf-8');
87
96
}
88
} else {
89
Encode::from_to($self->{headers}{$header}, $encoding, 'utf-8');
90
97
}
91
98
}
99
} else {
100
# Encode::_utf8_off($content);
101
if ( exists $self->{headers} ) {
102
foreach my $header ( keys %{$self->{headers}} ) {
103
if ( ref $self->{headers}{$header} eq 'ARRAY' ) {
104
foreach my $val ( @{$self->{headers}{$header}} ) {
105
Encode::_utf8_off($val);
106
}
107
} else {
108
warn "Test: ".$self->{headers}{$header}.": check flag: ".Encode::is_utf8($self->{headers}{$header}).". check: ".Encode::is_utf8($self->{headers}{$header},1)."\n";
109
if ( Encode::is_utf8($self->{headers}{$header}) && Encode::is_utf8($self->{headers}{$header},1) ) {
110
Encode::_utf8_off($self->{headers}{$header});
111
# Encode::_utf8_on($self->{headers}{$header});
112
# $self->{headers}{$header} = Encode::encode('utf8', $self->{headers}{$header}, Encode::FB_QUIET);
113
# Encode::from_to($self->{headers}{$header}, $encoding, 'utf8');
114
}
115
}
116
}
117
}
92
118
}
119
$self->{encoding} = $encoding;
120
warn Dumper($self) if $DEBUG;
121
if ( $self->{headers}->content_is_html ) {
122
my $headers;
123
if ( $content =~ /<head.*?>(.*?)<\/head>/si ) {
124
$headers = $self->__parse_html_header( $1 );
125
}
126
if ( ref $headers eq 'ARRAY' && @$headers ) {
127
foreach my $header ( @$headers ) {
128
if ( $header->{tag} eq 'title' ) {
129
$self->{headers}{title} = $header->{content};
130
} elsif ( $header->{tag} eq 'meta' && (($header->{rel} && $header->{rel} =~ /icon/i) || ($header->{href} && $header->{href} =~ /\.ico$/)) ) {
131
$self->{favicon} = $header->{href};
132
}
133
}
134
$self->{html_headers} = $headers;
135
}
136
}
93
137
}
94
$self->{encoding} = $encoding;
95
warn Dumper($self) if $DEBUG;
96
138
$self->{content} = $content;
97
139
$self->{success} = 1;
98
140
} else {
…
…
126
168
}
127
169
}
128
170
171
sub __parse_html_header {
172
my ($self, $input)= @_;
173
my @tags;
174
$input =~ s/[\r\n\t]+/\ /sgi;
175
if ( $input =~ /<title.*?>(.*?)<\/title.*?>/sgi ) {
176
my $title = $1;
177
for ( $title ) {
178
s/^\s+//;
179
s/\s+$//;
180
}
181
push @tags, { tag => 'title', content => $title };
182
}
183
while ( $input =~ /<(.*?)\/?>/sgi ) {
184
my $tag = $1;
185
my $struct = {};
186
for ( $tag ) {
187
s/\ *=\ */=/g;
188
$_ = __encode_quotes($_);
189
}
190
my @tag = split /\ +/, $tag;
191
$struct->{tag} = lc(shift @tag);
192
next unless ($struct->{tag} eq 'link' || $struct->{tag} eq 'meta');
193
foreach my $str ( @tag ) {
194
if ( $str =~ /^(.*?)=(.*)$/ ) {
195
my $attr = $1;
196
my $val = $2;
197
for ( $val ) {
198
s/^"//;
199
s/"$//;
200
s/ /\ /sg;
201
}
202
$struct->{$attr} = $val;
203
}
204
}
205
push @tags, $struct;
206
}
207
return \@tags;
208
}
209
210
sub __encode_quotes {
211
my $str = shift;
212
my @in = split //, $str;
213
my $out = '';
214
my $quot = '';
215
foreach my $ch ( @in ) {
216
if ( ($ch eq '"' && $quot eq '"') || ($ch eq "'" && $quot eq "'") ) {
217
$quot = '';
218
} elsif ( ($ch eq "'" || $ch eq '"' ) && !$quot ) {
219
$quot = $ch;
220
} elsif ( ($ch eq '"' && $quot eq "'") ) {
221
$ch = '"';
222
} elsif ( ($ch eq "'" && $quot eq '"') ) {
223
$ch = '&';
224
} elsif ( ($ch eq ' ' && $quot) ) {
225
$ch = ' ';
226
}
227
$out .= $ch;
228
}
229
$out =~ s/'/"/sgi;
230
return $out;
231
}
232
129
233
sub scheme {
130
234
my $uri = shift;
131
235
my $scheme;
utf8/core/ports/all/Image-Info/GNUmakefile
1
##############################################################################
2
# $HeadURL: http://svn.dev.rambler.ru/Contenido/branches/utf8/ports/all/Image-Size/GNUmakefile $
3
# $Id: GNUmakefile 175 2006-06-16 12:50:03Z lonerr $
4
###############################################################################
5
6
PORTVERSION = 1.31
7
PERL_MAKEMAKER = yes
8
MASTER_CPAN_SUBDIR = Image
9
10
11
include ../../etc/ports.mk
Небольшая справка по веткам
cnddist – контейнер, в котором хранятся все дистрибутивы всех библиотек и программных пакетов, которые использовались при построении различных версий Contenido. Если какой-то библиотеки в данном хранилище нет, инсталлятор сделает попытку "подтянуть" ее с веба (например, с CPAN). Если библиотека слишком старая, есть очень большая вероятность, что ее там уже нет. Поэтому мы храним весь хлам от всех сборок. Если какой-то дистрибутив вдруг отсутствует в cnddist - напишите нам, мы положим его туда.
koi8 – отмирающая ветка, чей код, выдача и все внутренние библиотеки заточены на кодировку KOI8-R. Вносятся только те дополнения, которые касаются внешнего вида и функционала админки, баги ядра, обязательные обновления портов и мелочи, которые легко скопипастить. В дальнейшем планируется полная остановка поддержки по данной ветке.
utf8 – актуальная ветка, заточенная под UTF-8.
Внутри каждой ветки: core – исходники ядра; install – скрипт установки инсталляции; plugins – плагины; samples – "готовые к употреблению" проекты, которые можно поставить, запустить и посмотреть, как они работают.
