Line # Revision Author
1 8 ahitrov@rambler.ru package Contenido::Type::File;
2 #-------------------------------------------------------------------------------
3 # Тип данных - Файл
4 #-------------------------------------------------------------------------------
5 use strict;
6 use warnings;
7 use Contenido::Globals;
8 use Contenido::File;
9 use LWP;
10 use LWP::UserAgent;
11 use LWP::Simple qw /get/;
12 use HTTP::Request;
13 use HTTP::Headers;
14
15 sub new {
16 my ($proto, $prop) = @_;
17 $proto = ref $proto || $proto;
18 my $self = $prop && ref $prop && ref $prop eq 'HASH' ?
19 {%$prop, ext => undef, filename => undef, size => undef} :
20 {ext => undef, filename => undef, size => undef};
21 bless $self, $proto;
22 return $self;
23 }
24 #-------------------------------------------------------------------------------
25 # Кладем файл локально
26 # В будущем, можно сдесь же проводить upload
27 sub put_local {
28 my ($self, $filename, $data) = @_;
29 return undef if (!$filename || !$data);
30 ($self->{'ext'}) = $filename =~ /\.([^\.]+)$/;
31 $self->{'ext'} = lc $self->{'ext'};
32 $self->{'file_local'} = $state->{'tmp_dir'}.'/'.int(rand(100000)).'_'.time.'.'.$self->{'ext'};
33 my $fh = undef;
34 if (ref $data eq 'Apache::Upload') {
35 my $upload = $data->fh();
36 unless (open ($fh, '>', $self->{'file_local'})) {$self->error($!); return undef}
37 while (<$upload>) {print $fh $_}
38 close $fh;
39 } else {
40 unless (open ($fh, '>', $self->{'file_local'})) {$self->error($!); return undef}
41 print $fh $data;
42 close $fh;
43 }
44 unless ($self->file_info()) {unlink $self->{'file_local'}}
45 return 1;
46 }
47 #-------------------------------------------------------------------------------
48 # Берем файл локально
49 # В будущем, можно сдесь же проводить upload
50 sub get_local {
51 my ($self, $filename) = @_;
52 return undef if (!$filename || !-f $filename);
53 ($self->{'ext'}) = $filename =~ /\.([^\.\?]+)(?:\?.+$|$)/;
54 $self->{'file_local'} = $filename;
55 $self->file_info() || return undef;
56 return 1;
57 }
58 #-------------------------------------------------------------------------------
59 # Берем файл удаленно, и удаляем если надо
60 sub get_remote {
61 my ($self, %params) = @_;
62 ($self->{'ext'}) = $params{'url'} =~ /\.([^\.\?]+)(?:\?.+$|$)/;
63 $self->{'ext'} = lc $self->{'ext'};
64 $self->{'file_local'} = $state->{'tmp_dir'}.'/'.int(rand(100000)).'_'.time.'.'.$self->{'ext'};
65 my $ua = LWP::UserAgent->new();
66 my $response = $ua->get($params{'url'}, ':read_size_hint' => 10 * 1024, ':content_file' => $self->{'file_local'});
67 return undef unless $response->is_success();
68 unless ($self->file_info()) {unlink $self->{'file_local'}; return undef}
69 return 1;
70 }
71 #-------------------------------------------------------------------------------
72 # Типа обертка для Contenido::File::store
73 sub store {
74 my ($self, $filename) = @_;
75 return undef unless $filename; # Стоит ли делать дефолный путь сохранения?
76 $self->remove if $self->{'filename'}; # Удаляем предыдущий файл
77 unless (Contenido::File::store($filename, $self->{'file_local'})) {$self->error('Не могу записать файл '.$filename); return undef}
78 $self->{'filename'} = $filename;
79 return 1;
80 }
81 #-------------------------------------------------------------------------------
82 # Типа обертка для Contenido::File::remove
83 sub remove {
84 my ($self) = @_;
85 unless (Contenido::File::remove($self->{'filename'})) {$self->error('Не могу удалить файл '.$self->{'filename'}); return undef}
86 return 1;
87 }
88 #-------------------------------------------------------------------------------
89 # Удаляем локальный файл за ненадобностью
90 sub clean {
91 my ($self) = @_;
92 unless (unlink $self->{'file_local'}) {$self->error($!); return undef}
93 delete $self->{'file_local'};
94 delete $self->{'properties'};
95 return 1;
96 }
97 #-------------------------------------------------------------------------------
98 # Инфо файла
99 sub file_info {
100 my ($self) = @_;
101 $self->{'size'} = (stat($self->{'file_local'}))[7];
102 if ($self->can('more_info')) {$self->more_info() || return undef}
103 return 1;
104 }
105 #-------------------------------------------------------------------------------
106 # Filename default
107 sub filename_default {
108 my $time = time;
109 my @date = (localtime $time)[5, 4, 3]; $date[0] += 1900; $date[1] += 1;
110 my $component_date = sprintf "%04d/%02d/%02d", @date;
111 my $component_time_rand = sprintf "%010d_%05d", $time, int rand 99999;
112 return join "/", $component_date, $component_time_rand;
113 }
114 #-------------------------------------------------------------------------------
115 # DataDumper
116 sub dumper {
117 my $self = shift;
118 my $class = ref($self) || die 'objmethod';
119 my $struct = undef;
120 local $Data::Dumper::Indent = 0;
121 $struct = Data::Dumper::Dumper($self);
122 return undef unless defined $struct;
123 return $struct;
124 }
125 #-------------------------------------------------------------------------------
126 # Куда сваливаем ошибки
127 sub error {
128 my ($self, $error) = @_;
129 warn $error;
130 return 1;
131 }
132 1;