未分類 | 電書魂

‘未分類’ カテゴリーのアーカイブ

「東大新図書館計画と次世代デジタルアーカイブ」に行ってきた

2014/11/03

　去る10月18日、東京大学図書館で行われたイベント「東大新図書館トークイベント10「東大新図書館計画と次世代デジタルアーカイブ」」に行ってきました。

　これは第13回東京大学ホームカミング・デイの一環として開催されたイベントなのですが、一般の人でも聞けるとのことで、「東大版ヨーロピアナをいかにつくるのか?」という副題にも興味があったので行ってきました。

　Ustreamで公開もされていたということで、本当はもう少し早めに、一度しっかり映像を見直してからエントリを書きたかったのですが、公開期間の2週間をもう過ぎてしまったようで、今見に行っても映像を見ることが出来ませんでした。残念ですが、まあ既に公式のまとめ記事も上がっているようですので、ここでは記憶と、私個人の雑感を中心に書いてみることとします。

「情報の蓄積を発想力に変えられるか」

　まずは、国立情報学研究所の高野明彦先生のセッションから。「文化の深い記憶を呼び戻す連想情報技術」と題して、「Webcat Plus」、「新書マップ」、「Book Town じんぼう」、「文化遺産オンライン」、といった高野先生の数々のお仕事の紹介がありました。さらには、これらの各検索データベースを繋ぐ「想 IMAGINE」というサイトが紹介されました。表層部分の検索・データベース化はGoogleによってあらかた達成されているが、深い場所の情報のネットワーク化はまだ手が届いていない部分が多くあるため、これのデータベース化を目指したとのこと。
　Webcat Plusはちょっと試してみましたが、興味を持ったジャンルの本の類書を探すシーンなどではかなり役に立ちそうでした。これはいずれAmazonのリコメンドをさらに発展させたような、書籍のディスカバラビリティに繋がっていく技術なのだろうと思います。

　高野先生のセッションの中で、特に印象的だった言葉に「水芸から蒸気機関へ」というものがあります。いわゆるビッグデータ的なデータの活用の文脈で語られた言葉だったと思うのですが、現状のビッグデータ活用はまだ「水芸」に過ぎず、今後の情報処理はコンテンツを変換する「蒸気機関」を目指さねばならない、という趣旨の言葉でした。キーワードは「検索から連想へ」とのことです。以前このテーマで高野先生が書かれた論文がこちら。

　確かにビッグデータは近年のホットワードですが、まだビッグデータの処理そのものを中核としてビジネスモデルを構築した例はそう多くないようにも思えます。既存のビジネスの補完的な役割に留まっているというのが現状でしょう。今後、全く新しいビジネスモデルがビッグデータの処理を中核として出てくるとすれば、現在米国企業一強と言っていいITの勢力図も、まだまだ今後どう転ぶかわからないとも言えそうです。

「なぜ欧州はグーグルに挑むのか」

　続いて、弁護士の福井健策先生のセッション。国立国会図書館の取り組みなど、日本のアーカイビングの取り組みについての説明があった後、EUの「ヨーロピアナ」の説明がありました。
　そもそもヨーロピアナとは欧州連合（EU）が、2005年から構築を開始した電子図書館ポータルサイトで、現在既に3000万点のコンテンツが閲覧できるとのこと。のみならず、掲載コンテンツの使用条件が明記されていることがとても利便性を高めているとのことで、このあたりはクリエイティブ・コモンズにも通じる考え方です。

　福井先生からも説明がありましたが、現在過去のコンテンツの利用の大きな壁になっているのは、実は権利者に支払うお金そのものというよりも、どこにいるか分からない権利者を探しだし、交渉するコストの方なわけで、その意味でコンテンツの使用条件をあらかじめ明らかにしておくことはとても重要です。
　EUが巨大予算を投じてのヨーロピアナ構築に踏み切った背景には、Googleを中心とした英米企業による「知の寡占」状態に対しての深刻な危機感があったとのことで、このままでは英米による文化侵略が（Googleがそれを意図していないとしても）急速に進みかねないという意識が、この事業の推進を強力に後押ししたとのこと。Googleの検索エンジン利用シェアは現在88%にも上るそうで、確かにこの数字はEUに危機感を抱かせるに十分なものと思えます。私たち日本人にしてもこの点は全く他人事ではないでしょう。

　福井先生からはこのあと、日本のアーカイブ計画における課題として、専門的な職能を持った人員の不足や、欧州や近隣アジア諸国に比べても圧倒的なデジタル化予算の不足、著作権法の整備が進んでいないことなどが挙げられました。
　特に大きな問題として、（昨今良く聞く言葉ですが）「孤児作品」、つまり著作権は切れていないと思われるものの、権利者がどこにいるのか分からない作品の問題について触れています。孤児作品は国立国会図書館によると明治期図書の71%にもなるそうです。

　こうした諸問題を解決に導くために、日本でも「デジタルアーカイブ振興法」の早期成立が必要、との提言がありました。
　この法律のもとで、アーカイブ振興基本計画の作成、全国のデジタルアーカイブのネットワーク化、デジタル化ラボ、字幕化ラボの設置、各国アーカイブとの相互接続、公的資金で制作・収集された情報資産のデジタル公開を義務化・利用ルールの公開、デジタルアーキビストの育成と関連技術開発、孤児作品・絶版作品のデジタル活用促進などの施策を進める必要があり、また、デジタルアーカイブに必要十分な予算を確保するための下準備としても法律が必要とのこと。
　このあたりのことに関しては、近著『誰が「知」を独占するのか』に詳しいようですので、ご一読をおすすめしておきます。

　それから、やはりこれに関連して近日、『アーカイブ立国宣言』という書籍が出版されます（ステマだと非難されるのもヤなんであらかじめ書いてしまいますが、電子化をお手伝いさせていただきました（笑））。こちらは実験的に紙の本を購入した人に対して電子本を無料でダウンロード出来るようにするという取り組みを行うようですので、紙で買う方が多分お得です。

◇

　「見て歩く者」の鷹野凌さんが今年の初めに予告されていたように、今年はやはり図書館関係が熱い年でした。これは市場的な面から見ても当然で、いわゆる専門書・学術書といったような分野の本は、従来もあまり「書店」でたくさん売れるというイメージはなく、主に図書館や大学の研究室によって購入されてきました。つまりここは、Amazon KindleやiBookStoreといった既存の一般書向けの電子書店がカバーしきれていないエリアです。今後、この分野の電子化の進展には大きく期待したいところですが、それにはやはり国会図書館をはじめとした図書館との連携が鍵になってくるのだろうと思っています。

（2014.11.5）

タグ: デジタルアーカイブ, ヨーロピアナ, 図書館
カテゴリー: 未分類 | コメントはまだありません »

表組みをCSV経由でXHTMLにしてみた

2014/09/16

　InDesignデータからのEPUB制作で、悩ましいポイントのひとつが「表組み」の対応です。InDesignのEPUB書き出し機能を使うことでInDesign内の表をテーブル形式で書き出すことはできますが、InDesignの表組み機能では、そもそもセルの内容が複数ページにまたがるような場合には分割して作る必要があり、これの修正には当然相応の手間がかかります。また、そもそも元データがInDesign内の表作成機能を使用して作られていないケースも多々あります。
　また、現状多くのビューアでテーブル表示の対応が不完全で、これを受けて電書協ガイドではテーブル要素を非対応としているという現状もあります。このため、現在のEPUB作成では、現実的な解として表組みのページを画像として挿入しています。
　ただ、この形では当然文字を拡大することはできませんし、将来的にはアクセシビリティ対応にも支障をきたしそうです。

　そこで、InDesign内の表組みをCSV経由でXHTMLに変換することを考えてみました。CSV（カンマ区切りテキスト）は、ExcelやKeynoteから書き出して生成することができますので、InDesign内の表をコピーしてExcel等にペーストし、CSV形式で書き出してPerlで変換するという流れでワークフロー化することができます。Excel等の表計算ソフトであれば、比較的簡単に表の内容の編集・整理が可能ですので、かなり柔軟な処理ができると思います。

　PerlでCSVを扱う際に問題になるのは各項目の分割（パース）で、項目内にカンマが含まれていないなら普通にsplit関数で分割できるのですが、含まれている場合には結構面倒なことになりますので、今回は素直にCSV用のモジュール「Text::CSV_XS」を使いました。cpanminusがインストール済みの環境であれば、ターミナルで

sudo cpanm Text::CSV_XS

　と入力すればインストールできるはずです。

　また、今回出力するXHTMLファイルは最初の項目と次の項目を全角スペース区切りで並べ、次行との区別のためにぶら下がりインデントを指定する形にしてみました。表ではなくなってしまいますが、これならばまあ表示できないビューアはありません。本当はtable要素なりdiv要素のdisplay:table指定なりを使いたいところですが、現状ではまあ仕方ありません。

