Line # Revision Author
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