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/&nbsp;/\ /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 = '&quot;';
    222 } elsif ( ($ch eq "'" && $quot eq '"') ) {
    223 $ch = '&amp;';
    224 } elsif ( ($ch eq ' ' && $quot) ) {
    225 $ch = '&nbsp;';
    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