　変換元データはこんな感じ。なお今回はPerl側で変換元の文字コードにUTF-8を指定しています。ExcelからCSVを出力した場合はShift_Jisで出力されるようですので、一度テキストエディタで開いて文字コードを変換する必要があります。なお、今回利用したNumbersでは出力時に文字コードを指定できる模様です。

　スクリプト的には外部からXHTMLのテンプレートを読み込む形にしても良いのですが、今回はコンパクトにしたかったのでソースコード内部に直にテンプレートを記述する形にしています。こういうのを「ヒアドキュメント」と呼ぶらしいです（初めて使いましたよ）。まあ可読性も良いですし悪くない形かなと思っています。以下が変換スクリプトになります。これに引数としてCSVファイルを食わせてやればXHTMLファイルを出力します。

#! /usr/bin/perl
use utf8;
use Encode qw/encode decode/;
use Text::CSV_XS;

######################↓↓↓テンプレート（各行）↓↓↓######################
my $innerTemplate = <<'EOS';
<div class="h-indent-1em">
<p><span class="bold">XXXfirstitemXXX</span>　XXXseconditemXXX</p>
</div>
EOS
######################↑↑↑テンプレート（各行）↑↑↑######################

######################↓↓↓テンプレート（ヘッダフッタ）↓↓↓######################
my $outerTemplate = <<'EOS';
<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE html>
<html
 xmlns="http://www.w3.org/1999/xhtml"
 xmlns:epub="http://www.idpf.org/2007/ops"
 xml:lang="ja"
 class="vrtl"
>
<head>
<meta charset="UTF-8"/>
<title>作品名</title>
<link rel="stylesheet" type="text/css" href="../style/book-style.css"/>
</head>
<body class="p-text">
<div class="main">

XXXinnerstringXXX
</div>
</body>
</html>
EOS
######################↑↑↑テンプレート（ヘッダフッタ）↑↑↑######################

######################↓↓↓メイン部分↓↓↓######################
#変換Textファイルのパスを取得
my $convertCsvFilePath = $ARGV[0];
$convertCsvFilePath = decode('UTF-8', $convertCsvFilePath);

#出力ファイルパスの定義
my $exportXhtmlFilePath = $convertCsvFilePath;
$exportXhtmlFilePath =~ s@\.csv$@\.xhtml@;

#各テキストファイルを展開、置換
open(IN,"$convertCsvFilePath");
#改行コードの統一処理
@eachLineTxts = <IN>;
$eachLineTxt = join("",@eachLineTxts);
$eachLineTxt =~ s@\x0D\x0A@\x0D@g;
$eachLineTxt =~ s@\x0A@\x0D@g;
@eachLineTxts = split("\x0D",$eachLineTxt);
$joinedTxt = join("\x0D\x0A",@eachLineTxts);
$joinedTxt = decode('UTF-8', $joinedTxt);
close (IN);
#置換処理
my $replacedTxt = & textReplace ($joinedTxt);
#出力
$replacedTxt = encode('UTF-8', $replacedTxt);
open(OUT,"> $exportXhtmlFilePath");
print OUT $replacedTxt;
close (OUT);
exit;
######################↑↑↑メイン部分↑↑↑######################

######################↓↓↓変換サブルーチン↓↓↓######################
sub textReplace {
#置換テキストの取得
$_ = $_[0];

#各行の置換処理
my @generatedLine;
my @eachlines = split(/\x0D\x0A/,$_);

foreach $eachline(@eachlines){
  #Text::CSV_XSでcsvをパースして各パラメータを取り出す
  my $csvRef = Text::CSV_XS->new;
  $csvRef->parse($eachline);
  my @eachparameters = $csvRef->fields;
  my $firstItem = $eachparameters[0];
  my $secondItem = $eachparameters[1];
  #空欄なら処理せず、空欄でなければ各行テンプレートと合成
  my $processingString = $innerTemplate;
  if ($firstItem eq ""){
    next;
  } else {
    $processingString =~ s@XXXfirstitemXXX@$firstItem@;
  }
  if ($secondItem eq ""){
    next;
  } else {
    $processingString =~ s@XXXseconditemXXX@$secondItem@;
  }
  push (@generatedLine,$processingString);
}
#各行を結合
$innerString = join("<p><br /></p>\x0D\x0A",@generatedLine);
#ヘッダフッタ部分を合成
$_ = $outerTemplate;
$_ =~ s@XXXinnerstringXXX@$innerString@;

return $_;
}
######################↑↑↑変換サブルーチン↑↑↑######################

100

101

102

103

104

105

106

107

#! /usr/bin/perl

use utf8;

use Encode qw/encode decode/;

use Text::CSV_XS;

######################↓↓↓テンプレート（各行）↓↓↓######################

my $innerTemplate = <<'EOS';

<p><span class="bold">XXXfirstitemXXX</span>　XXXseconditemXXX</p>

</div>

EOS

######################↑↑↑テンプレート（各行）↑↑↑######################

######################↓↓↓テンプレート（ヘッダフッタ）↓↓↓######################

my $outerTemplate = <<'EOS';

<?xml version="1.0" encoding="UTF-8"?>

<!DOCTYPE html>

<html

xmlns="http://www.w3.org/1999/xhtml"

xmlns:epub="http://www.idpf.org/2007/ops"

xml:lang="ja"

class="vrtl"

<head>

</head>

XXXinnerstringXXX

</div>

</body>

</html>

EOS

######################↑↑↑テンプレート（ヘッダフッタ）↑↑↑######################

######################↓↓↓メイン部分↓↓↓######################

#変換Textファイルのパスを取得

my $convertCsvFilePath = $ARGV[0];

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

#出力ファイルパスの定義

my $exportXhtmlFilePath = $convertCsvFilePath;

$exportXhtmlFilePath =~ s@\.csv$@\.xhtml@;

#各テキストファイルを展開、置換

open(IN,"$convertCsvFilePath");

#改行コードの統一処理

@eachLineTxts = <IN>;

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

$eachLineTxt =~ s@\x0D\x0A@\x0D@g;

$eachLineTxt =~ s@\x0A@\x0D@g;

@eachLineTxts = split("\x0D",$eachLineTxt);

$joinedTxt = join("\x0D\x0A",@eachLineTxts);

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

close (IN);

#置換処理

my $replacedTxt = & textReplace ($joinedTxt);

#出力

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

open(OUT,"> $exportXhtmlFilePath");

print OUT $replacedTxt;

close (OUT);

exit;

######################↑↑↑メイン部分↑↑↑######################

######################↓↓↓変換サブルーチン↓↓↓######################

sub textReplace {

#置換テキストの取得

$_ = $_[0];

#各行の置換処理

my @generatedLine;

my @eachlines = split(/\x0D\x0A/,$_);

foreach $eachline(@eachlines){

#Text::CSV_XSでcsvをパースして各パラメータを取り出す

my $csvRef = Text::CSV_XS->new;

$csvRef->parse($eachline);

my @eachparameters = $csvRef->fields;

my $firstItem = $eachparameters[0];

my $secondItem = $eachparameters[1];

#空欄なら処理せず、空欄でなければ各行テンプレートと合成

my $processingString = $innerTemplate;

if ($firstItem eq ""){

next;

} else {

$processingString =~ s@XXXfirstitemXXX@$firstItem@;

}

if ($secondItem eq ""){

next;

} else {

$processingString =~ s@XXXseconditemXXX@$secondItem@;

}

push (@generatedLine,$processingString);

}

#各行を結合

$innerString = join("<p><br /></p>\x0D\x0A",@generatedLine);

#ヘッダフッタ部分を合成

$_ = $outerTemplate;

$_ =~ s@XXXinnerstringXXX@$innerString@;

return $_;

}

######################↑↑↑変換サブルーチン↑↑↑######################

　出力結果はこんな感じ。

<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE html>
<html
 xmlns="http://www.w3.org/1999/xhtml"
 xmlns:epub="http://www.idpf.org/2007/ops"
 xml:lang="ja"
 class="vrtl"
>
<head>
<meta charset="UTF-8"/>
<title>作品名</title>
<link rel="stylesheet" type="text/css" href="../style/book-style.css"/>
</head>
<body class="p-text">
<div class="main">

<div class="h-indent-1em">
<p><span class="bold">項目1</span>　内容テキスト入る1</p>
</div>
<p><br /></p>
<div class="h-indent-1em">
<p><span class="bold">項目2</span>　内容テキスト入る2</p>
</div>
<p><br /></p>
<div class="h-indent-1em">
<p><span class="bold">項目3</span>　内容テキスト入る3</p>
</div>
<p><br /></p>
<div class="h-indent-1em">
<p><span class="bold">項目4</span>　内容テキスト入る4</p>
</div>
<p><br /></p>
<div class="h-indent-1em">
<p><span class="bold">項目5</span>　内容テキスト入る5</p>
</div>

</div>
</body>
</html>

<?xml version="1.0" encoding="UTF-8"?>

<!DOCTYPE html>

<html

xmlns="http://www.w3.org/1999/xhtml"

xmlns:epub="http://www.idpf.org/2007/ops"

