Perl | 電書魂

‘Perl’ タグのついている投稿

PerlでXHTMLのテキスト内容だけを置換する

2017/10/20

　まあ仕事でEPUBを作っていると恒常的にXHTMLに触ることにはなるのですが、検索で文章中の欧文の部分などを引っかけて修正する時にXHTMLのタグ部分も引っかかってしまって、これこのまま間違えてここも修正しちゃったらエラー直行だよなみたいなケースが時々あります。なのでテキスト部分だけを検索置換対象にできれば便利かなと思って作ってみました。

　XML::LibXMLでXHTMLをパースしてテキストノードだけ選別して置換処理をループで回してるだけです。置換用ファイルは別ファイルにPerlの置換式書いたヤツを読み込む感じで。

　Macのターミナルで

perl コードのファイル.pl 置換対象.xhtml 外部読み込み置換式.pl

　のような感じで実行すれば置換対象のxhtmlを置換して上書きします。

#!/usr/bin/perl
use utf8;
use warnings;
use XML::LibXML;
use Encode qw/encode decode/;

#変換するXHTMLファイルのパスを取得
my $convertXhtmlFilePath = $ARGV[0];
$convertXhtmlFilePath = decode('UTF-8', $convertXhtmlFilePath);
#インポートする置換式入りファイルのパスを取得、内容をインポート
$replaceFilePath = $ARGV[1];
$replaceFilePath = decode('UTF-8', $replaceFilePath);
require $replaceFilePath;

#最初にパース実行
my $parser = XML::LibXML->new();
$parser->no_network(1);
my $dom = $parser->parse_file($convertXhtmlFilePath);
#デフォルト名前空間の対応処置
my $xc = XML::LibXML::XPathContext->new($dom);
$xc->registerNs('xhtml', 'http://www.w3.org/1999/xhtml');
$xc->registerNs('epub', 'http://www.idpf.org/2007/ops');

#####dom置換実行#####
#タグのリスト定義／よくわかんないからhtml5のタグほぼ全部ぶっ込んだ
my @tags = ( '//xhtml:body', '//xhtml:div', '//xhtml:section', '//xhtml:article', '//xhtml:aside', '//xhtml:blockquote', '//xhtml:p', '//xhtml:h1', '//xhtml:h2', '//xhtml:h3', '//xhtml:h4', '//xhtml:h5', '//xhtml:h6', '//xhtml:ruby', '//xhtml:rb', '//xhtml:rt', '//xhtml:rp', '//xhtml:li', '//xhtml:dt', '//xhtml:dd', '//xhtml:td', '//xhtml:th', '//xhtml:caption', '//xhtml:thead', '//xhtml:tfoot', '//xhtml:span', '//xhtml:strong', '//xhtml:em', '//xhtml:small', '//xhtml:cite', '//xhtml:q', '//xhtml:i', '//xhtml:b', '//xhtml:u', '//xhtml:sub', '//xhtml:sup', '//xhtml:pre', '//xhtml:code', '//xhtml:time', '//xhtml:label', '//xhtml:input', '//xhtml:select', '//xhtml:option', '//xhtml:textarea', '//xhtml:a', '//xhtml:address', '//xhtml:figcaption', '//xhtml:abbr', '//xhtml:ins', '//xhtml:del', '//xhtml:fieldset', '//xhtml:legend', '//xhtml:s', '//xhtml:dfn', '//xhtml:var', '//xhtml:samp', '//xhtml:kbd', '//xhtml:mark', '//xhtml:bdi', '//xhtml:bdo', '//xhtml:wbr', '//xhtml:track', '//xhtml:button', '//xhtml:datalist', '//xhtml:output', '//xhtml:detail', '//xhtml:summary', '//xhtml:command', '//xhtml:menu' );
#ループまわしてテキストノードのテキスト部分を置換
foreach $tagName(@tags){
  foreach $tagNode($xc->findnodes($tagName)){
    my @childnodes = $tagNode->childNodes();
    foreach $eachnode(@childnodes){
      #テキストノードかどうか判定して置換を実行
      $type = $eachnode->nodeType;
      if ($type == 3){
        my $originTextContentsData = $eachnode->data;
        #サブルーチンに飛ばして置換処理実行
        my $replacedTextContentsData = & textReplace ($originTextContentsData);
        $eachnode->setData( $replacedTextContentsData );
      }
    }
  }
}

