| 1 |
|
|---|
| 2 | sub ReadForms { # GET POST
|
|---|
| 3 |
|
|---|
| 4 | my ($self, $key) = @_;
|
|---|
| 5 |
|
|---|
| 6 | my ($buffer,$boundary,$lenpairs,$temp);
|
|---|
| 7 | my (%FORM,%URL);
|
|---|
| 8 | #Libs::ReadF::WriteFile($self,'>FORM',"$ENV{'QUERY_STRING'}\n"); #
|
|---|
| 9 | my $ctr = Text::Iconv->new('UTF-8',$self->{CONF}->{'WebCharset'});
|
|---|
| 10 | $ENV{'QUERY_STRING'}=$ctr->convert($ENV{'QUERY_STRING'});
|
|---|
| 11 | #Libs::ReadF::WriteFile($self,'>FORM',"$ENV{'QUERY_STRING'}\n"); #
|
|---|
| 12 | my @pairs = split(/&/, $ENV{'QUERY_STRING'});
|
|---|
| 13 |
|
|---|
| 14 | foreach my $pair (@pairs) {
|
|---|
| 15 | my ($name, $value) = split(/=/, $pair);
|
|---|
| 16 | $name =~ tr/+/ /;
|
|---|
| 17 | $name =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
|
|---|
| 18 | $value =~ tr/+/ /;
|
|---|
| 19 | $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
|
|---|
| 20 | $value=$ctr->convert($value) if $self->{CONF}->{UTF} eq 'true';
|
|---|
| 21 | $URL{$name} =(! exists $URL{$name} ) ? $value : $URL{$name}.','.$value if $value ne '';
|
|---|
| 22 | #$URL{$name} = $value;
|
|---|
| 23 | }
|
|---|
| 24 | #foreach my $i (keys %URL)
|
|---|
| 25 | #{
|
|---|
| 26 | #Libs::ReadF::WriteFile($self,'>FORM',"Name - $i=$URL{$i}\n"); #
|
|---|
| 27 | #}
|
|---|
| 28 |
|
|---|
| 29 |
|
|---|
| 30 | if ($ENV{'CONTENT_TYPE'} =~ m#^multipart/form-data# ) {
|
|---|
| 31 | binmode(STDIN);
|
|---|
| 32 | seek(STDIN,0,0);
|
|---|
| 33 | read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
|
|---|
| 34 | my ($boundary) = $ENV{CONTENT_TYPE} =~ /boundary=\"?([^\";,]+)\"?/;
|
|---|
| 35 | my @forms = split(/\r\n--$boundary/, $buffer);
|
|---|
| 36 | my %FILE;
|
|---|
| 37 | foreach my $line (@forms) {
|
|---|
| 38 | my ($header, $value) = split(/\r\n\r\n/,$line);
|
|---|
| 39 | my ($name) = $header =~ /name=\"?([^\";]*)\"?/;
|
|---|
| 40 | if ($name eq ''){next}
|
|---|
| 41 | #Libs::ReadF::WriteFile($self,'>FORM',"Name - $name\n"); #
|
|---|
| 42 | $header =~ s/^\r\n//;
|
|---|
| 43 | if ($name eq "targ_i") {$value = "$value:$FORM{'targ_i'}"} # temp
|
|---|
| 44 | #if ($FORM{$name} eq '' && exists $FORM{$name} ){delete $FORM{$name}}
|
|---|
| 45 | $FORM{$name} =(! exists $FORM{$name} ) ? $value : $FORM{$name}.','.$value if $value ne ''; #
|
|---|
| 46 | $FORM{$name . '_header'} = $header;
|
|---|
| 47 | if ($header =~ /filename\=[\'|\"](.*?)[\'|\"]/) #\"(.*?)\"
|
|---|
| 48 | {
|
|---|
| 49 | my $fName=$1;
|
|---|
| 50 | if ($fName ne ''){
|
|---|
| 51 | #Libs::ReadF::WriteFile($self,'>FORM',"Name = [$fName] $header\n");
|
|---|
| 52 | $FILE{$fName}=$value;
|
|---|
| 53 | }
|
|---|
| 54 | }
|
|---|
| 55 |
|
|---|
| 56 | }
|
|---|
| 57 |
|
|---|
| 58 | #foreach my $i (keys %FORM)
|
|---|
| 59 | #{
|
|---|
| 60 | #Libs::ReadF::WriteFile($self,'>FORM',"Name - $i\n"); #
|
|---|
| 61 | #}
|
|---|
| 62 |
|
|---|
| 63 | %{$FORM{'_FILES_'}}=%FILE; #
|
|---|
| 64 | }
|
|---|
| 65 | else {
|
|---|
| 66 |
|
|---|
| 67 | read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
|
|---|
| 68 |
|
|---|
| 69 | my @pairs = split(/&/, $buffer);
|
|---|
| 70 |
|
|---|
| 71 | foreach my $pair (@pairs) {
|
|---|
| 72 | #print STDERR "$pair\n";
|
|---|
| 73 | my ($name, $value) = split(/=/, $pair);
|
|---|
| 74 | $name =~ tr/+/ /;
|
|---|
| 75 |
|
|---|
| 76 | $name =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
|
|---|
| 77 | $value =~ tr/+/ /;
|
|---|
| 78 | $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
|
|---|
| 79 | #if ($FORM{$name} eq '' && exists $FORM{$name} ){delete $FORM{$name}}
|
|---|
| 80 | $FORM{$name} =(! exists $FORM{$name} ) ? $value : $FORM{$name}.','.$value if $value ne '';
|
|---|
| 81 | }
|
|---|
| 82 | }
|
|---|
| 83 | if ($key eq '') {return ({%FORM},{%URL})} else {return $FORM{$key}}
|
|---|
| 84 |
|
|---|
| 85 | }
|
|---|
| 86 |
|
|---|
| 87 |
|
|---|
| 88 |
|
|---|
| 89 |
|
|---|
| 90 |
|
|---|
| 91 | sub SpaceTrim #
|
|---|
| 92 | {
|
|---|
| 93 | my $text=shift;
|
|---|
| 94 | $text =~ s/(^ *| *$)//mg;
|
|---|
| 95 | return $text;
|
|---|
| 96 | }
|
|---|
| 97 |
|
|---|
| 98 |
|
|---|
| 99 | package Libs::Image;
|
|---|
| 100 | use strict;
|
|---|
| 101 | use Image::Magick;
|
|---|
| 102 |
|
|---|
| 103 | sub GenRandomImage{ #
|
|---|
| 104 | my ($self)=@_;
|
|---|
| 105 | my $Text=(&SendSQLCmdR($self,"SELECT SubV from $self->{CONF}->{'DbPrefix'}_MOD_Users_Sessions WHERE Session='$self->{URL}->{md5}'"))[0];
|
|---|
| 106 | if ($Text eq ''){return ''}
|
|---|
| 107 | my $image = Image::Magick->new(magick=>'gif');
|
|---|
| 108 | $image->Set(size=>$self->{CONF}->{'RandomWidth'}.'x'.$self->{CONF}->{'RandomHeight'});
|
|---|
| 109 | $image->ReadImage('xc:'.$self->{CONF}->{'RandomBackColor'});
|
|---|
| 110 | my $step_x=$self->{CONF}->{'RandomTextSize'}*0.75;
|
|---|
| 111 | my $base_x=5;
|
|---|
| 112 | my $base_y=int ($self->{CONF}->{'RandomHeight'}/2+$self->{CONF}->{'RandomTextSize'}/2)-2;
|
|---|
| 113 | if (lc($self->{CONF}->{'RandomFullText'}) eq 'true'){$image->Annotate(antialias =>'true',pointsize =>$self->{CONF}->{'RandomTextSize'},x=>$base_x,y=>$base_y,rotate=>0,fill=>$self->{CONF}->{'RandomTextColor'},encoding=>'windows1251',text=>$Text,font=>$self->{CONF}->{'RandomFont'});}
|
|---|
| 114 | else {
|
|---|
| 115 | foreach my $letter (split(//, $Text))
|
|---|
| 116 | {
|
|---|
| 117 | my $sdvig_x=($self->{CONF}->{'RandomSdvigX'}==0) ? 0 : int(rand(4))-$self->{CONF}->{'RandomSdvigX'};
|
|---|
| 118 | my $sdvig_y=($self->{CONF}->{'RandomSdvigY'}==0) ? 0 : int(rand(10))-$self->{CONF}->{'RandomSdvigY'};
|
|---|
| 119 | my $rotate=($self->{CONF}->{'RandomRotate'}==0) ? 0 : int(rand(30))-$self->{CONF}->{'RandomRotate'};
|
|---|
| 120 | $image->Annotate(antialias =>'true',pointsize =>$self->{CONF}->{'RandomTextSize'},x=>$base_x+$sdvig_x,y=>$base_y+$sdvig_y,rotate=>$rotate,fill=>$self->{CONF}->{'RandomTextColor'},encoding=>'windows1251',text=>$letter,font=>$self->{CONF}->{'RandomFont'});
|
|---|
| 121 | $base_x+=$step_x;
|
|---|
| 122 | }
|
|---|
| 123 | }
|
|---|
| 124 | for my $i (1..$self->{CONF}->{'RandomNoise'})
|
|---|
| 125 | {
|
|---|
| 126 | my $rnd_x=int(rand($self->{CONF}->{'RandomWidth'}));
|
|---|
| 127 | my $rnd_y=int(rand($self->{CONF}->{'RandomHeight'}));
|
|---|
| 128 | $image->Set("pixel[$rnd_x,$rnd_y]"=>$self->{CONF}->{'RandomNoiseColor'});
|
|---|
| 129 | }
|
|---|
| 130 | return ($image->ImageToBlob())[0];
|
|---|
| 131 | #$image->Write("$Text.gif");
|
|---|
| 132 | #$Img=$image->BlobToImage($Img);
|
|---|
| 133 | #return $image->IimageToBlob('-:gif');
|
|---|
| 134 | #my $File=$image->ImageToBlob($image);
|
|---|
| 135 | #print "sdfsdf $File";
|
|---|
| 136 | #my $File=&ReadBinFile($self,"$Text.gif");
|
|---|
| 137 | #unlink("$Text.gif");
|
|---|
| 138 | #return $File;
|
|---|
| 139 | }
|
|---|
| 140 |
|
|---|
| 141 |
|
|---|
| 142 |
|
|---|
| 143 | sub ResizeImageH{ # Height
|
|---|
| 144 | my ($self,$image,$H)=@_;
|
|---|
| 145 | if (ref($image) ne 'Image::Magick'){ #
|
|---|
| 146 | my $File=$image;
|
|---|
| 147 | $image=Image::Magick->new;
|
|---|
| 148 | my $x = $image->Read("$File");
|
|---|
| 149 | if ($x ne '') {return 'false'};
|
|---|
| 150 | }
|
|---|
| 151 | my @ImgInfo=&GetImgInfo($self,$image);
|
|---|
| 152 | my $Pers=int($H*$ImgInfo[0]/$ImgInfo[1]) if $ImgInfo[0]/$ImgInfo[1] != 0;
|
|---|
| 153 | $image->Resize(geometry=>'100x100"+1"00"+1"00', width=>$Pers, height=>$H);
|
|---|
| 154 | return $image; #
|
|---|
| 155 | }
|
|---|
| 156 |
|
|---|
| 157 | sub ResizeImageW{ # Width
|
|---|
| 158 | my ($self,$image,$W)=@_;
|
|---|
| 159 |
|
|---|
| 160 | if (ref($image) ne 'Image::Magick'){ #
|
|---|
| 161 | my $File=$image;
|
|---|
| 162 | $image=Image::Magick->new;
|
|---|
| 163 | my $x = $image->Read("$File");
|
|---|
| 164 | if ($x ne '') {return 'false'};
|
|---|
| 165 | }
|
|---|
| 166 | my @ImgInfo=&GetImgInfo($self,$image);
|
|---|
| 167 |
|
|---|
| 168 | my $Pers=int($W*$ImgInfo[1]/$ImgInfo[0]) if $ImgInfo[0]/$ImgInfo[1] != 0;
|
|---|
| 169 | $image->Resize(geometry=>'100x100"+1"00"+1"00', width=>$W, height=>$Pers);
|
|---|
| 170 |
|
|---|
| 171 | return $image; #
|
|---|
| 172 | }
|
|---|
| 173 |
|
|---|
| 174 | sub CropImage{ # X,Y
|
|---|
| 175 | my ($self,$image,$W,$H)=@_;
|
|---|
| 176 | if (ref($image) ne 'Image::Magick'){ #
|
|---|
| 177 | my $File=$image;
|
|---|
| 178 | $image=Image::Magick->new;
|
|---|
| 179 | my $x = $image->Read("$File");
|
|---|
| 180 | if ($x ne '') {return 'false'};
|
|---|
| 181 | }
|
|---|
| 182 | my @ImgInfo=&GetImgInfo($self,$image);
|
|---|
| 183 | if ($ImgInfo[0]>$ImgInfo[1]){$image->Crop(geometry=>'100x100"+1"00"+1"00', width=>$W, height=>$H,'x'=>0, 'y'=>(($ImgInfo[1]-$H)/2));} #
|
|---|
| 184 | else{$image->Crop(geometry=>'100x100"+1"00"+1"00', width=>$W, height=>$H, 'y'=>0,'x'=>(($ImgInfo[0]-$W)/2));}
|
|---|
| 185 | return $image;
|
|---|
| 186 | }
|
|---|
| 187 |
|
|---|
| 188 | sub ResizeImageWH{ # Width Height
|
|---|
| 189 | my ($self,$image,$W,$H)=@_;
|
|---|
| 190 | if (ref($image) ne 'Image::Magick'){ #
|
|---|
| 191 | my $File=$image;
|
|---|
| 192 | $image=Image::Magick->new;
|
|---|
| 193 | my $x = $image->Read("$File");
|
|---|
| 194 | if ($x ne '') {return 'false'};
|
|---|
| 195 | }
|
|---|
| 196 | my @ImgInfo=&GetImgInfo($self,$image);
|
|---|
| 197 | if ($ImgInfo[0]>$ImgInfo[1]){$image=($W>$H) ? &ResizeImageW($self,$image,$W) : &ResizeImageW($self,$image,$H)}
|
|---|
| 198 | else{$image=($W>$H) ? &ResizeImageH($self,$image,$W): &ResizeImageH($self,$image,$H)}
|
|---|
| 199 | my @ImgInfo=&GetImgInfo($self,$image);
|
|---|
| 200 | $image=(($W>$H) && ($ImgInfo[0]>$ImgInfo[1])) ? &CropImage($self,$image,$W,$H) : &CropImage($self,$image,$H,$W);
|
|---|
| 201 |
|
|---|
| 202 | return $image; #
|
|---|
| 203 | # ,
|
|---|
| 204 | }
|
|---|
| 205 |
|
|---|
| 206 |
|
|---|
| 207 | sub FlatternImage{ #
|
|---|
| 208 | my ($self,$image,$Name,$W,$H)=@_;
|
|---|
| 209 | if (ref($image) ne 'Image::Magick'){ #
|
|---|
| 210 | my $File=$image;
|
|---|
| 211 | $image=Image::Magick->new;
|
|---|
| 212 | my $x = $image->Read("$File");
|
|---|
| 213 | if ($x ne '') {return 'false'};
|
|---|
| 214 | }
|
|---|
| 215 | my @ImgInfo=&GetImgInfo($self,$image);
|
|---|
| 216 | my $File=($ImgInfo[0]>$ImgInfo[1]) ? 'hor_mask.jpg' : 'vert_mask.jpg';
|
|---|
| 217 | my $Template=Image::Magick->new;
|
|---|
| 218 |
|
|---|
| 219 | $Template->Read("$self->{CONF}->{DirMod}/$File");
|
|---|
| 220 | $image=&ResizeImageWH($self,$image,$W,$H);
|
|---|
| 221 | $Template->Composite(image=>$image,geometry=>'100x100+'.$self->{CONF}->{FlatternOffsetX}.'+'.$self->{CONF}->{FlatternOffsetY},gravity=>'NorthWest',compose=>'Over');
|
|---|
| 222 | if ($Name ne '') {$Template->Write($Name)}
|
|---|
| 223 |
|
|---|
| 224 | return $Template;
|
|---|
| 225 | }
|
|---|
| 226 |
|
|---|
| 227 | sub FlatternTransImage{ #
|
|---|
| 228 | my ($self,$image,$Name)=@_;
|
|---|
| 229 | my $logo=Image::Magick->new;
|
|---|
| 230 | my $x = $logo->Read("../img/logo_img.gif");
|
|---|
| 231 | my ($lX,$lY)=&GetImgInfo($self,$logo);
|
|---|
| 232 | my $Template=Image::Magick->new;
|
|---|
| 233 | $Template->Read("..$image");
|
|---|
| 234 | # $image=&ResizeImageWH($self,$ModName,$image,$W,$H);
|
|---|
| 235 | my ($tX,$tY)=&GetImgInfo($self,$Template);
|
|---|
| 236 | $Template->Composite(image=>$logo,gravity=>'NorthWest',geometry=>'100x100',x=>(($tX-$lX)/2),y=>(($tY-$lY)/2+($tY-$lY)/2-20),compose=>'Over');
|
|---|
| 237 | if ($Name ne '') {$Template->Write($Name)}
|
|---|
| 238 | #$Template->Write("IMG.jpg");
|
|---|
| 239 | #my $File=&ReadBinFile($self,"$Text.gif");
|
|---|
| 240 | #unlink("$Text.gif");
|
|---|
| 241 | #return $File;
|
|---|
| 242 | #my @blobs = $Template->ImageToBlob();
|
|---|
| 243 | #my $blobs[0];
|
|---|
| 244 | return ($Template->ImageToBlob())[0];
|
|---|
| 245 | }
|
|---|
| 246 |
|
|---|
| 247 | sub FlatternImageWidth{ # . Width
|
|---|
| 248 | my ($self,$image,$Name,$W,$H)=@_;
|
|---|
| 249 | #&Debugger($self,$image);
|
|---|
| 250 | if (ref($image) ne 'Image::Magick'){ #
|
|---|
| 251 | my $File=$image;
|
|---|
| 252 | $image=Image::Magick->new;
|
|---|
| 253 | my $x = $image->Read("$File");
|
|---|
| 254 | if ($x ne '') {return 'false'};
|
|---|
| 255 | }
|
|---|
| 256 | my @ImgInfo=&GetImgInfo($self,$image);
|
|---|
| 257 | my $File=($ImgInfo[0]>$ImgInfo[1]) ? 'hor_mask.jpg' : 'vert_small_mask.jpg';
|
|---|
| 258 | my $Template=Image::Magick->new;
|
|---|
| 259 | $Template->Read("$self->{CONF}->{DirMod}/$File");
|
|---|
| 260 | my $Pers=int($H*$H/$W);
|
|---|
| 261 | $image=($ImgInfo[0]>$ImgInfo[1]) ? &ResizeImageWH($self,$image,$W,$H) : &ResizeImageWH($self,$image,$H,$Pers);
|
|---|
| 262 | $Template->Composite(image=>$image,geometry=>'100x100+'.$self->{CONF}->{FlatternOffsetX}.'+'.$self->{CONF}->{FlatternOffsetX},gravity=>'NorthWest',compose=>'Over');
|
|---|
| 263 | if ($Name ne '') {$Template->Write($Name)}
|
|---|
| 264 | return $Template;
|
|---|
| 265 | }
|
|---|
| 266 |
|
|---|
| 267 | sub GetImgInfo{ # , colorspace,density,units,width,height
|
|---|
| 268 | my ($self,$image)=@_;
|
|---|
| 269 | if (ref( $image ) ne 'Image::Magick'){ #
|
|---|
| 270 | my $File=$image;
|
|---|
| 271 | $image=Image::Magick->new;
|
|---|
| 272 | my $x = $image->Read("$File");
|
|---|
| 273 | if ($x ne '') {return 'false'};
|
|---|
| 274 | }
|
|---|
| 275 | my @temp=$image->Get('width','height','colorspace','density','units');
|
|---|
| 276 | return @temp;
|
|---|
| 277 | }
|
|---|
| 278 |
|
|---|
| 279 | sub ThumbnailImage{ # , colorspace,density,units,width,height
|
|---|
| 280 | my ($self,$image,$size,$tmb)=@_;
|
|---|
| 281 | my $File;
|
|---|
| 282 | if (ref( $image ) ne 'Image::Magick'){ #
|
|---|
| 283 | $File=$image;
|
|---|
| 284 | $image=Image::Magick->new;
|
|---|
| 285 | my $x = $image->Read("$File");
|
|---|
| 286 | if ($x ne '') {return 'false'};
|
|---|
| 287 | }
|
|---|
| 288 |
|
|---|
| 289 | $image->Contrast();
|
|---|
| 290 | $image->Thumbnail(width=>$size, height=>$size);
|
|---|
| 291 | #Libs::ReadF::WriteFile($self,'>Thumb',"$tmb\n"); #
|
|---|
| 292 | #$image->Write($tmb);
|
|---|
| 293 | my $x;
|
|---|
| 294 | if ($tmb ne '') {$x=$image->Write("$tmb")}
|
|---|
| 295 | Libs::ReadF::WriteFile($self,'>Thumb',"$x $tmb\n");
|
|---|
| 296 | return 'true';
|
|---|
| 297 | }
|
|---|
| 298 |
|
|---|
| 299 |
|
|---|
| 300 |
|
|---|
| 301 |
|
|---|
| 302 | sub ImgConvert{ # , colorspace,density,units,width,height
|
|---|
| 303 | my ($self,$image)=@_;
|
|---|
| 304 | if ($image eq '') {return}
|
|---|
| 305 | my $File;
|
|---|
| 306 |
|
|---|
| 307 | if (ref( $image ) ne 'Image::Magick'){ #
|
|---|
| 308 | $File=$image;
|
|---|
| 309 | $image=Image::Magick->new;
|
|---|
| 310 | my $x = $image->Read("$File");
|
|---|
| 311 | if ($x ne '') {return 'false'};
|
|---|
| 312 | }
|
|---|
| 313 | $File =~ s/tif/png/i;
|
|---|
| 314 | $image->Set('density'=>'200');
|
|---|
| 315 | my $x = $image->Write("$File");
|
|---|
| 316 | my @temp=$image->Get('width','height','colorspace','density');
|
|---|
| 317 | return @temp;
|
|---|
| 318 | }
|
|---|
| 319 |
|
|---|
| 320 | 1;
|
|---|
| 321 |
|
|---|
| 322 |
|
|---|
| 323 |
|
|---|
| 324 |
|
|---|
| 325 |
|
|---|
| 326 |
|
|---|
| 327 |
|
|---|
| 328 |
|
|---|
| 329 |
|
|---|