xml:lang="ja"

class="vrtl"

<head>

</head>

<p><span class="bold">項目1</span>　内容テキスト入る1</p>

</div>

<p><span class="bold">項目2</span>　内容テキスト入る2</p>

</div>

<p><span class="bold">項目3</span>　内容テキスト入る3</p>

</div>

<p><span class="bold">項目4</span>　内容テキスト入る4</p>

</div>

<p><span class="bold">項目5</span>　内容テキスト入る5</p>

</div>

</body>

</html>

　できたできた。

　やっていることは比較的単純で、読み込んだCSVファイルの各行の項目をモジュールで分割し、各行のテンプレートに入れ込む処理をしてから合成済みのテキストを配列に収納し、最後に配列内の各行を結合しています。その後でヘッダフッタを合成。テンプレート部分を書き換えるだけでそれなりに便利に使えるかと思います。いずれEPUBでテーブルが普通に使用できるようになったとしても、まあ応用は効きそうかなと思っています。

（2014.9.16）

タグ: csv, Perl, table, 表組み
カテゴリー: 未分類 | コメントはまだありません »

電書協ガイドEPUB用試し読みファイル生成スクリプト

2014/07/16

　電子書籍の制作時に、コンテンツファイルと同時に納品が求められるものに「試し読みファイル」があります。これは例えばAmazonであれば画面右側の「1-Clickで今すぐ買う」ボタンの下にある「今すぐ無料サンプルを送信」ボタンから各端末に配信することで読める「試し読み用コンテンツ」のことで、通常冒頭の10％程度を読むことができます。BookLiveなどでは現在ブラウザ画面内で試し読みが出来るようです。
　この「試し読みファイル」は、各配信ストアや電子取次がサービスとして作成することを行っている場合もあるようなのですが、まだ別途必要とするストアもあるようで、現状まだ納品が求められます。また、各配信ストアや電子取次の作った試し読みファイルは出版社に支給されるわけではないため、自社サイトでのプロモーション用途には別途ファイルを用意する必要がある、といった事情もあるのではないかと思います。
　このため、コンテンツファイル完成後に試し読みファイルを制作する必要があるのですが、単純な読み物的なコンテンツならまだしも、画像やリンクが多数含まれるようなリフロー型のEPUBコンテンツを加工して試し読みファイルを制作するのは、実は結構面倒な作業です。

　そこでこの部分を自動化すべくスクリプト化を図っていたのですが、完成し、私の所属する会社から公開の許可も得られましたので公開させていただきます。
　なお、このスクリプトは「電書協ガイド仕様のリフロー型EPUB」用として作っております。例えばでんでんコンバーターやRomancerなどで生成した、仕様の異なるEPUBでは、処理後にEPUBソースの手直しが必要になると思われます（おそらく階層化した目次まわり）。あらかじめご了承ください。

使用方法

あらかじめZIP展開したEPUBフォルダ内の文書XHTMLファイル内に「++Trial reading is so far++」もしくは「++試し読みここまで++」という表記をコメント文等で記述しておきます。その後ターミナル等で
perl makesampleepub.pl（このスクリプトのソースファイル）展開したEPUBのフォルダのパス「試し読みはここまで」などと記載されたXHTMLファイルのパス
と入力して実行すると、展開したEPUBのフォルダと同一の階層に試し読みファイルが生成されます。ファイルがデスクトップにあるなら

perl /Users/username/Desktop/makesampleepub.pl /Users/username/Desktop/testepubfile /Users/username/Desktop/試し読みはここまで.xhtml

のような感じです。usernameのところは環境に合わせて差し替えてください。また、XHTMLファイルはあらかじめ作成しておく必要があります。

処理内容の詳細

EPUBコンテンツを先頭から読んでゆき、「++Trial reading is so far++」もしくは「++試し読みここまで++」という文が含まれる行が出てきたらそこでファイルを分割、以後のコンテンツを削除
必要のなくなったXHTML文書ファイル、画像ファイルを削除
OPFファイル内の消去したXHTML文書ファイル、画像ファイル関連の記述を削除、書名に「【試し読み版】」の記述を追記
文書ファイル消去により無効になったコンテンツ内リンクの消去
文書ファイル消去により無効になったHTML目次項目のリンクの消去
文書ファイル消去により無効になった論理目次項目の消去
「試し読みはここまで」などと記載されたXHTMLファイルをコンテンツ末尾に挿入、OPFにファイル情報を追記
以上の処理を行い、試し読みEPUBファイルを生成

ソースファイル

#! /usr/bin/perl
use utf8;
use Encode qw/encode decode/;
use File::Basename qw/basename dirname/;
use File::Path;
use File::Find;

#EPUBフォルダのパスを取得、インポート
my $epubFolderPath = $ARGV[0];
$epubFolderPath = decode('UTF-8', $epubFolderPath);
#「この続きは〜」記述ファイルのパスを取得、インポート
my $pSampleFilePath = $ARGV[1];
$pSampleFilePath = decode('UTF-8', $pSampleFilePath);

###################EPUBフォルダを作業用フォルダにコピー###################
my $epubFileName = basename $epubFolderPath;
my $epubWorkFolderPath = '/tmp/' . "sample_" . $epubFileName;
my $epubFolderCopyCommand = "cp -R " . '"' . $epubFolderPath . '"' . " " . '"' . $epubWorkFolderPath . '"';
system $epubFolderCopyCommand;

###################各ファイルへのパス/ファイル名取得###################
#EPUB出力先のパスを取得
my $epubExportPath = dirname $epubFolderPath;

#OPF、Xhtml、imageの各ファイルへのパスを取得
my @opfFilePath;
my @xhtmlFilePath;
my @imageFilePath;
find(\&getEachFile, $epubWorkFolderPath);

#OPFファイルへのパス取得
my $opfFilePath = $opfFilePath[0];

#論理目次ファイルのファイル名取得
my $navFileName = &getNavFileName($opfFilePath);

#論理目次ファイルの絶対パス取得
my @navFilePathList;
find(\&getNavFile, $epubWorkFolderPath);
my $navFilePath = $navFilePathList[0];

#OPFのSpine指定をもとにEPUB内表示順にXHTMLファイルへのパスの配列を取得
my @spineFileList = &getSpineFileList($opfFilePath);

###################不要なファイルの削除処理###################
#XHTMLファイルを表示順で展開し、試し読み指示テキストが出てくる箇所でXHTMLファイルを分割/それ以後のXHTMLファイルを削除
my @existAndDeletedFileList = &cutXhtmlFile(@spineFileList);

#消さなかったXHTMLファイルのフルパス/消したXHTMLファイルのファイル名の各リストを取得
my @existFilePathList = @{$existAndDeletedFileList[0]};
my @deletedXhtmlFileList = @{$existAndDeletedFileList[1]};

#消さなかったXHTMLファイルを順番に展開し、リンクされているイメージファイルへのフルパスをリストとして取得
my @eachArray = (\@existFilePathList,$epubWorkFolderPath);
my @linkedImageFilesPathList = &getLinkedImageFile(@eachArray);

#要らないイメージファイルを消去
my @eachArray = (\@imageFilePath,\@linkedImageFilesPathList);

#消した画像ファイルのファイル名リストを取得
my @deletedImageFileList = &deleteUnlinkedImageFile(@eachArray);

###################不要なOPF行の削除処理###################
#OPFのManifest、Spineの整理、Titleへの「試し読み」文言挿入
my $xhtmlFolderPath = dirname $existFilePathList[0];
my @deletedAllFileList = (\@deletedXhtmlFileList,\@deletedImageFileList,$opfFilePath,$xhtmlFolderPath);
&opfCleanUp(@deletedAllFileList);

###################切れたリンクの削除処理###################
my @eachArray = (\@existFilePathList,\@deletedXhtmlFileList,$navFilePath);
&unmatchedLinkFix(@eachArray);

###################試し読みはここまでファイルの自動挿入処理###################
my $copySpotPath = $xhtmlFolderPath . "/p-sample.xhtml";
my @eachPath = ($pSampleFilePath,$copySpotPath,$opfFilePath);
&insertPsampleXhtml(@eachPath);

###################epubファイル作成処理###################
#出力先パスを取得
my $outputEpubName = basename $epubWorkFolderPath;
my $syscommand = 'cd ' . '"' . $epubWorkFolderPath . '"' . ';zip -0 -X '. '"../' . $outputEpubName . '.epub"' . ' mimetype;zip -r ' . '"../' . $outputEpubName . '.epub' . '"' . ' * -x mimetype */.DS_Store */*/.DS_Store */*/*/.DS_Store';
system $syscommand;

my $epubMoveTargetPath = dirname $epubFolderPath;
my $epubPreGenaratePath = $epubWorkFolderPath . $outputEpubName . '.epub';
my $epubMoveCommand = 'mv -f ' . '"' . $epubWorkFolderPath . ".epub" . '"' . " " . '"' . $epubMoveTargetPath . '"';
system $epubMoveCommand;