#####シリアライズしてヘッダくっつける#####
my $htmls = $xc->findnodes('//xhtml:html');
$serializedTxt = $$htmls[0]->serialize;
my $mergedTxt = '<?xml version="1.0" encoding="UTF-8"?>' . "\x0A" . '<!DOCTYPE html>' . "\x0A" . $serializedTxt;

#####出力#####
$mergedTxt = encode('UTF-8', $mergedTxt);
open(OUT,"> $convertXhtmlFilePath");
print OUT $mergedTxt;
close (OUT);
exit;

#!/usr/bin/perl

use utf8;

use warnings;

use XML::LibXML;

use Encode qw/encode decode/;

#変換するXHTMLファイルのパスを取得

my $convertXhtmlFilePath = $ARGV[0];

$convertXhtmlFilePath = decode('UTF-8', $convertXhtmlFilePath);

#インポートする置換式入りファイルのパスを取得、内容をインポート

$replaceFilePath = $ARGV[1];

$replaceFilePath = decode('UTF-8', $replaceFilePath);

require $replaceFilePath;

#最初にパース実行

my $parser = XML::LibXML->new();

$parser->no_network(1);

my $dom = $parser->parse_file($convertXhtmlFilePath);

#デフォルト名前空間の対応処置

my $xc = XML::LibXML::XPathContext->new($dom);

$xc->registerNs('xhtml', 'http://www.w3.org/1999/xhtml');

$xc->registerNs('epub', 'http://www.idpf.org/2007/ops');

#####dom置換実行#####

#タグのリスト定義／よくわかんないからhtml5のタグほぼ全部ぶっ込んだ

my @tags = ( '//xhtml:body', '//xhtml:div', '//xhtml:section', '//xhtml:article', '//xhtml:aside', '//xhtml:blockquote', '//xhtml:p', '//xhtml:h1', '//xhtml:h2', '//xhtml:h3', '//xhtml:h4', '//xhtml:h5', '//xhtml:h6', '//xhtml:ruby', '//xhtml:rb', '//xhtml:rt', '//xhtml:rp', '//xhtml:li', '//xhtml:dt', '//xhtml:dd', '//xhtml:td', '//xhtml:th', '//xhtml:caption', '//xhtml:thead', '//xhtml:tfoot', '//xhtml:span', '//xhtml:strong', '//xhtml:em', '//xhtml:small', '//xhtml:cite', '//xhtml:q', '//xhtml:i', '//xhtml:b', '//xhtml:u', '//xhtml:sub', '//xhtml:sup', '//xhtml:pre', '//xhtml:code', '//xhtml:time', '//xhtml:label', '//xhtml:input', '//xhtml:select', '//xhtml:option', '//xhtml:textarea', '//xhtml:a', '//xhtml:address', '//xhtml:figcaption', '//xhtml:abbr', '//xhtml:ins', '//xhtml:del', '//xhtml:fieldset', '//xhtml:legend', '//xhtml:s', '//xhtml:dfn', '//xhtml:var', '//xhtml:samp', '//xhtml:kbd', '//xhtml:mark', '//xhtml:bdi', '//xhtml:bdo', '//xhtml:wbr', '//xhtml:track', '//xhtml:button', '//xhtml:datalist', '//xhtml:output', '//xhtml:detail', '//xhtml:summary', '//xhtml:command', '//xhtml:menu' );

#ループまわしてテキストノードのテキスト部分を置換

