TSperl 発言

　極悪さん
　　　　　　　　　　　　　　　　　　なむnomotoです
　jperl が動きました。
　Perl フォルダにインストールしてあったものを、
　Perl フォルダを改名して 極悪Perl にして置いて(^^;)
　新しいPerl フォルダに再インストールしましたらば、
　作動しました。
　
　んで、今のところは具合良いです。
　ちょっと変更したいのですが、巧く行きません。教えて下さい。
　TXK2app.pl なんですが、例えば、
　
V:續天全_史傳2
P:159a
B:性空傳
　　雖遍空倫師恐事跡湮沒。撰寫本傳一卷。附録五卷
　　而備此山。鑒不圖罹回祿既成烏有矣。爰越州村
P:159b
　　上榊原史君。應衆之求。便命謄寫曾祖故拾遺嘗所
　　令寫之本。以遠寄諸吾山矣。史君之功可謂大焉。余
　　雖久患往追來而未遑繕寫焉。今也得逸于茅亭
　　世故稍疎。因持誦之餘。寫其全帙竟充素志矣。後
　　之攬者。亦襲余志。幸此記之不墜云爾。
　　　　時　元祿三年歳在庚午四月十六日。
　　　　　　　　　龍象院前住持　實雄（俗年六十六戒臘五十三）誌。
　
　とあるTXKデータを、txk2app.plで、app型に変更します。
        while(<FILE>){
            chomp;          # 改行あれば削除
   #        s/[　 \t]+//g;  # 空白あれば削除
  上記の空白は残すようにしました。
  そうすると、こうなります。
性空傳,續天全_史傳2,159a,16,0,　　雖遍空倫師恐事跡湮沒。撰寫本傳一卷。,4
性空傳,續天全_史傳2,159a,17,4,附録五卷　　而備此山。鑒不圖罹回祿既成烏有
矣。,4
性空傳,續天全_史傳2,159b,1,4,爰越州村　　上榊原史君。應衆之求。,11
性空傳,續天全_史傳2,159b,2,11,便命謄寫曾祖故拾遺嘗所　　令寫之本。以遠寄
諸吾山矣。史君之功可謂大焉。,1
性空傳,續天全_史傳2,159b,3,1,余　　雖久患往追來而未遑繕寫焉。,7
性空傳,續天全_史傳2,159b,4,7,今也得逸于茅亭　　世故稍疎。因持誦之餘。寫
其全帙竟充素志矣。,1
性空傳,續天全_史傳2,159b,5,1,後　　之攬者。亦襲余志。幸此記之不墜云爾。,
0
性空傳,續天全_史傳2,159b,6,0,　　　　時　元祿三年歳在庚午四月十六日。,0
性空傳,續天全_史傳2,159b,7,0,　　　　　　　　　龍象院前住持　實雄（俗年
六十六戒臘五十三）誌。,0

　不都合なことは、上記のように、行冒頭の２個の空白が、本文中に挿入されて
　しまいます。さらに、タグと本文の間ですが、
　史傳2,159b,1,4,爰越州村
　　　とあるのは、
　史傳2,159b,1,4：爰越州村
　　　　か、
　史傳2,159b,1,4‖爰越州村
　　　　か、または
　史傳2,159b,1,4, 爰越州村
　　　　　　　　 ↑
　　　　　　　　 半角スペース
　　　　のように漢文本文の直前に何かの区切り記号を入れたいです。
　　　　txk2app.pl のどこを変更しても、作動しなくなります。
　　　　・・・・厳重だわ(+_+)
　　　　どうすれば、良いのですか教えて下さいまし。
　　　　　　ちょっと長文ですが、　皆さんごめんなさい(-人-)
$$$----------txk2app.pl----------
#!/usr/local/bin/jperl

# usage: jperl txk2app.pl foo.txk
# .txk ファイルを .app ファイルに変換します。
# 必ず日本語対応の perl（jperl5） を使ってください。
# my $revision = '$Revision: 1.14 $';

use strict;
use Getopt::Std;
getopts('d:k:chmrvw');
use vars qw($opt_d $opt_k $opt_c $opt_h $opt_m $opt_r $opt_v $opt_w);
### -h:ヘルプ ###
if($opt_h){
    my $help = join("",<DATA>);
    $help =~ s/\$\S+/$&/eeg;
    print $help;
    exit 8;
}
### DOS 窓に色をつける ###
#use Term::ANSIColor qw(:constants);
sub BLUE{   return "\c[[1;34m"  }
sub RED{    return "\c[[1;31m"  }
sub RESET{  return "\c[[m"      }

### 出力フォーマット ###
my $format = "%s,%s,%s,%d,%s,%d\n";
if($opt_c){
    my($in,$out) = (BLUE,RESET);
    $format = "%s $in%s$out %-15s$in%2d$out %s$in%d$out\n";
}
### -m:文の終わりを検索するための正規表現 ###
my($patstr,$patend) = (".*","。|・");
$patstr = ".*?" if $opt_m;

### 漢字対応の length ###
sub namulength($){
    local $_ = shift;
    my $len = 0;
    ++$len  while chop;
    return $len;
}
### -r:なんかよくわんないけど、文字を削除 ###
my $namuchardel = sub($){ return shift };
if($opt_r){
    $namuchardel = sub($){
        local $_ = shift;
        s/[!-.:->{-~]+//g;
        s/[　-、，-．：-☆◎-ｚ]+//g;
        return $_;
    }
}
### -k:文字列を強調 ###
my $emstr = sub($){ return shift };
if(defined $opt_k){
    $emstr = sub($){
        local $_ = shift;
        my($in,$out) = ("【","】");
        ($in,$out) = (RED,RESET)    if $opt_c;
        s/(?!\Q$in\E)(?:$opt_k)(?!\Q$out\E)/$in$&$out/go;
        return $_;
    }
}
### -v:冗長な表示をする ###
my $verbose = sub{};
$verbose = sub{ print @_ } if $opt_v;

### 最終行に $patend がないときにエラーを表示 ###
sub warnstrend($){
    my $str = shift;
    print STDERR "...最後の行 \"$str\" に ($patend) が必要です。\n"
        if length $str;
}
### -w:ワイルドカードを展開する、ファイルに出力する ###
my $wopen = sub{};
my $wclose = sub{};
if($opt_w){
    $wopen = sub($){
        my $infile = shift;
        my $outfile = $infile;
        $outfile =~ s/(\.[^.]*?)?$/.app/i;
        if($infile ne $outfile){
            print STDERR $infile,"\t-> ",$outfile,"\n";
            open(STDOUT,">$outfile") or die "$!,$outfile\n";
        }else{
            die "Invalid filename,$infile\n";
        }
    };
    $wclose = sub{ close STDOUT };

    eval q{
        use File::DosGlob 'glob';
        @ARGV = map /[*?]/ ? File::DosGlob::glob($_) : $_, @ARGV;
    };
}
### ここから主処理 ###
push(@ARGV,"-") if $#ARGV < 0;
my $infile;
foreach $infile (@ARGV){
    &${wopen}($infile);
    open(FILE,"$infile") or die "$!,$infile\n";
    my($book,$line,$volume,$page,$pbegin,$lbegin) = (("?") x 6);
    my(@buff);
    while(<FILE>){
        chomp;          # 改行あれば削除
#        s/[　 \t]+//g;  # 空白あれば削除

        ### コメント ###
        if(m/^\'/){  $line = 0;  next;   }
        ### タグを処理 ###
        if(m/^([A-Z]):(.+)$/){
            my($tag,$adj) = ($1,$2);
            &${verbose}("* $tag:$adj\n");
            if($tag eq "V"){    $volume = $adj; $line = 0;  next;   }
            if($tag eq "B"){    $book = $adj;               next;   }
            if($tag eq "P"){    $page = $adj;   $line = 0;  next;   }
            if($tag eq "L"){    $line = $adj-1;             next;   }
            &${verbose}("\n*** Unkown tag, \"$tag\" at $.\n");
            next;
        }
        ### 本文に突入 ###
        ++$line;
        ### 空行 ###
        next if m/^$/;
        ### $buff が空ということは、新しい文が始まるということ ###
        ($pbegin,$lbegin) = ($page,$line) if $#buff < 1;
        ### 半角空白
#        $spec = " ";
        ### 文の終わりを検出したときの処理 ###
        while(s/^($patstr)($patend)//o){
            my $buff = join("",@buff);
            s/\w+/★/g;
            $_ = &{$namuchardel}($_);
            my $cprev += namulength($buff);
            $buff .= $1.$2;
            my $cnext = namulength($_);

            my $pageline = "$pbegin,$lbegin";
            if(0 < $#buff){
                $pageline .= "〜";
                $pageline .= "$page," if $pbegin ne $page;
                $pageline .= $line;
            }

            $buff = &${emstr}($buff);   # -k:強調表示
            printf(
                $format,        # （出力フォーマット）
                $opt_d.$book,   # フォルダと書名
                $volume,        # 巻名
                $pageline,      # ページと行
                $cprev,         # 前行から受けた文字数
#                $spec           # 本文前の半角空白
                $buff,          # 本文
                $cnext          # 次行に送る文字数
            );
            undef @buff;    # 文が終わったのでバッファはクリア
            ($pbegin,$lbegin) = ($page,$line);
        }
        push(@buff,$_); # 次の文の頭
    }
    &${wclose};
    warnstrend(join("",@buff));
}

__END__
Usage : jperl $0 [-d DIR] [-k KEY] [-chrvw] [FILES...]

.txk ファイルを .app ファイルに変換します。

--