view release on metacpan or  search on metacpan

bin/fb3_to_fb2.pl  view on Meta::CPAN

die ("param -fb3: file '".$OPT{'fb3'}."' not exists") unless -e $OPT{'fb3'};
die ("param -fb2 not defined") unless defined $OPT{'fb2'};
$OPT{'genremap'} //= dist_file("FB3-Convert", "fb3_to_fb2_genre.json");

#CHECK --fb2,--fb3 
my $FileName = $OPT{'fb3'};
$FileName =~ s/.*?([^\/]+)$/$1/;
$FileName =~ s/\.fb3$//;
#если директория, кладем в нее под именем fb3
$OPT{'fb2'} =~ s/\/$//;
$OPT{'fb2'} = $OPT{'fb2'}.'/'.$FileName if -d $OPT{'fb2'};
#еще проверка, не сунули нам неправильную директорию?
my $Fb2Dir = $OPT{'fb2'};
$Fb2Dir =~ s/([^\/]+)$//;
die ("param fb2: dir '$Fb2Dir' not exists") unless -d $Fb2Dir;
$OPT{'fb2'} .= '.fb2' unless $OPT{'fb2'} =~ m/\.fb2$/;

#все ок, поехали
print "Start convert FB3 (".$OPT{'fb3'}.") to FB2 (".$OPT{'fb2'}.")\n" if $OPT{'verbose'};

my (@FB2XML, @FB2ImgXML, $NS, %NS);
my $FB3Package = OPC->new( $OPT{'fb3'} );

#Находим Description?
my %DescrRelation = $FB3Package->RelationByType( '/_rels/.rels', RELATION_TYPE_FB3_BOOK );
my $DescrRelsPartName = $DescrRelation{'TargetFullName'};

#Находим body
my $BodyRelsPartName = $DescrRelsPartName;
$BodyRelsPartName =~ s/^(.*)\/([^\/]*)$/$1\/\_rels\/$2\.rels/;
my %BodyRelation = $FB3Package->RelationByType( $BodyRelsPartName, RELATION_TYPE_FB3_BODY );

#Картинки соберем первыми, до всяких преобразований xslt

#а где у нас  описание body?
my $BodyRelsPartName = $BodyRelation{'TargetFullName'};
$BodyRelsPartName =~ s/^(.*)\/([^\/]*)$/$1\/\_rels\/$2\.rels/;

#где у нас обложка?
my @Img;
my ($CoverRelation) = $FB3Package->RelationsByType( '/_rels/.rels', RELATION_TYPE_OPC_THUMBNAIL );
if ($CoverRelation->{'TargetFullName'}) {
  $CoverRelation->{IsCover} = 1;
  push @Img, $CoverRelation;
}

#читаем картинки
push @Img, $FB3Package->RelationsByType( $BodyRelsPartName, RELATION_TYPE_FB3_IMAGES );

my (%ImgRels, %ImgReverse);
my (%LinkRels);
foreach my $Img (@Img) {
  print "Processing img ".$Img->{'Id'}."\n" if $OPT{'verbose'};
  
  my $ImgType;
  my $ImgContent = $FB3Package->PartContents($Img->{'TargetFullName'});
  my $ImgType = $FB3Package->PartContentType($Img->{'TargetFullName'});
  
  #SVG конвертим в PNG
  if ( $ImgType eq 'image/svg' || $ImgType eq 'image/svg+xml' || $Img->{'TargetFullName'} =~ /\.svg$/ ) {
    $ImgContent = Svg2Png($ImgContent);
    $ImgType = 'image/png';
    $Img->{'TargetFullName'} = SvgUnique($Img->{'TargetFullName'}, \@Img);
  } else {
    $ImgType = 'image/png' if $Img->{'TargetFullName'} =~ /\.png$/;
    $ImgType = 'image/jpeg' if $Img->{'TargetFullName'} =~ /\.(jpg|jpeg)$/;
    $ImgType = 'image/gif' if $Img->{'TargetFullName'} =~ /\.gif$/;
  }
  
  my $NewImgId = $Img->{'TargetFullName'};
	$NewImgId = URI::Escape::uri_unescape($NewImgId);
	$NewImgId = DecodeUtf8($NewImgId);
	$NewImgId = TransLitGeneral($NewImgId) if $NewImgId =~ /[А-Яа-я]/;
  $NewImgId =~ s#/#_#g;
  $NewImgId =~ s/^_//;
  if ($ImgType =~ /\/(.+)$/) {
    $NewImgId .= '.'.$1 unless $NewImgId =~ /\.(png|gif|jpg|jpeg)$/;
  }

  $Img->{NewId} = $ImgRels{$Img->{'Id'}} = $NewImgId;

  next if exists $ImgReverse{$NewImgId}; #иногда описания картинок совпадают. например обложка залетает дважды из описаний
  $ImgReverse{$NewImgId} = 1;

  push @FB2ImgXML, '<binary content-type="'.$ImgType.'" id="'.$NewImgId.'">'.MIME::Base64::encode($ImgContent).'</binary>';
}

#работаем с DESCRIPTION
my $DescrXML = $FB3Package->PartContents($DescrRelsPartName);
my $xc = XML::LibXML::XPathContext->new($Parser->parse_string($DescrXML)); 
$xc->registerNs('fb3', &NS_FB3_DESCRIPTION); 


#запихаем в xml данные обложки
if ($Img[0]->{'IsCover'} &&  (my $RootDescr = $xc->findnodes("/fb3:fb3-description")->[0]) ){
  my $CoverElement = $Doc->createElement('coverpage');
  $CoverElement->setAttribute('href'=> $Img[0]->{'NewId'});
  $RootDescr->appendChild($CoverElement);
  $DescrXML = $RootDescr->toString();
}