foreach $tagName(@tags){

foreach $tagNode($xc->findnodes($tagName)){

my @childnodes = $tagNode->childNodes();

foreach $eachnode(@childnodes){

#テキストノードかどうか判定して置換を実行

$type = $eachnode->nodeType;

if ($type == 3){

my $originTextContentsData = $eachnode->data;

#サブルーチンに飛ばして置換処理実行

my $replacedTextContentsData = & textReplace ($originTextContentsData);

$eachnode->setData( $replacedTextContentsData );

}

#####シリアライズしてヘッダくっつける#####

my $htmls = $xc->findnodes('//xhtml:html');

$serializedTxt = $$htmls[0]->serialize;

my $mergedTxt = '<?xml version="1.0" encoding="UTF-8"?>' . "\x0A" . '<!DOCTYPE html>' . "\x0A" . $serializedTxt;

#####出力#####

$mergedTxt = encode('UTF-8', $mergedTxt);

open(OUT,"> $convertXhtmlFilePath");

print OUT $mergedTxt;

close (OUT);

exit;

　外部置換用ファイルは以下のような感じ。

#! /usr/bin/perl
use utf8;
sub textReplace {
	#置換テキストの取得
	$_ = $_[0];
	######################↓↓↓ここに置換内容を記述↓↓↓######################
	s/サンプル/さんぷる/g;
	######################↑↑↑ここに置換内容を記述↑↑↑######################
	return $_;
}
1;

#! /usr/bin/perl

use utf8;

sub textReplace {

#置換テキストの取得

$_ = $_[0];

######################↓↓↓ここに置換内容を記述↓↓↓######################

s/サンプル/さんぷる/g;

######################↑↑↑ここに置換内容を記述↑↑↑######################

return $_;

}

　いやあ長年作りたかったんですよこういうの。こないだやっとパーサーモジュールでDOM飼い慣らせたんで作れましたよ。うれしい。

（2017.10.20）

タグ: DOM, Perl, XML::LibXML
カテゴリー: 未分類 | コメントはまだありません »

WindowsでXojoからPerlを呼び出して使う

2017/09/25

　Xojoはクロスプラットフォーム開発環境なわけですが、Xojo単体内部でコードが完結してるならともかく、外部のPerlやらなんやらに処理を投げようとするといろいろプラットフォーム環境に依存して面倒なわけです。Macは根っこがBSDUnixなのでデフォルトでいろいろ入ってて面倒がないんですけどね。ということでどうにかこうにかWindowsでXojoからPerlに処理を投げることに成功したのでメモです。@kmutoさん、いろいろと助言ありがとうございました。助かりました。

StrawberryPerlをインストールして環境を構築

　まず、無料のPerl環境、StrawberryPerlをインストールして環境を構築しました。当初Windows10のBash on Ubuntu on Windowsに処理を投げようとしたり、ActivePerl使おうとしたりで四苦八苦しましたが、Bash on Ubuntu on WindowsだとXojo内からシェル経由でコマンド投げようとするといろいろ支障が出てきて動かなかったり（一応このあたりに知見はあるようなんですが手に負えず）、ActivePerlはXMLパーサーモジュールのインストールこれどうすりゃいいのよだったりして結局StrawberryPerlに落ち着きました。これ素晴らしいです。インストーラ普通にあるしCPAN普通に使えるし。セットアップはこのあたりを参考に。

実行ファイルと同じフォルダにPerlのファイルをコピーする指定

　Macではアプリ自体実はフォルダなので、アプリ内のフォルダにPerlのスクリプトをコピーしていたのですが、Winではそういう扱いにならないようなので実行ファイルと同じ階層にコピーする指定をします。で配布時には親フォルダごと渡す。まあ一般的なやつですね。ビルド設定のWindowsのところでビルドステップに「ファイルのコピー」を追加してやり、ウィンドウにコピーするファイルをドラッグアンドドロップしてコピー先に「Contents Folder」を指定すればいいようです。なおサブディレクトリ作ってそこにコピーする指定もできる模様。

XojoからPerlにシェル経由で処理を投げて実行

　あとはXojoからPerlにシェル経由で処理を投げるだけですが、Macとはフォルダの階層が異なるのと、StrawberryPerlの場合はBashではなくコマンドプロンプトに処理を投げることになるためパスやパイプ（コマンド連続実行）の記法が異なることに注意が必要なようです。具体的にはパスはシングルクォートではなくダブルクォートで囲まないとエラーになりますし、パイプに使う記号は「;」ではなく「&」です。なおXojo内でFolderItemのパスを「.NativePath」でString値として取得するとシングルクォートで囲まれた形でパスの文字列が返ってきてしまうので、変換してやらないと処理が通りません。ということでコードは以下のような感じ。

'実行している自身のパスを得る
Dim App as new Application
Dim SelfPath As FolderItem
SelfPath = App.ExecutableFile

'親フォルダのパスを得る
Dim parentFolderPath As FolderItem = GetFolderItem( SelfPath.NativePath ).parent 
Dim parentFolderPathString As String = convertSingleqw2Doubleqw(parentFolderPath.NativePath)

'XMLファイルのパスを取得
Dim xmlFilePathString As String
xmlFilePathString = Window1.filePath.Text

'perlに投げて出力
Dim exportFileCmd As String = "cd " + parentFolderPathString + " & perl test.pl " + &u22 + xmlFilePathString + &u22
Dim Sh As New Shell
Sh.Execute(exportFileCmd)

'実行している自身のパスを得る

Dim App as new Application

Dim SelfPath As FolderItem

SelfPath = App.ExecutableFile

'親フォルダのパスを得る

Dim parentFolderPath As FolderItem = GetFolderItem( SelfPath.NativePath ).parent

Dim parentFolderPathString As String = convertSingleqw2Doubleqw(parentFolderPath.NativePath)

'XMLファイルのパスを取得

Dim xmlFilePathString As String

xmlFilePathString = Window1.filePath.Text

'perlに投げて出力

Dim exportFileCmd As String = "cd " + parentFolderPathString + " & perl test.pl " + &u22 + xmlFilePathString + &u22

Dim Sh As New Shell

Sh.Execute(exportFileCmd)

　シングルクォートをダブルクォートに変換するメソッドは以下のような感じ。なお引数pathStringをString型で定義していて、戻り値もString型で返す感じ。

Dim re as New RegEx
re.SearchPattern = "^&u27(.*?)&u27$"
re.ReplacementPattern = "$1"
re.Options.ReplaceAllMatches = True
Dim convertedPath As String = re.Replace(pathString)
convertedPath = &u22 + convertedPath + &u22
return convertedPath

Dim re as New RegEx

re.SearchPattern = "^&u27(.*?)&u27$"

re.ReplacementPattern = "$1"

re.Options.ReplaceAllMatches = True

Dim convertedPath As String = re.Replace(pathString)

convertedPath = &u22 + convertedPath + &u22

return convertedPath

　ここもうちょいスマートな感じで処理できればなと思うんですけどね。正規表現でゴリゴリ変換ってすごく泥臭い。

（2017.9.25）

タグ: Perl, StrawberryPerl, Windows, Xojo
カテゴリー: 未分類 | コメントはまだありません »

PerlのXML::LibXMLモジュールでShift_JISのXMLのパース

2017/07/27

　PerlのXMLパーサーモジュール、XML::LibXMLで文字コードShift_JISのXMLをパースしようとしてしばらくハマったので将来の自分用にメモを残しておきます。

$doc = $parser->parse_file（〜）でエラー

　XML::LibXMLは$doc = $parser->parse_file（〜）の書式で外部XMLファイルのパスを指定して直接読み込めるのですが、どうもうまくいきません。
用意した読み込み元のXMLは次のような感じ。

<?xml version="1.0" encoding="Shift_JIS"?>
<TEST>
<CONTENTS>
<PARAGRAPH>吾輩は猫である。名前はまだ無い。</PARAGRAPH>
<PARAGRAPH>どこで生れたかとんと見当がつかぬ。</PARAGRAPH>
<PARAGRAPH>何でも薄暗いじめじめした所でニャーニャー泣いていた事だけは記憶している。</PARAGRAPH>
<PARAGRAPH>吾輩はここで始めて人間というものを見た。</PARAGRAPH>
<PARAGRAPH>しかもあとで聞くとそれは書生という人間中で一番獰悪な種族であったそうだ。</PARAGRAPH>
</CONTENTS>
</TEST>

<?xml version="1.0" encoding="Shift_JIS"?>

<TEST>

<PARAGRAPH>吾輩は猫である。名前はまだ無い。</PARAGRAPH>

<PARAGRAPH>どこで生れたかとんと見当がつかぬ。</PARAGRAPH>

<PARAGRAPH>何でも薄暗いじめじめした所でニャーニャー泣いていた事だけは記憶している。</PARAGRAPH>

<PARAGRAPH>吾輩はここで始めて人間というものを見た。</PARAGRAPH>

<PARAGRAPH>しかもあとで聞くとそれは書生という人間中で一番獰悪な種族であったそうだ。</PARAGRAPH>

</CONTENTS>

</TEST>

　これを以下のコードでパースしようとして

#!/usr/bin/perl
use utf8;
use warnings;
use XML::LibXML;
use Encode qw/encode decode/;

#変換するXMLファイルのパスを取得
my $convertXmlFilePath = $ARGV[0];
$convertXmlFilePath = decode('UTF-8', $convertXmlFilePath);

#ファイルを読み込んでパース
my $parser = XML::LibXML->new();
$parser->no_network(1);
my $dom = $parser->parse_file($convertXmlFilePath);

#<TEST>タグの中身取得
my $tags = $dom->findnodes('///TEST');

#テキスト化して配列収納
my @eachLines;
foreach my $tag(@$tags){
  push (@eachLines, $tag->serialize);
}

#テスト出力
my $joinedTxt = join("\x0A",@eachLines);
$joinedTxt = encode('UTF-8', $joinedTxt);
print $joinedTxt . "\n";

#!/usr/bin/perl

use utf8;

use warnings;

use XML::LibXML;

use Encode qw/encode decode/;

#変換するXMLファイルのパスを取得

my $convertXmlFilePath = $ARGV[0];

$convertXmlFilePath = decode('UTF-8', $convertXmlFilePath);

#ファイルを読み込んでパース

my $parser = XML::LibXML->new();

$parser->no_network(1);

my $dom = $parser->parse_file($convertXmlFilePath);

#<TEST>タグの中身取得

my $tags = $dom->findnodes('///TEST');

#テキスト化して配列収納

my @eachLines;

foreach my $tag(@$tags){

push (@eachLines, $tag->serialize);

}

#テスト出力

my $joinedTxt = join("\x0A",@eachLines);

$joinedTxt = encode('UTF-8', $joinedTxt);

print $joinedTxt . "\n";

　以下のようなエラーが返ります。

読み込み元のXMLの文字コード（と宣言文）をUTF-8に変えてやれば普通に読み込めるので、Shift_JIS由来の問題に間違いないようです。どうもXML::LibXMLの$doc = $parser->parse_file（〜）がShift_JISに対応していないのが原因のよう。

$doc = $parser->parse_string（〜）でもエラーになる

　困ったなということでネットでいろいろ情報を集めたのですが、use utf8;を宣言していない例とかしか引っかからなくて困りました。Perlの内部コードをShit_JISにしてやりゃそりゃ読めるでしょうが、Unicodeにしかない文字とか扱う可能性があるのでそれじゃダメなのよ。
　ということで作戦2として、一旦encodeモジュールを使って内部文字列として読み込んでやり、それを$doc = $parser->parse_string（〜）でパースしてみます。コードは以下。

#!/usr/bin/perl
use utf8;
use warnings;
use XML::LibXML;
use Encode qw/encode decode/;

#変換するXMLファイルのパスを取得
my $convertXmlFilePath = $ARGV[0];
$convertXmlFilePath = decode('UTF-8', $convertXmlFilePath);

#内部文字列として一度展開
open(IN,"$convertXmlFilePath");
@eachLineTxts = <IN>;
$xmlTxt = join("",@eachLineTxts);
$xmlTxt = decode('Shift_JIS', $xmlTxt);
close (IN);

#ファイルを読み込んでパース
my $parser = XML::LibXML->new();
$parser->no_network(1);
my $dom = $parser->parse_string($xmlTxt);

#<TEST>タグの中身取得
my $tags = $dom->findnodes('///TEST');

#テキスト化して配列収納
my @eachLines;
foreach my $tag(@$tags){
  push (@eachLines, $tag->serialize);
}

#テスト出力
my $joinedTxt = join("\x0A",@eachLines);
$joinedTxt = encode('UTF-8', $joinedTxt);
print $joinedTxt . "\n";

#!/usr/bin/perl

use utf8;

use warnings;

use XML::LibXML;

use Encode qw/encode decode/;

#変換するXMLファイルのパスを取得

my $convertXmlFilePath = $ARGV[0];

$convertXmlFilePath = decode('UTF-8', $convertXmlFilePath);

#内部文字列として一度展開

open(IN,"$convertXmlFilePath");

@eachLineTxts = <IN>;

$xmlTxt = join("",@eachLineTxts);

$xmlTxt = decode('Shift_JIS', $xmlTxt);

close (IN);

#ファイルを読み込んでパース

my $parser = XML::LibXML->new();

$parser->no_network(1);

my $dom = $parser->parse_string($xmlTxt);

#<TEST>タグの中身取得

my $tags = $dom->findnodes('///TEST');

#テキスト化して配列収納

my @eachLines;

foreach my $tag(@$tags){

push (@eachLines, $tag->serialize);

}

#テスト出力

my $joinedTxt = join("\x0A",@eachLines);

$joinedTxt = encode('UTF-8', $joinedTxt);

print $joinedTxt . "\n";

　しかしこれでもエラー。

　んー・・・

$doc = $parser->読み込んだ文字列内の文字コード宣言の部分を置換して読み込ませて解決

　どうしたものかなとしばらくいろいろ（$dom = XML::LibXML->load_xml();方面とか）試していたのですがうまくいかず。
　もう一度エラー内容とコードを眺めていたら、もしかして読み込みXMLソース内の「encoding="Shift_JIS"」の宣言がイタズラしてるのでは？と思い、一行追加。

#!/usr/bin/perl
use utf8;
use warnings;
use XML::LibXML;
#use XML::LibXML::XPathContext;
use Encode qw/encode decode/;

#変換するXMLファイルのパスを取得
my $convertXmlFilePath = $ARGV[0];
$convertXmlFilePath = decode('UTF-8', $convertXmlFilePath);

#内部文字列として一度展開
open(IN,"$convertXmlFilePath");
@eachLineTxts = <IN>;
$xmlTxt = join("",@eachLineTxts);
$xmlTxt = decode('Shift_JIS', $xmlTxt);
close (IN);

#エンコーディング宣言の部分を置換（↓この行を追記）
$xmlTxt =~ s@encoding=\"Shift_JIS\"@encoding=\"UTF-8\"@;

#ファイルを読み込んでパース
my $parser = XML::LibXML->new();
$parser->no_network(1);
my $dom = $parser->parse_string($xmlTxt);

#<TEST>タグの中身取得
my $tags = $dom->findnodes('///TEST');

#テキスト化して配列収納
my @eachLines;
foreach my $tag(@$tags){
  push (@eachLines, $tag->serialize);
}

#テスト出力
my $joinedTxt = join("\x0A",@eachLines);
$joinedTxt = encode('UTF-8', $joinedTxt);
print $joinedTxt . "\n";

#!/usr/bin/perl

use utf8;

use warnings;

use XML::LibXML;

#use XML::LibXML::XPathContext;

use Encode qw/encode decode/;

#変換するXMLファイルのパスを取得

my $convertXmlFilePath = $ARGV[0];

$convertXmlFilePath = decode('UTF-8', $convertXmlFilePath);

#内部文字列として一度展開

open(IN,"$convertXmlFilePath");

@eachLineTxts = <IN>;

$xmlTxt = join("",@eachLineTxts);

$xmlTxt = decode('Shift_JIS', $xmlTxt);

close (IN);

#エンコーディング宣言の部分を置換（↓この行を追記）

$xmlTxt =~ s@encoding=\"Shift_JIS\"@encoding=\"UTF-8\"@;

#ファイルを読み込んでパース

my $parser = XML::LibXML->new();

$parser->no_network(1);

my $dom = $parser->parse_string($xmlTxt);

#<TEST>タグの中身取得

my $tags = $dom->findnodes('///TEST');

#テキスト化して配列収納

my @eachLines;

foreach my $tag(@$tags){

push (@eachLines, $tag->serialize);

}

#テスト出力

my $joinedTxt = join("\x0A",@eachLines);

$joinedTxt = encode('UTF-8', $joinedTxt);

print $joinedTxt . "\n";

　これでうまくパースできました。

◇

　いやあ文字コードって本当に面倒ですね。

（2017.7.27）

タグ: Perl, Shift_JIS, XML, XML::LibXML, パース
カテゴリー: 未分類 | コメントはまだありません »