view release on metacpan or  search on metacpan

lib/FB3/Convert.pm  view on Meta::CPAN

package FB3::Convert;

use strict;
use Archive::Zip qw( :ERROR_CODES :CONSTANTS );
use Data::Dumper;
use Term::ANSIColor;
use File::Temp;
use XML::LibXSLT;
use XML::LibXML;
use File::Basename;
use Hash::Merge;
use Cwd qw(cwd abs_path getcwd realpath);
use UUID::Tiny ':std';
use File::Copy qw(copy);
use File::Temp qw/ tempfile tempdir /;
use FB3::Validator;
use utf8;
use URI::Escape;
use Encode qw(encode_utf8 decode_utf8);
use XML::Entities;
use XML::Entities::Data;
use Time::HiRes qw(gettimeofday sleep);
use Lingua::Identify qw(langof);
use Image::Magick;
use File::ShareDir qw/dist_dir/;
binmode(STDOUT,':utf8');

our $VERSION = 0.48;

=head1 NAME

FB3::Convert - scripts and API for converting FB3 from and to different formats

=cut

my $Dist = dist_dir('FB3-Convert');
my $ProfilesDir = $Dist."/profiles";
my $CMYKProfile = $ProfilesDir.'/CoatedFOGRA27.icc';
my $sRGBProfile = $ProfilesDir.'/sRGB_Color_Space.icc';

my %MODULES;
# каким плагином работать - определяется тупо по расширению файла (см. ключ в хэше)
%MODULES = (
  'epub' => {
    'class' => 'FB3::Convert::Epub',
    'unpack' => 1,
  },
  'fb2' => {
    'class' => 'FB3::Convert::FB2',
    'unpack' => 0,
  },
);

my @BlockLevel =
('address','article','aside','blockquote','canvas','dd','div','dl','dt','fieldset','figcaption','figure','footer','form',
'h1','h2','h3','h4','h5','h6',
'header','hr','li','main','nav','noscript','ol','output','p','pre','section','table','tfoot','ul','video',
#формально не блок-левел, но нам их тоже приводить к нормальному виду
'th','tr','td','caption'
);

my $AllEntities = XML::Entities::Data::all;
delete $AllEntities->{'lt'};
delete $AllEntities->{'gt'};
delete $AllEntities->{'quot'};
delete $AllEntities->{'apos'};
delete $AllEntities->{'amp'};

my %escapes = (
  '&'   => '&',
  '<'  => '&lt;',
  '>'  => '&gt;',
  '"'  => '&quot;',
  '\'' => '&apos;',
);
my $xmlesc_rgx = join('|', keys %escapes);

sub xmlescape {

  my $Esc = shift;
  return unless defined $Esc;

  $Esc =~ s/($xmlesc_rgx)/$escapes{$1}/gso;
  return $Esc;

lib/FB3/Convert.pm  view on Meta::CPAN

    my $Item = $X->{'bench_list'}->{$Key};
    my $Cnt = scalar @{$Item->{'timers'}};
    my $Summ=0;
    $Out .= "[key: '$Key'] ";
    $Out .= "[cnt: $Cnt] ";
    foreach my $t ( @{$Item->{'timers'}} ) {
      $Summ += ($t->{'end'} - $t->{'start'});
    }
    $Out .= "[time: ".sprintf('%.4f',$Summ)." sec] ";
    $Out .= "[avg: ".sprintf('%.4f',$Summ/$Cnt)." sec]\n";
    $Out .= "desc: ".$Item->{'desc'}."\n\n" if $Item->{'desc'};
  }

  $X->{'bench_list'} = {};

  $X->Msg("\n".$Out,'w',1) if $X->{'bench'};

  if ($X->{'bench2file'}) {
    open my $F,">>:utf8",$X->{'bench2file'} or $X->Error($!);
    print $F $Out;
    close $F;
  }

}

sub isUseImageProfile {
  my $X = shift;
  my $ImgType = lc(shift) || return;
  return 1 if exists $UseImgProfile{$ImgType} && $UseImgProfile{$ImgType};
}

sub isConvertImageType {
  my $X = shift;
  my $ImgType = shift || return;
  return grep {lc($ImgType) eq $_} @ConvertImgFormat;
}

sub isAllowedImageType {
  my $X = shift;
  my $ImgType = shift || return;
  return grep {lc($ImgType) eq $_} @AccessImgFormat;
}

sub GuessLang {
  my $X = shift;
  my $Text = shift;
  return if length($Text) < 150;
  $Text = substr($Text,0,2000);
  my %LangsHashLocal = Lingua::Identify::langof($Text);
  my @SortedProbability = sort {$b <=> $a} values(%LangsHashLocal);
  foreach my $Lang (keys %LangsHashLocal) {
    return lc($Lang) if $LangsHashLocal{$Lang} == $SortedProbability[0];
  }
}

sub Img2JPG {
  my $X = shift;
  my $ImgFile = shift;
  my $UseProfile = shift || undef;
  my $To = $ImgFile.".jpg";
  my $Image = new Image::Magick;

  $Image->Read($ImgFile); #почему-то у IM "or die" всегда срабатывает...;

  if ($UseProfile) {
    if (!-s $sRGBProfile) {
      $X->Msg("Can't find sRGB ICC profile $sRGBProfile. Try convert to RGB colorspace without profile. May wrong colors for CMYK->RGB\n");
      $Image->Quantize(colorspace=>'sRGB');
    } elsif (!-s $CMYKProfile) {
      $X->Msg("Can't find CMYK ICC profile $CMYKProfile. Try convert to RGB colorspace without profile. May wrong colors for CMYK->RGB\n");
      $Image->Quantize(colorspace=>'sRGB');
    } else {

      #вытираем профили
      $Image->Profile(name => 'ICC', profile => '');
      $Image->Profile(name => 'IPTC', profile => '');

      open my $PHRGB,"<".$sRGBProfile or die $!;
      binmode($PHRGB);
      my $ProfRGBBLOB = join("", <$PHRGB>);
      close $PHRGB;

      open my $PHCMYK,"<".$CMYKProfile or die $!;
      binmode($PHCMYK);
      my $ProfCMYKBLOB = join("", <$PHCMYK>);
      close $PHCMYK;

      $Image->Profile(name => 'ICC', profile => $ProfCMYKBLOB);
      $Image->Profile(name => 'ICC', profile => $ProfRGBBLOB);

     }
  }

  $Image->[0]->Write($To);

  unless (-s $To) {
    $X->Error("Cant't convert $ImgFile to JPG");
  } else {
    unlink($ImgFile);
    return $To;
  }
}

=head1 LICENSE AND COPYRIGHT

Copyright (C) 2018 Litres.ru

The GNU Lesser General Public License version 3.0

FB3::Convert is free software: you can redistribute it and/or modify it
under the terms of the GNU Lesser General Public License as published by
the Free Software Foundation, either version 3.0 of the License.

FB3::Convert is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public
License for more details.

Full text of License L<http://www.gnu.org/licenses/lgpl-3.0.en.html>.

=cut