1 |
296 |
ahitrov |
#!/usr/bin/perl |
2 |
|
|
|
3 |
|
|
use FindBin; |
4 |
|
|
BEGIN { |
5 |
|
|
require "$FindBin::RealBin/../../../lib/Modules.pm"; |
6 |
|
|
use lib "$FindBin::RealBin/../lib"; |
7 |
|
|
} |
8 |
|
|
|
9 |
|
|
use Contenido::Globals; |
10 |
|
|
use Contenido::Init; |
11 |
|
|
use ErrorTee; |
12 |
|
|
use PidFile; |
13 |
|
|
|
14 |
|
|
use Convert::UU qw(uudecode); |
15 |
|
|
use POSIX qw(strftime); |
16 |
|
|
use IIR_Parser; |
17 |
|
|
use Data::Dumper; |
18 |
|
|
use Image::Size; |
19 |
|
|
|
20 |
|
|
use vars qw($DEBUG); |
21 |
|
|
$DEBUG = 0; |
22 |
|
|
|
23 |
|
|
# begin |
24 |
|
|
Contenido::Init->init(); |
25 |
|
|
|
26 |
|
|
my $news_section = $project->s_alias()->{news}; |
27 |
|
|
my $sources_section = $project->s_alias()->{sources}; |
28 |
|
|
|
29 |
|
|
my $discovery_section = 260004783; |
30 |
|
|
my $temp_images_directory = "~/Contenido/var/projects/promosuite/loader/images"; |
31 |
|
|
|
32 |
|
|
my %inter = ( |
33 |
|
|
); |
34 |
|
|
|
35 |
|
|
my %SPECATTRS = ( |
36 |
|
|
Image => [], |
37 |
|
|
SECT_ID => [], |
38 |
|
|
IMG_COMMENT => [], |
39 |
|
|
ShortAbstr => [], |
40 |
|
|
LongAbstr => [], |
41 |
|
|
Command => [], |
42 |
|
|
itype_id => [], |
43 |
|
|
); |
44 |
|
|
|
45 |
|
|
$SPECATTRS{LentaImage} = $SPECATTRS{Image}; |
46 |
|
|
|
47 |
|
|
my %STATUSMAP = ( |
48 |
|
|
0 => 0, #default |
49 |
|
|
); |
50 |
|
|
|
51 |
|
|
|
52 |
|
|
my %fields_map = ( |
53 |
|
|
'Title' => 'name', |
54 |
|
|
'Body' => 'body', |
55 |
|
|
'Body_Preview' => 'abstr', |
56 |
|
|
'Date' => 'dtime', |
57 |
|
|
# 'SECT_ID' => 'sections' |
58 |
|
|
); |
59 |
|
|
|
60 |
|
|
|
61 |
|
|
my $err = ErrorLog->new(); |
62 |
|
|
|
63 |
|
|
# Инициализация парсера IIR |
64 |
|
|
my $parser = IIR_Parser->new(err => $err, debug=>$DEBUG); |
65 |
|
|
|
66 |
|
|
# Читаем IIR в хэш {поле}=>{значение} |
67 |
|
|
my %obj; |
68 |
|
|
while (! $parser->eof ) { |
69 |
|
|
my $fn = $parser -> GetFieldName; |
70 |
|
|
my $fv = $parser -> GetFieldValue(mode => 'return'); |
71 |
|
|
$fv=[uudecode($fv)] if ($fv=~/^begin/); |
72 |
|
|
if (exists($SPECATTRS{$fn})){ |
73 |
|
|
push (@{$SPECATTRS{$fn}},$fv) |
74 |
|
|
}else{ |
75 |
|
|
$obj{$fn}=$fv if ($fn && defined($fv)); |
76 |
|
|
} |
77 |
|
|
} |
78 |
|
|
|
79 |
|
|
if (my ($cmd) = grep { /change_author/ } @{$SPECATTRS{Command}}) { |
80 |
|
|
($obj{AUTH_ID}) = ($cmd =~ /change_author\s+(\d+)/); |
81 |
|
|
} |
82 |
|
|
#print Dumper(\%obj); |
83 |
|
|
#print Dumper(\%SPECATTRS); |
84 |
|
|
##### warn Dumper \%SPECATTRS; |
85 |
|
|
##### warn Dumper \%obj; |
86 |
|
|
|
87 |
|
|
## Если новость не в теме "Олимпиада", то, если у нее есть картинки, отложим их в сторонку |
88 |
|
|
## А вдруг пригодятся |
89 |
|
|
## Потом выйдем, потому как соленые бананы мы не едим |
90 |
|
|
|
91 |
|
|
if ($obj{MTYPE_ID} != -4 ) { |
92 |
|
|
if (@{$SPECATTRS{Image}}) { |
93 |
|
|
my $i = 0; |
94 |
|
|
foreach my $image (@{$SPECATTRS{Image}}) { |
95 |
|
|
$i++; |
96 |
|
|
my ($img, $file) = @$image; |
97 |
|
|
my ($ext) = ($file =~ /\.(\w+)$/); |
98 |
|
|
my $real_msg_id = $obj{Real_Msg_Id}; |
99 |
|
|
$real_msg_id =~ s/^0+//; |
100 |
|
|
my $dir = "$temp_images_directory/$real_msg_id"; |
101 |
|
|
system("mkdir -p $dir"); |
102 |
|
|
if (my $fh = new IO::File ">$dir/image$i.$ext") { |
103 |
|
|
$fh->autoflush(1); |
104 |
|
|
$fh->print($img); |
105 |
|
|
$fh->close(); |
106 |
|
|
} else { |
107 |
|
|
warn "Can\'t open $dir/image$i.$ext: $!"; |
108 |
|
|
return undef; |
109 |
|
|
} |
110 |
|
|
} |
111 |
|
|
} |
112 |
|
|
##### exit(); |
113 |
|
|
##### } elsif (!(grep { $_ == $discovery_section } @{$SPECATTRS{SECT_ID}})) { |
114 |
|
|
##### exit(); |
115 |
|
|
} |
116 |
|
|
|
117 |
|
|
my %src_map = map { $_->auth_id() => $_->name } $keeper->get_documents( |
118 |
|
|
s => $sources_section, |
119 |
|
|
class => 'promosuite::Source', |
120 |
|
|
status => 1, |
121 |
|
|
); |
122 |
|
|
|
123 |
|
|
my $news = new promosuite::Article $keeper; |
124 |
|
|
|
125 |
|
|
foreach my $key (keys %obj) { |
126 |
|
|
next unless exists $fields_map{$key}; |
127 |
|
|
$news->{$fields_map{$key}} = $obj{$key}; |
128 |
|
|
} |
129 |
|
|
|
130 |
|
|
#warn Dumper(\%obj); |
131 |
|
|
#warn Dumper($news); |
132 |
|
|
|
133 |
|
|
my $body = $news->body(); |
134 |
|
|
|
135 |
|
|
$body =~ s/\n{2,}/<p>/gi; |
136 |
|
|
$body =~ s/\n/\ /gi; |
137 |
|
|
$body =~ s/<p>/\n\n/gi; |
138 |
|
|
|
139 |
|
|
$news->body($body); |
140 |
|
|
|
141 |
|
|
## Аннотация, если надо |
142 |
|
|
if ( !$news->{abstr} || $news->{abstr} !~ /\S/) { |
143 |
|
|
my $text = substr($news->body(), 0, 300); |
144 |
|
|
$text =~ s/\s\S+$//; |
145 |
|
|
$news->{abstr} = $text; |
146 |
|
|
} |
147 |
|
|
|
148 |
|
|
my $images = {}; |
149 |
|
|
if (@{$SPECATTRS{Image}}) { |
150 |
|
|
my $i = 0; |
151 |
|
|
foreach my $image (@{$SPECATTRS{Image}}) { |
152 |
|
|
$i++; |
153 |
|
|
my $ind = $i - 1; |
154 |
|
|
my $key = "pictures_$i"; |
155 |
|
|
|
156 |
|
|
my ($img, $file); |
157 |
|
|
if (ref $image eq 'ARRAY') { |
158 |
|
|
($img, $file) = @$image; |
159 |
|
|
} elsif ($obj{MTYPE_ID} == -4) { |
160 |
|
|
my $old_msg_id = $obj{Msg_Id}; |
161 |
|
|
my $dir = "$temp_images_directory/$old_msg_id"; |
162 |
|
|
opendir(D, $dir); |
163 |
|
|
($file) = grep { /^image$i/ } readdir D; |
164 |
|
|
closedir D; |
165 |
|
|
|
166 |
|
|
if ($file) { |
167 |
|
|
if (my $fh = new IO::File "$dir/$file") { |
168 |
|
|
local $/ = undef; |
169 |
|
|
$img = <$fh>; |
170 |
|
|
} else { |
171 |
|
|
warn "Can\'t open $dir/$file: $!"; |
172 |
|
|
next; |
173 |
|
|
} |
174 |
|
|
} else { |
175 |
|
|
next; |
176 |
|
|
} |
177 |
|
|
} |
178 |
|
|
|
179 |
|
|
my ($ext) = ($file =~ /\.(\w+)$/); |
180 |
|
|
$ext = 'gif' unless $ext; |
181 |
|
|
my $ii = post_image($keeper->images_directory(), $ext, $img); |
182 |
|
|
next unless defined $ii; |
183 |
|
|
|
184 |
|
|
$ii->{alt}=$SPECATTRS{IMG_COMMENT}[$ind] if (exists($SPECATTRS{IMG_COMMENT}) && $SPECATTRS{IMG_COMMENT}[$ind]); |
185 |
|
|
$ii->{number} = $i; |
186 |
|
|
|
187 |
|
|
$images->{$key} = $ii; |
188 |
|
|
} |
189 |
|
|
|
190 |
|
|
$images->{maxnumber} = $i; |
191 |
|
|
|
192 |
|
|
local $Data::Dumper::Indent = 0; |
193 |
|
|
$news->images(Dumper($images)); |
194 |
|
|
} |
195 |
|
|
|
196 |
|
|
if (my ($cmd) = grep { /(?:ex_)?photobanner/ } @{$SPECATTRS{itype_id}}) { |
197 |
|
|
exit; |
198 |
|
|
} |
199 |
|
|
|
200 |
|
|
if (my ($cmd) = grep { /interface_lifetime/ } @{$SPECATTRS{Command}}) { |
201 |
|
|
my ($interface, $time) = ($cmd =~ /interface_lifetime\s+(.[^\s]+)\s+(.[^\s]+)$/); |
202 |
|
|
$news->{status} = 0; |
203 |
|
|
} else { |
204 |
|
|
$news->{status} = 0; ##### было 2 |
205 |
|
|
} |
206 |
|
|
|
207 |
|
|
##### $news->{body} =~ tr/\202\204\213\221\222\223\224\225\226\227\233\246\253\271\273/\,\"\<\'\'\"\"\-\-\-\>\|\"\N\"/; |
208 |
|
|
##### $news->{abstr} =~ tr/\202\204\213\221\222\223\224\225\226\227\233\246\253\271\273/\,\"\<\'\'\"\"\-\-\-\>\|\"\N\"/; |
209 |
|
|
#if (scalar @{$SPECATTRS{SECT_ID}}) { |
210 |
|
|
# $news->sections(@{ $SPECATTRS{SECT_ID} }); |
211 |
|
|
#}else{ |
212 |
|
|
$news->sections($news_section); |
213 |
|
|
#} |
214 |
|
|
|
215 |
|
|
if (exists $src_map{$obj{AUTH_ID}}) { |
216 |
|
|
$news->source($src_map{$obj{AUTH_ID}}); |
217 |
|
|
} else { |
218 |
|
|
$news->source("Источник медии # ".$obj{AUTH_ID}); |
219 |
|
|
} |
220 |
|
|
|
221 |
|
|
$news->store(); |
222 |
|
|
|
223 |
|
|
exit; |
224 |
|
|
|
225 |
|
|
sub post_image |
226 |
|
|
{ |
227 |
|
|
my ($dest_dir, $ext, $img) = @_; |
228 |
|
|
|
229 |
|
|
my $uniq = time().'_'.int(rand(10**5)); |
230 |
|
|
my $fname="$uniq.$ext"; |
231 |
|
|
my $imgfile="$dest_dir/$fname"; |
232 |
|
|
|
233 |
|
|
if (my $fh = new IO::File ">$imgfile"){ |
234 |
|
|
$fh->autoflush(1); |
235 |
|
|
$fh->print($img); |
236 |
|
|
$fh->close(); |
237 |
|
|
}else{ |
238 |
|
|
warn "Can\'t open $imgfile: $!"; |
239 |
|
|
return undef; |
240 |
|
|
} |
241 |
|
|
|
242 |
|
|
my ($width, $height) = imgsize($imgfile); |
243 |
|
|
|
244 |
|
|
my $ii = { |
245 |
|
|
filename => $fname, |
246 |
|
|
width => $width, |
247 |
|
|
height => $height, |
248 |
|
|
}; |
249 |
|
|
|
250 |
|
|
$keeper->minimize_image($ii, '100x100'); |
251 |
|
|
|
252 |
|
|
return $ii; |
253 |
|
|
} |
254 |
|
|
|
255 |
|
|
1; |
256 |
|
|
|
257 |
|
|
package ErrorLog; |
258 |
|
|
|
259 |
|
|
sub new { |
260 |
|
|
my ($class, %opts) = @_; |
261 |
|
|
$opts{_FH}=*STDERR unless ($opts{_FH}); |
262 |
|
|
my $self = \%opts; |
263 |
|
|
bless ($self,$class); |
264 |
|
|
return $self; |
265 |
|
|
} |
266 |
|
|
|
267 |
|
|
sub handle{ |
268 |
|
|
my ($self,$level,$msg)=@_; |
269 |
|
|
my $fh=$$self{'_FH'}; |
270 |
|
|
print $fh time()."\t$$\t$level\t$msg\n"; |
271 |
|
|
exit(1) if ($level eq 'fatal'); |
272 |
|
|
return 1; |
273 |
|
|
} |
274 |
|
|
|
275 |
|
|
1; |
276 |
|
|
|