###################作業ファイルの削除処理###################
rmtree($epubWorkFolderPath);
exit;

#サブルーチン
sub getEachFile {
	my $file = $_;
	my $path = $File::Find::name;
	push(@opfFilePath,$path) if ($path =~ /^(.*?)\.opf$/);
	push(@xhtmlFilePath,$path) if ($path =~ /^(.*?)\.xhtml$/i);
	push(@imageFilePath,$path) if ($path =~ /^(.*?)\.(jpg|jpeg|png|gif)$/i);
}

sub getNavFile {
	my $file = $_;
	my $path = $File::Find::name;
	push(@navFilePathList,$path) if ($path =~ /^.*?\/$navFileName$/);
}

sub getSpineFileList {
	my $opfFilePath = $_[0];
	open(IN,"$opfFilePath");
		#改行コードの統一処理
		@eachLineOpfTxts = <IN>;
		$eachLineOpfTxt = join("",@eachLineOpfTxts);
		$eachLineOpfTxt =~ s@\x0D\x0A@\x0D@g;
		$eachLineOpfTxt =~ s@\x0A@\x0D@g;
		@eachLineOpfTxts = split("\x0D",$eachLineOpfTxt);
	close (IN);
	#SPINEのidrefを取得
	my @idrefList;
	foreach my $line(@eachLineOpfTxts) {
		if ($line =~ /^.*?idref=\"(.*?)\".*?$/){
			$line =~ s@^.*?idref=\"(.*?)\".*?$@$1@;
			push(@idrefList,$line);
		}
	}
	#SPINEのidrefをキーに各XHTMLファイルへのパスを取得
	my $itemPath = dirname $opfFilePath;
	my @spineFileList;
	foreach my $idref(@idrefList){
		my @href = grep /id=\"$idref\"/,@eachLineOpfTxts;
		my $hrefPath = $href[0];
		$hrefPath =~ s@^.*?href=\"(.*?)\".*?$@$1@;
		$hrefPath = $itemPath . "/" . $hrefPath;
		push(@spineFileList,$hrefPath);
	}
	return @spineFileList;
}

sub cutXhtmlFile {
	my @spineFileList = @_;
	our $sampleFileOutputFlag = "yet";
	our @existFilePathList;
	our @deletedFileList;
	foreach $eachFilePath(@spineFileList){
		$eachFilePath = encode('UTF-8', $eachFilePath);
		#サンプルファイルがすでに出力されていたらファイルを削除する処理
		if ($sampleFileOutputFlag eq "dune"){
		#消去ファイルのリストにpush
			$deleteFileName = basename $eachFilePath;
			push(@deletedFileList,$deleteFileName);
			unlink $eachFilePath;
		} else {
		#存在ファイルのリストにpush
			$existFileName = basename $eachFilePath;
			push(@existFilePathList,$eachFilePath);
			open(IN,"$eachFilePath");
			#改行コードの統一処理
				@mySPLITFILEtxts = <IN>;
				$mySPLITFILEtxts = join("",@mySPLITFILEtxts);
				$mySPLITFILEtxts =~ s@\x0D\x0A@\x0D@g;
				$mySPLITFILEtxts =~ s@\x0A@\x0D@g;
				$mySPLITFILEtxts = decode('UTF-8', $mySPLITFILEtxts);
				@eachLine = split("\x0D",$mySPLITFILEtxts);
			close (IN);
		#「++Trial reading is so far++」もしくは「++試し読みここまで++」という文が含まれる行が出てきたらそこまでの行を出力
			my @outputTxt = ();
			foreach $line (@eachLine){
				if ($line =~ /(\+\+Trial reading is so far\+\+|\+\+試し読みここまで\+\+)/){
					open(OUT,"> $eachFilePath");
						foreach (@outputTxt){
							$_ = encode('UTF-8', $_);
							print OUT $_ . "\r\n";
						}
					close (OUT);
					#html tidyで閉じタグ自動補正
					my $fixXhtmlCommand = "tidy -xml -utf8 -m -q " . '"' . $eachFilePath . '"';
					system $fixXhtmlCommand;
					#tidyで修正後の改行コード関係修正
					open(IN,"$eachFilePath");
						#改行コードの統一処理
						@myTxts = <IN>;
						my $myTxts = join("",@myTxts);
						$myTxts =~ s@\x0D\x0A@\x0D@g;
						$myTxts =~ s@\x0A@\x0D@g;
						@myTxts = split("\x0D",$myTxts);
						$myTxt = join("\x0D\x0A",@myTxts);
						$myTxt = decode('UTF-8', $myTxt);
					close (IN);
					#改行コード削除処理
					my @blockObjectArray = qw/address center dir dl fieldset h1 h2 h3 h4 h5 h6 hr isindex menu noframes noscript ol p pre ul/;
					my @inlineObjectArray = qw /a abbr acronym applet b basefont bdo big br button cite code dfn em font i iframe img input kbd label map object q s samp script select small span strike strong sub sup textarea tt u var/;
					foreach $object(@blockObjectArray){
						$myTxt =~ s@<$object([^<>]*?)>\x0D\x0A@<$object$1>@g;
						$myTxt =~ s@\x0D\x0A</$object>@</$object>@g;
					}
					foreach $object(@inlineObjectArray){
						$myTxt =~ s@\x0D\x0A<$object([^<>]*?)>\x0D\x0A@<$object$1>@g;
						$myTxt =~ s@<$object([^<>]*?)>\x0D\x0A@<$object$1>@g;
						$myTxt =~ s@\x0D\x0A<$object([^<>]*?)>@<$object$1>@g;
						$myTxt =~ s@\x0D\x0A</$object>\x0D\x0A@</$object>@g;
						$myTxt =~ s@\x0D\x0A</$object>@</$object>@g;
						$myTxt =~ s@</$object>\x0D\x0A@</$object>@g;
					}
					$myTxt =~ s@\"\x0D\x0A@\" @g;
					$myTxt =~ s@<body([^<>]*?)>@\x0D\x0A<body$1>\x0D\x0A@g;
					#再出力
					open(OUT,"> $eachFilePath");
						$myTxt = encode('UTF-8', $myTxt);
						print OUT $myTxt;
					close (OUT);
					$sampleFileOutputFlag = "dune";
					last;
				} else {
					push(@outputTxt,$line);
				}
			}
		}
	}
	my @existAndDeletedFileList = (\@existFilePathList,\@deletedFileList);
	return @existAndDeletedFileList;
}

sub getLinkedImageFile {
	my @existFilePathList = @{$_[0]};
	my $epubFolderPath = $_[1];
	my @linkedImageFilesList;
	my @linkedImageFilesPathList;
	foreach $eachExistFilePath(@existFilePathList){
	open(IN,"$eachExistFilePath");
		#改行コードの統一処理
		@mySPLITFILEtxts = <IN>;
		$mySPLITFILEtxts = join("",@mySPLITFILEtxts);
		$mySPLITFILEtxts =~ s@\x0D\x0A@\x0D@g;
		$mySPLITFILEtxts =~ s@\x0A@\x0D@g;
		$mySPLITFILEtxts = decode('UTF-8', $mySPLITFILEtxts);
		@eachLine = split("\x0D",$mySPLITFILEtxts);
		my $joinedTxt = join("\x0D\x0A",@eachLine);
	close (IN);
	my @imageFileNames = ($joinedTxt =~ /([^\/]+\.jpg|[^\/]+\.JPG|[^\/]+\.jpeg|[^\/]+\.JPEG|[^\/]+\.png|[^\/]+\.PNG|[^\/]+\.gif|[^\/]+\.GIF)/g);
	foreach $imageFileName (@imageFileNames){
		find(\&getImageFilePath, $epubFolderPath);
			sub getImageFilePath {
				my $file = $_;
				my $path = $File::Find::name;
				push(@linkedImageFilesPathList,$path) if ($path =~ /.*?\/$imageFileName$/);
			}
		}
	}
	#重複削除
	my %hash;
	@hash{ @linkedImageFilesPathList } = ();
	my @linkedImageFilesPathList = keys %hash;
	return @linkedImageFilesPathList;
}

sub deleteUnlinkedImageFile {
	my @imageFilePath = @{$_[0]};
	my @linkedImageFilesPathList = @{$_[1]};

	#配列の差分を出す
	my %cnt = ();  
	map { $cnt{$_}-- } @linkedImageFilesPathList;  
	my @UnlinkedImageFilePathList = grep { ++$cnt{$_} == 1 } @imageFilePath;
	my @deletedImageFilesList;
	#いらなくなった画像ファイルを消す
	foreach $UnlinkedImageFilePath (@UnlinkedImageFilePathList){
		my $UnlinkedImageFileName = basename $UnlinkedImageFilePath;
		push(@deletedImageFilesList,$UnlinkedImageFileName);
		unlink $UnlinkedImageFilePath;
	}
	#消したファイル名を返す
	return @deletedImageFilesList;
}

