2010年6月7日月曜日

BOM の存在を消去する(Perlの場合)

BOM存在のチェックと、その除去を行うプログラム(Perl)

一口にBOMと言っても、エンコードに応じて実体は様々あるらしい(utf8なら 0xEF 0xBB 0xBF)

1. BOMチェックスクリプト

#!/usr/bin/perl
@bom = (
  chr(0x00).chr(0x00).chr(0xFE).chr(0xFF),
  chr(0xFF).chr(0xFE).chr(0x00).chr(0x00),
  chr(0x00).chr(0x00).chr(0xFF).chr(0xFE),
  chr(0xFE).chr(0xFF).chr(0x00).chr(0x00),
  chr(0xFE).chr(0xFF),
  chr(0xFF).chr(0xFE),
  chr(0xEF).chr(0xBB).chr(0xBF)
);

if(-f $ARGV[0]){
  open(FILE, $ARGV[0]) or die;
  $dat = <FILE>;
  for(my $i = 0; $i <= $#bom; $i++){
    if(index($dat, $bom[$i]) == 0){
      print "$ARGV[0]\n";
      last;
    }
  }
  close(FILE);
}

2. BOM除去スクリプト(いちおうバックアップを取る仕様)

#!/usr/bin/perl
if(-f $ARGV[0]){
    my $f = $ARGV[0];
    my $new = $f . '.new';
    my $flg = 1;
    open(OLD, $f) or die;
    open(NEW, "> $new")         or die "can't open $new: $!";
    while (<OLD>) {
        if($flg) {
            print NEW substr($_, 3) or die "can't write $new: $!";
            $flg = 0;
        } else {
            print NEW $_            or die "can't write $new: $!";
        }
    }
    close(OLD)                  or die "can't close $old: $!";
    close(NEW)                  or die "can't close $new: $!";
    rename($f, "$f.orig")       or die "can't rename $old to $old.orig: $!";
    rename($new, $f)            or die "can't rename $new to $old: $!";
} else {
    die 'no argument';
}

0 件のコメント:

コメントを投稿