1 |
8 |
ahitrov@rambler.ru |
package Contenido::Type::Image; |
2 |
|
|
#------------------------------------------------------------------------------- |
3 |
|
|
# Тип данных - Файл |
4 |
|
|
#------------------------------------------------------------------------------- |
5 |
|
|
use strict; |
6 |
|
|
use warnings; |
7 |
|
|
use Contenido::Globals; |
8 |
|
|
use Contenido::File; |
9 |
|
|
use Image::Size; |
10 |
|
|
use base qw/Contenido::Type::File/; |
11 |
|
|
#------------------------------------------------------------------------------- |
12 |
|
|
# |
13 |
|
|
sub new { |
14 |
|
|
my ($prototype, $properties) = @_; |
15 |
|
|
warn 'Неправильно переданы свойства изображения: #0001' unless $properties || ref $properties; |
16 |
|
|
$properties = { |
17 |
|
|
properties => $properties, |
18 |
|
|
width => undef, |
19 |
|
|
height => undef, |
20 |
|
|
alt => undef, |
21 |
|
|
mini => {}, |
22 |
|
|
}; |
23 |
|
|
my $self = SUPER::new($prototype, $properties) |
24 |
|
|
return $self; |
25 |
|
|
} |
26 |
|
|
#------------------------------------------------------------------------------- |
27 |
|
|
# Перепроверяем текущие параметры - не готово |
28 |
|
|
sub restrict_properties { |
29 |
|
|
my ($self, $properties) = @_; |
30 |
|
|
warn 'Неправильно переданы свойства изображения: #0002' unless $properties || ref $properties; |
31 |
|
|
foreach my $key (keys %{$properties}) { |
32 |
|
|
|
33 |
|
|
} |
34 |
|
|
return $self; |
35 |
|
|
} |
36 |
|
|
#------------------------------------------------------------------------------- |
37 |
|
|
# Дополнительные данные |
38 |
|
|
sub more_info { |
39 |
|
|
my ($self) = @_; |
40 |
|
|
($self->{'width'}, $self->{'height'}) = Image::Size::imgsize($self->{'file_local'}) || return undef; |
41 |
|
|
return 1; |
42 |
|
|
} |
43 |
|
|
#------------------------------------------------------------------------------- |
44 |
|
|
sub create_preview { |
45 |
|
|
my ($self, $filename) = @_; |
46 |
|
|
$filename ||= '/images/'.$self->filename_default; |
47 |
|
|
# Удаляем старые превьюшки |
48 |
|
|
foreach my $key (keys {$self->{'mini'}}) { |
49 |
|
|
next if $key eq 'filename' || $key eq 'width' || $key eq 'height' || $key eq 'alt'; |
50 |
|
|
Contenido::File::remove($self->{'mini'}->{$key}->{'filename'}); |
51 |
|
|
delete $self->{'mini'}->{$key}; |
52 |
|
|
} |
53 |
|
|
$self->{'mini'} = {}; |
54 |
|
|
# Формируем новые превьюшки |
55 |
|
|
my @preview = $self->{'properties'}->{'preview'} && ref $self->{'properties'}->{'preview'} && ref $self->{'properties'}->{'preview'} eq 'ARRAY' ? |
56 |
|
|
@{$self->{'properties'}->{'preview'}} : ($self->{'properties'}->{'preview'} || $keeper->{'preview'}); |
57 |
|
|
foreach my $preview (@preview) { |
58 |
|
|
substr (my $file_preview = $self->{'file_local'}, (- 1 - (length $self->{'ext'})), 0 , '.'.$preview); |
59 |
|
|
my $command = $state->{'convert_binary'}.' -geometry \''.$preview.'\' -quality 80 '.$self->{'file_local'}.' '.$file_preview; |
60 |
|
|
my $result = `$command`; |
61 |
|
|
substr (my $filename_preview = $filename, (- 1 - (length $self->{'ext'})), 0 , $preview); |
62 |
|
|
if (Contenido::File::store($filename_preview, $file_preview)) { |
63 |
|
|
$self->{'mini'}->{$key}->{'filename'} = $storage.'.'.$self->{'ext'}; |
64 |
|
|
$self->{'mini'}->{$key}->{'size'} = (stat $file_preview)[7]; |
65 |
|
|
$self->{'mini'}->{$key}->{'ext'} = $self->{'ext'}; |
66 |
|
|
unlink $file_preview; |
67 |
|
|
($self->{'mini'}->{$key}->{'width'}, $self->{'mini'}->{$key}->{'height'}) = Image::Size::imgsize($self->{'file_local'}) || return undef; |
68 |
|
|
} |
69 |
|
|
} |
70 |
|
|
@{%{$self->{'mini'}}}{'filename', 'width', 'height', 'size', 'ext', 'alt'} = @{%{$self->{'mini'}{$preview[0]}}}{'filename', 'width', 'height', 'size', 'ext', 'alt'}; |
71 |
|
|
return 1; |
72 |
|
|
} |
73 |
|
|
#------------------------------------------------------------------------------- |
74 |
|
|
sub store { |
75 |
|
|
my ($self, $filename) = @_; |
76 |
|
|
$self->create_preview($filename); |
77 |
|
|
return $self->SUPER::store; |
78 |
|
|
} |
79 |
|
|
#------------------------------------------------------------------------------- |
80 |
|
|
sub remove { |
81 |
|
|
my ($self) = @_; |
82 |
|
|
return $self->SUPER::remove; |
83 |
|
|
} |
84 |
|
|
1; |