sub opfCleanUp {
	my @deletedXhtmlFileList = @{$_[0]};
	my @deletedImageFileList = @{$_[1]};
	my $opfFilePath = $_[2];
	my $xhtmlFolderPath = $_[3];

	#######OPFのSPINE要素内の不要となったXHTMLファイルの宣言を削除#######
	#OPFファイルを開く
	open(IN,"$opfFilePath");
		#改行コードの統一処理
		@eachLineOpfTxts = <IN>;
		$eachLineOpfTxt = join("",@eachLineOpfTxts);
		$eachLineOpfTxt =~ s@\x0D\x0A@\x0D@g;
		$eachLineOpfTxt =~ s@\x0A@\x0D@g;
		@eachLineOpfTxts = split("\x0D",$eachLineOpfTxt);
	close (IN);
	#不要となった各XHTMLファイルに対応するidrefの取得
	our @deletedIdrefList;
		foreach my $eachDeletedFile(@deletedXhtmlFileList){
			my @idrefLine = grep /(<item .*?id ?= ?\"(.*?)\"\ .*?href ?= ?\".*?$eachDeletedFile\".*?\/>|<item .*?href ?= ?\".*?$eachDeletedFile\" .*?id ?= ?\"(.*?)\".*?\/>)/,@eachLineOpfTxts;
			my $idrefName = $idrefLine[0];
			$idrefName =~ s@^.*?id ?= ?\"(.*?)\".*?$@$1@;
			push(@deletedIdrefList,$idrefName);
		}
	#OPFのテキストを連結
	our $joinedOpfText = join("\x0D\x0A",@eachLineOpfTxts);
	$joinedOpfText = decode('UTF-8', $joinedOpfText);
	#manifest（XHTML）の削除
	foreach my $eachDeletedFile(@deletedXhtmlFileList){
		$joinedOpfText =~ s@<item .*?href ?= ?\".*?$eachDeletedFile\".*?\/>\x0D\x0A@@;
	}
	#manifest（IMAGE）の削除
	foreach my $eachDeletedFile(@deletedImageFileList){
		$joinedOpfText =~ s@<item .*?href ?= ?\".*?$eachDeletedFile\".*?\/>\x0D\x0A@@;
	}
	#spineの削除
	foreach my $eachIdrefName(@deletedIdrefList){
		$joinedOpfText =~ s@<itemref .*?idref ?= ?\"$eachIdrefName\".*?\/>\x0D\x0A@@;
	}
	#Titleに「試し読み版」表記を追加
	$joinedOpfText =~ s@<dc:title([^>]*?)>(.*?)</dc:title>@<dc:title$1>【試し読み版】$2</dc:title>@;

	#manifestのxhtml部分に「p-sample.xhtml」追記
	my $opfFileDirName = dirname $opfFilePath;
	if ($opfFileDirName eq $xhtmlFolderPath){
		$joinedOpfText =~ s@/>.*?(\x0D\x0A\x0D\x0A|\x0D\x0A).*?</manifest>@/>\x0D\x0A<item media-type="application/xhtml+xml" id="p-sample" href="p-sample.xhtml" />\x0D\x0A\x0D\x0A</manifest>@;
	} else {
		my $xhtmlFolderName = basename $xhtmlFolderPath;
		$joinedOpfText =~ s@/>.*?(\x0D\x0A\x0D\x0A|\x0D\x0A).*?</manifest>@/>\x0D\x0A<item media-type="application/xhtml+xml" id="p-sample" href="$xhtmlFolderName/p-sample.xhtml" />\x0D\x0A\x0D\x0A</manifest>@;
	}
	#spine末尾に「p-sample」追記
	$joinedOpfText =~ s@/>.*?(\x0D\x0A\x0D\x0A|\x0D\x0A).*?</spine>@/>\x0D\x0A<itemref linear="yes" idref="p-sample" />\x0D\x0A\x0D\x0A</spine>@;

	#修正後のOPFファイルの出力
	open(OUT,"> $opfFilePath");
		$joinedOpfText = encode('UTF-8', $joinedOpfText);
		print OUT $joinedOpfText;
	close (OUT);
}

sub unmatchedLinkFix {
	my @existFilePathList = @{$_[0]};
	my @deletedXhtmlFileList = @{$_[1]};
	my $navFilePath = $_[2];

	#######################id名、リンク先ファイル名ピックアップ処理#######################
	my @idList;
	#フォルダ内各XHTMLファイルを開く繰り返し処理
	foreach $eachXhtmlFilePath(@existFilePathList){
		open(IN,"$eachXhtmlFilePath");
			#改行コードの統一、各行をリストに収録
			my @myTxts = <IN>;
			my $myTxts = join("",@myTxts);
			$myTxts =~ s@\x0D\x0A@\x0D@g;
			$myTxts =~ s@\x0A@\x0D@g;
			@myTxts = split("\x0D",$myTxts);
			$myTxt = join("\x0D\x0A",@myTxts);
		close (IN);
		#id名をリストに収録
		my @matchList = ($myTxt =~ /id=\"(.*?)\"/gs);
		foreach $matchString(@matchList){
			push (@idList,$matchString);
		}
	}
	#######################論理目次ファイルのテキスト置換処理#######################
	open(IN,"$navFilePath");
		#改行コードの統一、各行をリストに収録
		my @myNavTxts = <IN>;
		my $myNavTxts = join("",@myNavTxts);
		$myNavTxts =~ s@\x0D\x0A@\x0D@g;
		$myNavTxts =~ s@\x0A@\x0D@g;
		@myNavTxts = split("\x0D",$myNavTxts);
		$myNavTxt = join("\x0D\x0A",@myNavTxts);
	close (IN);
	#消去済みのファイルへのリンクを削除
	foreach $deletedXhtmlFile (@deletedXhtmlFileList){
		$myNavTxt =~ s@<li><a.*?href=\"xhtml/$deletedXhtmlFile.*?\">.*?</a></li>\x0D\x0A@@;
	}
	#修正済みファイル出力処理
	open(OUT,"> $navFilePath");
		print OUT $myNavTxt;
	close (OUT);
	#######################各XHTMLファイルのテキスト置換処理#######################
	#リンク元ファイルを検索、リンクに突き当たったら処理
	foreach $eachXhtmlFilePath(@existFilePathList){
		open(IN,"$eachXhtmlFilePath");
			#改行コードの統一、各行をリストに収録
			my @myTxts = <IN>;
			my $myTxts = join("",@myTxts);
			$myTxts =~ s@\x0D\x0A@\x0D@g;
			$myTxts =~ s@\x0A@\x0D@g;
			@myTxts = split("\x0D",$myTxts);
			$myTxt = join("\x0D\x0A",@myTxts);
		close (IN);
	
		#アンカー指定されているリンクのアンカー部分をリストで取得
		my @anchorLinkList = ($myTxt =~ /href ?= ?\".*?\#(.*?)\"/g);
		#IDのリストにないアンカー指定されているリンクを削除
		foreach $anchorID(@anchorLinkList){
			unless (grep {$_ eq $anchorID} @idList){
				$myTxt =~ s@<a.*?href ?= ?\".*?\#$anchorID\".*?>\x0D?\x0A?(.*?)\x0D?\x0A?<\/a>@$1@;
			}
		}
		#消去済みのファイルへのリンクを削除
		foreach $deletedXhtmlFile (@deletedXhtmlFileList){
			$myTxt =~ s@<a.*?href=\"$deletedXhtmlFile.*?\">\x0D?\x0A?(.*?)\x0D?\x0A?</a>@$1@;
		}
		#修正済みファイル出力処理
		open(OUT,"> $eachXhtmlFilePath");
			print OUT $myTxt;
		close (OUT);
	}
}

sub getNavFileName {
	my $opfFilePath = $_[0];
	open(IN,"$opfFilePath");
		#改行コードの統一処理
		@eachLineOpfTxts = <IN>;
		$eachLineOpfTxt = join("",@eachLineOpfTxts);
		$eachLineOpfTxt =~ s@\x0D\x0A@\x0D@g;
		$eachLineOpfTxt =~ s@\x0A@\x0D@g;
		@eachLineOpfTxts = split("\x0D",$eachLineOpfTxt);
	close (IN);
	#navファイルへのパスを取得
	my @navFileNameList;
	foreach my $line(@eachLineOpfTxts) {
		if ($line =~ /properties ?= ?\"nav\"/){
			$line =~ s@^.*?href=\"(.*?)\".*?$@$1@;
			push(@navFileNameList,$line);
		}
	}
	$navFileName = $navFileNameList[0];
	$navFileName = basename $navFileName;
	return $navFileName;
}

sub insertPsampleXhtml {
	my $pSampleFilePath = $_[0];
	my $copySpotPath = $_[1];
	my $opfFilePath = $_[2];

	##############OPFを展開してタイトルを取得##############
	#OPFファイルを開く
	open(OPFIN,"$opfFilePath");
		#改行コードの統一処理
		@eachLineOpfTxts = <OPFIN>;
		$eachLineOpfTxt = join("",@eachLineOpfTxts);
		$eachLineOpfTxt =~ s@\x0D\x0A@\x0D@g;
		$eachLineOpfTxt =~ s@\x0A@\x0D@g;
		@eachLineOpfTxts = split("\x0D",$eachLineOpfTxt);
		$eachLineOpfTxt = join("\x0D\x0A",@eachLineOpfTxts);
	close (OPFIN);
	$eachLineOpfTxt = decode('UTF-8', $eachLineOpfTxt);
	my $titleName = $eachLineOpfTxt;
	$titleName =~ s@^.*?<dc:title[^>]*?>【試し読み版】(.*?)<\/dc:title>.*?$@$1@s;

	##############コピー元ファイルを展開##############
	open(SAMPLEIN,"$pSampleFilePath");
	#改行コードの統一処理
	@eachLineSampleTxts = <SAMPLEIN>;
		$eachLineSampleTxt = join("",@eachLineSampleTxts);
		$eachLineSampleTxt =~ s@\x0D\x0A@\x0D@g;
		$eachLineSampleTxt =~ s@\x0A@\x0D@g;
		@eachLineSampleTxts = split("\x0D",$eachLineSampleTxt);
		$eachLineSampleTxt = join("\x0D\x0A",@eachLineSampleTxts);
	close (SAMPLEIN);
	$eachLineSampleTxt = decode('UTF-8', $eachLineSampleTxt);
	#タイトル行を置換
	$eachLineSampleTxt =~ s@<title>.*?</title>@<title>$titleName</title>@;

	#修正済みファイル出力処理
	open(SAMPLEOUT,"> $copySpotPath");
		$eachLineSampleTxt = encode('UTF-8', $eachLineSampleTxt);
		print SAMPLEOUT $eachLineSampleTxt;
	close (SAMPLEOUT);
}

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

145

146

147

148

149

150

151

152

153

154

155

156

157

158

159

160

161

162

163

164

165

166

167

168

169

170

171

172

173

174

175

176

177

178

179

180

181

182

183

184

185

186

187

188

189

190

191

192

193

194

195

196

197

198

199

200

201

202

203

204

205

206

207

208

209

210

211

212

213

214

215

216

217

218

219

220

221

222

223

224

225

226

227

228

229

230

231

232

233

234

235

236

237

238

239

240

241

242

243

244

245

246

247

248

249

250

251

252

253

254

255

256

257

258

259

260

261

262

263

264

265

266

267

268

269

270

271

272

273

274

275

276

277

278

279

280

281

282

283

284

285

286

287

288

289

290

291

292

293

294

295

296

297

298

299

300

301

302

303

304

305

306

307

308

309

310

311

312

313

314

315

316

317

318

319

320

321

322

323

324

325

326

327

328

329

330

331

332

333

334

335

336

337

338

339

340

341

342

343

344

345

346

347

348

349

350

351

352

353

354

355

356

357

358

359

360

361

362

363

364

365

366

367

368

369

370

371

372

373

374

375

376

377

378

379

380

381

382

383

384

385

386

387

388

389

390

391

392

393

394

395

396

397

398

399

400

401

402

403

404

405

406

407

408

409

410

411

412

413

414

415

416

417

418

419

420

421

422

423

424

425

426

427

428

429

430

431

432

433

434

435

436

437

438

439

440

441

442

443

444

445

446

447

448

449

450

451

452

453

454

455

456

457

458

459

460

461

462

463

464

465

466

467

468

469

470

471

#! /usr/bin/perl

use utf8;

use Encode qw/encode decode/;

use File::Basename qw/basename dirname/;

use File::Path;

use File::Find;

#EPUBフォルダのパスを取得、インポート

my $epubFolderPath = $ARGV[0];

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

#「この続きは〜」記述ファイルのパスを取得、インポート

my $pSampleFilePath = $ARGV[1];

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

###################EPUBフォルダを作業用フォルダにコピー###################

my $epubFileName = basename $epubFolderPath;

my $epubWorkFolderPath = '/tmp/' . "sample_" . $epubFileName;

my $epubFolderCopyCommand = "cp -R " . '"' . $epubFolderPath . '"' . " " . '"' . $epubWorkFolderPath . '"';

system $epubFolderCopyCommand;

###################各ファイルへのパス/ファイル名取得###################

#EPUB出力先のパスを取得

my $epubExportPath = dirname $epubFolderPath;

#OPF、Xhtml、imageの各ファイルへのパスを取得

my @opfFilePath;

my @xhtmlFilePath;

my @imageFilePath;

find(\&getEachFile, $epubWorkFolderPath);

#OPFファイルへのパス取得

my $opfFilePath = $opfFilePath[0];

#論理目次ファイルのファイル名取得

my $navFileName = &getNavFileName($opfFilePath);

#論理目次ファイルの絶対パス取得

my @navFilePathList;

find(\&getNavFile, $epubWorkFolderPath);

my $navFilePath = $navFilePathList[0];

#OPFのSpine指定をもとにEPUB内表示順にXHTMLファイルへのパスの配列を取得

my @spineFileList = &getSpineFileList($opfFilePath);

###################不要なファイルの削除処理###################

#XHTMLファイルを表示順で展開し、試し読み指示テキストが出てくる箇所でXHTMLファイルを分割/それ以後のXHTMLファイルを削除

my @existAndDeletedFileList = &cutXhtmlFile(@spineFileList);

#消さなかったXHTMLファイルのフルパス/消したXHTMLファイルのファイル名の各リストを取得

my @existFilePathList = @{$existAndDeletedFileList[0]};

my @deletedXhtmlFileList = @{$existAndDeletedFileList[1]};

#消さなかったXHTMLファイルを順番に展開し、リンクされているイメージファイルへのフルパスをリストとして取得

my @eachArray = (\@existFilePathList,$epubWorkFolderPath);

my @linkedImageFilesPathList = &getLinkedImageFile(@eachArray);

#要らないイメージファイルを消去

my @eachArray = (\@imageFilePath,\@linkedImageFilesPathList);

#消した画像ファイルのファイル名リストを取得

my @deletedImageFileList = &deleteUnlinkedImageFile(@eachArray);

###################不要なOPF行の削除処理###################

#OPFのManifest、Spineの整理、Titleへの「試し読み」文言挿入

my $xhtmlFolderPath = dirname $existFilePathList[0];

my @deletedAllFileList = (\@deletedXhtmlFileList,\@deletedImageFileList,$opfFilePath,$xhtmlFolderPath);

&opfCleanUp(@deletedAllFileList);

###################切れたリンクの削除処理###################

my @eachArray = (\@existFilePathList,\@deletedXhtmlFileList,$navFilePath);

&unmatchedLinkFix(@eachArray);

###################試し読みはここまでファイルの自動挿入処理###################

my $copySpotPath = $xhtmlFolderPath . "/p-sample.xhtml";

my @eachPath = ($pSampleFilePath,$copySpotPath,$opfFilePath);

&insertPsampleXhtml(@eachPath);

###################epubファイル作成処理###################

#出力先パスを取得

my $outputEpubName = basename $epubWorkFolderPath;

my $syscommand = 'cd ' . '"' . $epubWorkFolderPath . '"' . ';zip -0 -X '. '"../' . $outputEpubName . '.epub"' . ' mimetype;zip -r ' . '"../' . $outputEpubName . '.epub' . '"' . ' * -x mimetype */.DS_Store */*/.DS_Store */*/*/.DS_Store';

system $syscommand;

my $epubMoveTargetPath = dirname $epubFolderPath;

my $epubPreGenaratePath = $epubWorkFolderPath . $outputEpubName . '.epub';

my $epubMoveCommand = 'mv -f ' . '"' . $epubWorkFolderPath . ".epub" . '"' . " " . '"' . $epubMoveTargetPath . '"';

system $epubMoveCommand;

###################作業ファイルの削除処理###################

rmtree($epubWorkFolderPath);

exit;

#サブルーチン

sub getEachFile {

my $file = $_;

my $path = $File::Find::name;

push(@opfFilePath,$path) if ($path =~ /^(.*?)\.opf$/);

push(@xhtmlFilePath,$path) if ($path =~ /^(.*?)\.xhtml$/i);

push(@imageFilePath,$path) if ($path =~ /^(.*?)\.(jpg|jpeg|png|gif)$/i);

}

sub getNavFile {

my $file = $_;

my $path = $File::Find::name;

push(@navFilePathList,$path) if ($path =~ /^.*?\/$navFileName$/);

}

sub getSpineFileList {

my $opfFilePath = $_[0];

open(IN,"$opfFilePath");

#改行コードの統一処理

@eachLineOpfTxts = <IN>;

$eachLineOpfTxt = join("",@eachLineOpfTxts);

$eachLineOpfTxt =~ s@\x0D\x0A@\x0D@g;

$eachLineOpfTxt =~ s@\x0A@\x0D@g;

@eachLineOpfTxts = split("\x0D",$eachLineOpfTxt);

close (IN);

#SPINEのidrefを取得

my @idrefList;

foreach my $line(@eachLineOpfTxts) {

if ($line =~ /^.*?idref=\"(.*?)\".*?$/){

$line =~ s@^.*?idref=\"(.*?)\".*?$@$1@;

push(@idrefList,$line);

}

#SPINEのidrefをキーに各XHTMLファイルへのパスを取得

my $itemPath = dirname $opfFilePath;

my @spineFileList;

foreach my $idref(@idrefList){

my @href = grep /id=\"$idref\"/,@eachLineOpfTxts;

my $hrefPath = $href[0];

$hrefPath =~ s@^.*?href=\"(.*?)\".*?$@$1@;

$hrefPath = $itemPath . "/" . $hrefPath;

push(@spineFileList,$hrefPath);

}

return @spineFileList;

}

sub cutXhtmlFile {

my @spineFileList = @_;

our $sampleFileOutputFlag = "yet";

our @existFilePathList;

our @deletedFileList;

foreach $eachFilePath(@spineFileList){

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

#サンプルファイルがすでに出力されていたらファイルを削除する処理

if ($sampleFileOutputFlag eq "dune"){

#消去ファイルのリストにpush

$deleteFileName = basename $eachFilePath;

push(@deletedFileList,$deleteFileName);

unlink $eachFilePath;

} else {

#存在ファイルのリストにpush

$existFileName = basename $eachFilePath;

push(@existFilePathList,$eachFilePath);

open(IN,"$eachFilePath");

#改行コードの統一処理

@mySPLITFILEtxts = <IN>;

$mySPLITFILEtxts = join("",@mySPLITFILEtxts);

$mySPLITFILEtxts =~ s@\x0D\x0A@\x0D@g;

$mySPLITFILEtxts =~ s@\x0A@\x0D@g;

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

@eachLine = split("\x0D",$mySPLITFILEtxts);

close (IN);

#「++Trial reading is so far++」もしくは「++試し読みここまで++」という文が含まれる行が出てきたらそこまでの行を出力

my @outputTxt = ();

foreach $line (@eachLine){

if ($line =~ /(\+\+Trial reading is so far\+\+|\+\+試し読みここまで\+\+)/){

open(OUT,"> $eachFilePath");

foreach (@outputTxt){

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

print OUT $_ . "\r\n";

}

close (OUT);

#html tidyで閉じタグ自動補正

my $fixXhtmlCommand = "tidy -xml -utf8 -m -q " . '"' . $eachFilePath . '"';

system $fixXhtmlCommand;

#tidyで修正後の改行コード関係修正

open(IN,"$eachFilePath");

#改行コードの統一処理

@myTxts = <IN>;

my $myTxts = join("",@myTxts);

$myTxts =~ s@\x0D\x0A@\x0D@g;

$myTxts =~ s@\x0A@\x0D@g;

@myTxts = split("\x0D",$myTxts);

$myTxt = join("\x0D\x0A",@myTxts);

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

close (IN);

#改行コード削除処理

my @blockObjectArray = qw/address center dir dl fieldset h1 h2 h3 h4 h5 h6 hr isindex menu noframes noscript ol p pre ul/;

my @inlineObjectArray = qw /a abbr acronym applet b basefont bdo big br button cite code dfn em font i iframe img input kbd label map object q s samp script select small span strike strong sub sup textarea tt u var/;

foreach $object(@blockObjectArray){

$myTxt =~ s@<$object([^<>]*?)>\x0D\x0A@<$object$1>@g;

$myTxt =~ s@\x0D\x0A</$object>@</$object>@g;

}

foreach $object(@inlineObjectArray){

$myTxt =~ s@\x0D\x0A<$object([^<>]*?)>\x0D\x0A@<$object$1>@g;

$myTxt =~ s@<$object([^<>]*?)>\x0D\x0A@<$object$1>@g;

$myTxt =~ s@\x0D\x0A<$object([^<>]*?)>@<$object$1>@g;

$myTxt =~ s@\x0D\x0A</$object>\x0D\x0A@</$object>@g;

$myTxt =~ s@\x0D\x0A</$object>@</$object>@g;

$myTxt =~ s@</$object>\x0D\x0A@</$object>@g;

}

$myTxt =~ s@\"\x0D\x0A@\" @g;

$myTxt =~ s@<body([^<>]*?)>@\x0D\x0A<body$1>\x0D\x0A@g;

#再出力

open(OUT,"> $eachFilePath");

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

print OUT $myTxt;

close (OUT);

$sampleFileOutputFlag = "dune";

last;

} else {

push(@outputTxt,$line);

}

my @existAndDeletedFileList = (\@existFilePathList,\@deletedFileList);

return @existAndDeletedFileList;

}

sub getLinkedImageFile {

my @existFilePathList = @{$_[0]};

my $epubFolderPath = $_[1];

my @linkedImageFilesList;

my @linkedImageFilesPathList;

foreach $eachExistFilePath(@existFilePathList){

open(IN,"$eachExistFilePath");

#改行コードの統一処理

@mySPLITFILEtxts = <IN>;

$mySPLITFILEtxts = join("",@mySPLITFILEtxts);

$mySPLITFILEtxts =~ s@\x0D\x0A@\x0D@g;

$mySPLITFILEtxts =~ s@\x0A@\x0D@g;

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

@eachLine = split("\x0D",$mySPLITFILEtxts);

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

close (IN);

my @imageFileNames = ($joinedTxt =~ /([^\/]+\.jpg|[^\/]+\.JPG|[^\/]+\.jpeg|[^\/]+\.JPEG|[^\/]+\.png|[^\/]+\.PNG|[^\/]+\.gif|[^\/]+\.GIF)/g);

foreach $imageFileName (@imageFileNames){

find(\&getImageFilePath, $epubFolderPath);

sub getImageFilePath {

my $file = $_;

my $path = $File::Find::name;

push(@linkedImageFilesPathList,$path) if ($path =~ /.*?\/$imageFileName$/);

}

#重複削除

my %hash;

@hash{ @linkedImageFilesPathList } = ();

my @linkedImageFilesPathList = keys %hash;

return @linkedImageFilesPathList;

}

sub deleteUnlinkedImageFile {

my @imageFilePath = @{$_[0]};

my @linkedImageFilesPathList = @{$_[1]};

#配列の差分を出す

my %cnt = ();

map { $cnt{$_}-- } @linkedImageFilesPathList;

my @UnlinkedImageFilePathList = grep { ++$cnt{$_} == 1 } @imageFilePath;

my @deletedImageFilesList;

#いらなくなった画像ファイルを消す

foreach $UnlinkedImageFilePath (@UnlinkedImageFilePathList){

my $UnlinkedImageFileName = basename $UnlinkedImageFilePath;

push(@deletedImageFilesList,$UnlinkedImageFileName);

unlink $UnlinkedImageFilePath;

}

#消したファイル名を返す

return @deletedImageFilesList;

}

sub opfCleanUp {

my @deletedXhtmlFileList = @{$_[0]};

my @deletedImageFileList = @{$_[1]};

my $opfFilePath = $_[2];

my $xhtmlFolderPath = $_[3];

#######OPFのSPINE要素内の不要となったXHTMLファイルの宣言を削除#######

#OPFファイルを開く

open(IN,"$opfFilePath");

#改行コードの統一処理

@eachLineOpfTxts = <IN>;

$eachLineOpfTxt = join("",@eachLineOpfTxts);

$eachLineOpfTxt =~ s@\x0D\x0A@\x0D@g;

$eachLineOpfTxt =~ s@\x0A@\x0D@g;

@eachLineOpfTxts = split("\x0D",$eachLineOpfTxt);

close (IN);

#不要となった各XHTMLファイルに対応するidrefの取得

our @deletedIdrefList;

foreach my $eachDeletedFile(@deletedXhtmlFileList){

my @idrefLine = grep /(<item .*?id ?= ?\"(.*?)\"\ .*?href ?= ?\".*?$eachDeletedFile\".*?\/>|<item .*?href ?= ?\".*?$eachDeletedFile\" .*?id ?= ?\"(.*?)\".*?\/>)/,@eachLineOpfTxts;

my $idrefName = $idrefLine[0];

$idrefName =~ s@^.*?id ?= ?\"(.*?)\".*?$@$1@;

push(@deletedIdrefList,$idrefName);

}

#OPFのテキストを連結

our $joinedOpfText = join("\x0D\x0A",@eachLineOpfTxts);

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

#manifest（XHTML）の削除

foreach my $eachDeletedFile(@deletedXhtmlFileList){

$joinedOpfText =~ s@<item .*?href ?= ?\".*?$eachDeletedFile\".*?\/>\x0D\x0A@@;

}

#manifest（IMAGE）の削除

foreach my $eachDeletedFile(@deletedImageFileList){

$joinedOpfText =~ s@<item .*?href ?= ?\".*?$eachDeletedFile\".*?\/>\x0D\x0A@@;

}

#spineの削除

foreach my $eachIdrefName(@deletedIdrefList){

$joinedOpfText =~ s@<itemref .*?idref ?= ?\"$eachIdrefName\".*?\/>\x0D\x0A@@;

}

#Titleに「試し読み版」表記を追加

$joinedOpfText =~ s@<dc:title([^>]*?)>(.*?)</dc:title>@<dc:title$1>【試し読み版】$2</dc:title>@;

#manifestのxhtml部分に「p-sample.xhtml」追記

my $opfFileDirName = dirname $opfFilePath;

if ($opfFileDirName eq $xhtmlFolderPath){

$joinedOpfText =~ s@/>.*?(\x0D\x0A\x0D\x0A|\x0D\x0A).*?</manifest>@/>\x0D\x0A<item media-type="application/xhtml+xml" id="p-sample" href="p-sample.xhtml" />\x0D\x0A\x0D\x0A</manifest>@;

} else {

my $xhtmlFolderName = basename $xhtmlFolderPath;

$joinedOpfText =~ s@/>.*?(\x0D\x0A\x0D\x0A|\x0D\x0A).*?</manifest>@/>\x0D\x0A<item media-type="application/xhtml+xml" id="p-sample" href="$xhtmlFolderName/p-sample.xhtml" />\x0D\x0A\x0D\x0A</manifest>@;

}

#spine末尾に「p-sample」追記

$joinedOpfText =~ s@/>.*?(\x0D\x0A\x0D\x0A|\x0D\x0A).*?</spine>@/>\x0D\x0A<itemref linear="yes" idref="p-sample" />\x0D\x0A\x0D\x0A</spine>@;

#修正後のOPFファイルの出力

open(OUT,"> $opfFilePath");

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

print OUT $joinedOpfText;

close (OUT);

}

sub unmatchedLinkFix {

my @existFilePathList = @{$_[0]};

my @deletedXhtmlFileList = @{$_[1]};

my $navFilePath = $_[2];

#######################id名、リンク先ファイル名ピックアップ処理#######################

my @idList;

#フォルダ内各XHTMLファイルを開く繰り返し処理

foreach $eachXhtmlFilePath(@existFilePathList){

open(IN,"$eachXhtmlFilePath");

#改行コードの統一、各行をリストに収録

my @myTxts = <IN>;

my $myTxts = join("",@myTxts);

$myTxts =~ s@\x0D\x0A@\x0D@g;

$myTxts =~ s@\x0A@\x0D@g;

@myTxts = split("\x0D",$myTxts);

$myTxt = join("\x0D\x0A",@myTxts);

close (IN);

#id名をリストに収録

my @matchList = ($myTxt =~ /id=\"(.*?)\"/gs);

foreach $matchString(@matchList){

push (@idList,$matchString);

}

#######################論理目次ファイルのテキスト置換処理#######################

open(IN,"$navFilePath");

#改行コードの統一、各行をリストに収録

my @myNavTxts = <IN>;

my $myNavTxts = join("",@myNavTxts);

$myNavTxts =~ s@\x0D\x0A@\x0D@g;

$myNavTxts =~ s@\x0A@\x0D@g;

@myNavTxts = split("\x0D",$myNavTxts);

$myNavTxt = join("\x0D\x0A",@myNavTxts);

close (IN);

#消去済みのファイルへのリンクを削除

foreach $deletedXhtmlFile (@deletedXhtmlFileList){

$myNavTxt =~ s@<li><a.*?href=\"xhtml/$deletedXhtmlFile.*?\">.*?</a></li>\x0D\x0A@@;

}

#修正済みファイル出力処理

open(OUT,"> $navFilePath");

print OUT $myNavTxt;

close (OUT);

#######################各XHTMLファイルのテキスト置換処理#######################

#リンク元ファイルを検索、リンクに突き当たったら処理

foreach $eachXhtmlFilePath(@existFilePathList){

open(IN,"$eachXhtmlFilePath");

#改行コードの統一、各行をリストに収録

my @myTxts = <IN>;

my $myTxts = join("",@myTxts);

$myTxts =~ s@\x0D\x0A@\x0D@g;

$myTxts =~ s@\x0A@\x0D@g;

@myTxts = split("\x0D",$myTxts);

$myTxt = join("\x0D\x0A",@myTxts);

close (IN);

#アンカー指定されているリンクのアンカー部分をリストで取得

my @anchorLinkList = ($myTxt =~ /href ?= ?\".*?\#(.*?)\"/g);

#IDのリストにないアンカー指定されているリンクを削除

foreach $anchorID(@anchorLinkList){

unless (grep {$_ eq $anchorID} @idList){

$myTxt =~ s@<a.*?href ?= ?\".*?\#$anchorID\".*?>\x0D?\x0A?(.*?)\x0D?\x0A?<\/a>@$1@;

}

#消去済みのファイルへのリンクを削除

foreach $deletedXhtmlFile (@deletedXhtmlFileList){

$myTxt =~ s@<a.*?href=\"$deletedXhtmlFile.*?\">\x0D?\x0A?(.*?)\x0D?\x0A?</a>@$1@;

}

#修正済みファイル出力処理

open(OUT,"> $eachXhtmlFilePath");

print OUT $myTxt;

close (OUT);

}

sub getNavFileName {

my $opfFilePath = $_[0];

open(IN,"$opfFilePath");

#改行コードの統一処理

@eachLineOpfTxts = <IN>;

$eachLineOpfTxt = join("",@eachLineOpfTxts);

$eachLineOpfTxt =~ s@\x0D\x0A@\x0D@g;

$eachLineOpfTxt =~ s@\x0A@\x0D@g;

@eachLineOpfTxts = split("\x0D",$eachLineOpfTxt);

close (IN);

#navファイルへのパスを取得

my @navFileNameList;

foreach my $line(@eachLineOpfTxts) {

if ($line =~ /properties ?= ?\"nav\"/){

$line =~ s@^.*?href=\"(.*?)\".*?$@$1@;

push(@navFileNameList,$line);

}

$navFileName = $navFileNameList[0];

$navFileName = basename $navFileName;

return $navFileName;

}

sub insertPsampleXhtml {

my $pSampleFilePath = $_[0];

my $copySpotPath = $_[1];

my $opfFilePath = $_[2];

##############OPFを展開してタイトルを取得##############

#OPFファイルを開く

open(OPFIN,"$opfFilePath");

#改行コードの統一処理

@eachLineOpfTxts = <OPFIN>;

$eachLineOpfTxt = join("",@eachLineOpfTxts);

$eachLineOpfTxt =~ s@\x0D\x0A@\x0D@g;

$eachLineOpfTxt =~ s@\x0A@\x0D@g;

@eachLineOpfTxts = split("\x0D",$eachLineOpfTxt);

$eachLineOpfTxt = join("\x0D\x0A",@eachLineOpfTxts);

close (OPFIN);

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

my $titleName = $eachLineOpfTxt;

$titleName =~ s@^.*?<dc:title[^>]*?>【試し読み版】(.*?)<\/dc:title>.*?$@$1@s;

##############コピー元ファイルを展開##############

open(SAMPLEIN,"$pSampleFilePath");

#改行コードの統一処理

@eachLineSampleTxts = <SAMPLEIN>;

$eachLineSampleTxt = join("",@eachLineSampleTxts);

$eachLineSampleTxt =~ s@\x0D\x0A@\x0D@g;

$eachLineSampleTxt =~ s@\x0A@\x0D@g;

@eachLineSampleTxts = split("\x0D",$eachLineSampleTxt);

$eachLineSampleTxt = join("\x0D\x0A",@eachLineSampleTxts);

close (SAMPLEIN);

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

#タイトル行を置換

$eachLineSampleTxt =~ s@<title>.*?</title>@<title>$titleName</title>@;

#修正済みファイル出力処理

open(SAMPLEOUT,"> $copySpotPath");

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

print SAMPLEOUT $eachLineSampleTxt;

close (SAMPLEOUT);

}

ダウンロードはこちら↓

makesampleepub.zip

1 file(s) 4.82 KB

Download

このスクリプトを利用したことによる損害等に関しまして、私としては一切責任を負いかねますので、あくまで自己責任にてご利用ください。
転載・改訂等はご随意に。なお、改訂して再配布される際には@JunTajimaまでご一報いただけると嬉しいです。といいますか誰かスゴい人、汎用EPUB用コードに直しちゃってください。

なお、先日KADOKAWAさんのTw-ePub発表直後にこんな記事が流れてきてましたので、記事のとおりBiB/iを使って、生成した試し読みファイルをTwitterに流してみました。

試し読みEPUBファイルBiB/i投稿てすと。 https://t.co/sfqBMdm0gh

— Jun Tajima (@JunTajima) 2014, 7月 15

意外と簡単でしたし、何よりTwitter経由でのコンテンツとの偶然の出逢いはずっと電子書籍の課題として挙げられ続けてきた「ディスカバラビリティ」の補完策になります。ライトコンテンツのプロモーション用としては結構有効と思いますので、活用を検討されてみてはいかがでしょうか。

（2014.7.16）

カテゴリー: 未分類 | 1 件のコメント »