#тянем preamble из description
my @Preamble;
if (my $Pr = $xc->findnodes("/fb3:fb3-description/fb3:preamble")->[0]) {
   map { push @Preamble,  CopyNode($_);} $Pr->childNodes();
}

my $FB2Descr = TransformXML($DescrXML, XSL_FB3_TO_FB2_DESC);
print "Transform Description ok\n" if $OPT{'verbose'};

my @NewGenreNodes = $xc->findnodes("/fb3:fb3-description/fb3:fb3-classification/fb3:subject/text()");
my @NewGenres = map $_->data, @NewGenreNodes;
my %Genre2GenreAlias = NewGenreToOldMap(@NewGenres);

my $Node = RootNode($FB2Descr, ['/fb:description/fb:title-info/fb:genre', \%Genre2GenreAlias, 1]);
push @FB2XML, '<description>'.$Node->{'Content'}.'</description>'; #собираем контент
map {$NS{$_} = $Node->{NS}->{$_}} keys %{$Node->{NS}}; #собираем NS

#работаем с BODY
my $BodyXML = $FB3Package->PartContents( $BodyRelation{'TargetFullName'} );
my $xc = XML::LibXML::XPathContext->new($Parser->parse_string($BodyXML)); 

bin/fb3_to_fb2.pl  view on Meta::CPAN

      last;
    }
  }
}
## /change node id

if ($ChangedByTitle || $ChangedByNode) {
  my $RootNode = $xc->findnodes("/fb3:fb3-body")->[0];
  $BodyXML = $RootNode->toString();
}

my $FB2Body = TransformXML($BodyXML, XSL_FB3_TO_FB2_BODY);
print "Transform Body ok\n" if $OPT{'verbose'};
my $Node = RootNode($FB2Body);

push @FB2XML, $Node->{'Content'}; #собираем контент
map {$NS{$_} = $Node->{NS}->{$_}} keys %{$Node->{NS}}; #собираем NS

#собираем NS
$NS .= join (" ", map{$_.'="'.$NS{$_}.'"'} keys %NS); 
$NS = " ".$NS if $NS; 

my $OUT = '<?xml version="1.0" encoding="UTF-8"?>
<FictionBook'.$NS.'>'.join('',@FB2XML).join('',@FB2ImgXML).'</FictionBook>';

#проверка валидности полученного FB2
my $Schema = XML::LibXML::Schema->new(location => $OPT{'fb2xsd'});
my $FB2 = $Parser->parse_string($OUT);
eval { $Schema->validate($FB2) };
die "Schema validation error for file $OPT{'fb3'}: $@" if $@ && !$OPT{'force'};

#Все прошло ок, сохраняем файл
print "Save file to ".$OPT{'fb2'}."\n" if $OPT{'verbose'};
open F,">".$OPT{'fb2'} || die "can't open file $OPT{'fb2'}: $!";
binmode(F,':utf8');
print F $OUT;
close F;

sub CopyNode {
  my $Node = shift;
  
  #текстовую  не трогаем
  return $Node if $Node->nodeName eq '#text';

  #копируем атрибуты
  my $El= $Doc->createElement($Node->nodeName);
  foreach my $Att ($Node->attributes){
    next if $Att->nodeName =~ /xmlns(?::|$)/;
    $El->setAttribute($Att->localname, $Att->value);
  }
  
  #копируем чайлд-ноды
  foreach my $Child ($Node->childNodes){
    $El->appendChild( CopyNode($Child) );
  }
 
  return $El;
}

sub Svg2Png {
  my $Img = shift;
   
  my $Rsvg = new Image::LibRSVG();
  my $Formats  = $Rsvg->getSupportedFormats();    
    
  die "can't convert svg to png or jpeg. librsvg not supported PNG" unless $Rsvg->isFormatSupported("png");
 
  $Rsvg->loadImageFromString($Img);
  
  my ($TmpFH, $TmpFile) = File::Temp::tempfile(UNLINK => 1);
  $Rsvg->saveAs( $TmpFile,  'png') || die "can't convert svg: $!";
  
  my $Content;
  while (my $row = <$TmpFH>) {
    $Content .= $row;  
  }
  close $TmpFH;
 
  return $Content,
}

sub TransformXML{
	my $XML=shift;
	my $XSL=shift;

	my $Xslt = XML::LibXSLT->new();
  
  #все .svg у нас теперь .png ВЕЗДЕ
  $Xslt->register_function('LTR', 'RplId', sub {
      my $Str  = shift;
      if ($Str =~ /^(#)?(.+)/) { # может попасться якорь "#", учитываем
        $Str = $1.$ImgRels{$2} if exists $ImgRels{$2};
        $Str = $1.$LinkRels{$2} if exists $LinkRels{$2};
      }
      return $Str;
    }
  );

  $Xslt->register_function('LTR', 'RplLocalHref', sub {
      my $Str    = shift;
      my $Prefix = shift;
      if ($Str =~ /^#(.+)/) {
        $Str = '#'.$Prefix.$1;
      }
      return $Str;
    }
  );

  my $Source = $Parser->parse_string($XML);
	my $StyleDoc = $Parser->parse_file($XSL);
	my $Stylesheet = $Xslt->parse_stylesheet($StyleDoc);

	return $Stylesheet->output_string($Stylesheet->transform($Source));
}

#вытащим весь корень из части xml,
#собираем NS из частей, потом запихнем их в общий корень
sub RootNode {
  my $XML=shift;
  my $Replace=shift; # ['xpath', {'содержимое' => 'замена1', 'содержимое2' => 'замена2',...}, delete bool]