DocTitleのソース

• DocTitle

doctitle.pl

#!/usr/local/bin/perl

# doctitle.pl - WebDocの原稿ファイル名にタイトルを加える
# Copyright (C) Takashi Utsunomiya. All Rights Reserved.
# http://uttsu.com/

# Usage: doc_title.pl targetdir

# Description:
#   - WebDocの原稿ファイル yyyymmdd_n.txt を yyyymmdd_n[タイトル].txt というふうにリネームする。
#   - サブディレクトリ以下も対象

# 2003.04.04    ver 1.00
#   - 作成開始
#   - 完成

use strict;
my $target = './';

main();
exit;

sub main {
    do_dir($target);
}

sub do_dir {
    my $target = shift;
    $target .= '/' if ($target !~ /[\\\/]$/);

    opendir(DIR, $target) or die $!;
    @_ = readdir(DIR);
    closedir(DIR);

    foreach (@_) {
        next if (/^\./);
        do_dir("$target$_") if (-d "$target$_");
        if (/^(\d{8}_\d+)(\[.*\])?\.txt$/) {
            my $file = $1;
            open(IN, "$target$_") or die $!;
            my $title = <IN>;
            $title = <IN> if ($title =~ /^ /);
            chomp($title);
            close(IN);
            $title =~ s/\//／/g;
            rename("$target$_", "$target$file\[$title].txt");
#           print "$target$file\[$title].txt\n";
        }
    }
}