#! /usr/pkg/bin/perl
#
# catdump - Żҥ֥å/EPWING /ƥѴ
#
#	Written by Junn Ohta (ohta@src.ricoh.co.jp). Public Domain.
#	Modified by yamagata@nwgpc.kek.jp on 2000/04/13
#	Re-Written with Perl by Motoyuki Kasahara (m-kasahr@sra.co.jp)
#

use FileHandle;

$progname = 'catdump';
$version = '1.4.4';
$author = 'Junn Ohta (ohta@src.ricoh.co.jp)';
$author2 = 'Motoyuki Kasahara (m-kasahr@sra.co.jp)';

#
# ʸ
#
$EUC	= 0;	# EUC-JP
$SJIS	= 1;	# եJIS

#
# 
#
$DUMP   = 0;	#   ƥ
$UNDUMP = 1;	# ƥ  

#
# Ҽ
#
$EB		= 0;	# Żҥ֥å
$EPWING		= 1;	# EPWING1 = 1
$EPWING2	= 2;	# EPWING2
$EPWING3	= 3;	# EPWING3
$EPWING4	= 4;	# EPWING4
$EPWING5	= 5;	# EPWING5
$EPWING6	= 6;	# EPWING6

#
# ҥ֥å(= ե륵)
#
$BLKSIZ  = 2048;

#
# Ͽҿ
# (EBǺ50EPWINGǺ12)
#
$MAXENT_EB      = 50;
$MAXENT_EPW     = 12;

#
# եι¤
#
$C_LEN          = 16;   # C_ ΰιץ
$C_BOOKSLEN	= 2;	# Ͽҿ
$C_CDTYPELEN	= 2;	# Ҽ
$C_SELECTLEN	= 2;	# ̵ֹ̤ͭ
$C_RSVLEN	= 10;	# ĥ
$B_LEN_EB       = 40;   # B_ ΰΥ (Żҥ֥å)
$B_LEN_EPW      = 164;  # B_ ΰΥ (EPWING)
			# (ʲϿҿ֤)
$B_BKTYPELEN	= 2;	#   Ҿ
$B_TTLLEN_EB	= 30;	#   ̾(Żҥ֥å)
$B_TTLLEN_EPW	= 80;	#   ̾(EPWING)
$B_DIRLEN	= 8;	#   ҥǥ쥯ȥ꡼̾
$B_DPOSLEN_EPW	= 4;	#   ǥ쥯ȥ꡼(EPWING)
$B_INFBLEN_EPW	= 2;	#   Ͽ(EPWING)
$B_APPLEN_EPW	= 4;	#   (EPWING)
$B_ZGAILEN_EPW	= 32;	#   ѳե̾(EPWING)
$B_HGAILEN_EPW	= 32;	#   Ⱦѳե̾(EPWING)
$B2_LEN		= 164;	# B2_ ΰΥ
                        # (EPWING2ʹߡʲҿ֤)
$B2_RSV1LEN	= 4;	#   
$B2_BKFILELEN	= 8;	#   ʸե̾
$B2_PAD1LEN	= 16;	#   
$B2_STFILELEN	= 8;	#   ȥ꡼ե̾
$B2_PAD2LEN	= 16;	#   
$B2_RSV2LEN	= 4;	#   
$B2_PAD3LEN	= 108;	#   

#
# إå
#
sub hdr_t (;$) {
    my ($arg) = @_;
    my ($new, $offset);

    if (@_ == 0) {
	$new = {'books'    => "\0" x $C_BOOKSLEN,
		'cdtype'   => "\0" x $C_CDTYPELEN,
		'select'   => "\0" x $C_SELECTLEN,
		'reserved' => "\0" x $C_RSVLEN};
    } else {
	$new = {};
	$offset = 0;
	$new->{'books'}    = substr($arg, $offset, $C_BOOKSLEN);
	$offset += $C_BOOKSLEN;
	$new->{'cdtype'}   = substr($arg, $offset, $C_CDTYPELEN);
	$offset += $C_CDTYPELEN;
	$new->{'select'}   = substr($arg, $offset, $C_SELECTLEN);
	$offset += $C_SELECTLEN;
	$new->{'reserved'} = substr($arg, $offset, $C_RSVLEN);
	$offset += $C_RSVLEN;
    }
    return $new;
}

#
# (Żҥ֥å)
#
sub eb_t (;$) {
    my ($arg) = @_;
    my ($new, $offset);

    if (@_ == 0) {
	$new = {'booktype'  => "\0" x $B_BKTYPELEN,
		'title'     => "\0" x $B_TTLLEN_EB,
		'directory' => "\0" x $B_DIRLEN};
    } else {
	$new = {};
	$offset = 0;
	$new->{'booktype'}  = substr($arg, $offset, $B_BKTYPELEN);
	$offset += $B_BKTYPELEN;
	$new->{'title'}     = substr($arg, $offset, $B_TTLLEN_EB);
	$offset += $B_TTLLEN_EB;
	$new->{'directory'} = substr($arg, $offset, $B_DIRLEN);
	$offset += $B_DIRLEN;
    }
    return $new;
}

#
# (EPWING)
#
sub epw_t (;$) {
    my ($arg) = @_;
    my ($new, $offset);

    if (@_ == 0) {
	$new = {'booktype'   => "\0" x $B_BKTYPELEN,
		'title'      => "\0" x $B_TTLLEN_EPW,
		'directory'  => "\0" x $B_DIRLEN,
		'dirpos'     => "\0" x $B_DPOSLEN_EPW,
		'infoblock'  => "\0" x $B_INFBLEN_EPW,
		'appdef'     => "\0" x $B_APPLEN_EPW,
		'zgaijifile' => "\0" x $B_ZGAILEN_EPW,
		'hgaijifile' => "\0" x $B_HGAILEN_EPW};
    } else {
	$new = {};
	$offset = 0;
	$new->{'booktype'}   = substr($arg, $offset, $B_BKTYPELEN);
	$offset += $B_BKTYPELEN;
	$new->{'title'}      = substr($arg, $offset, $B_TTLLEN_EPW);
	$offset += $B_TTLLEN_EPW;
	$new->{'directory'}  = substr($arg, $offset, $B_DIRLEN);
	$offset += $B_DIRLEN;
	$new->{'dirpos'}     = substr($arg, $offset, $B_DPOSLEN_EPW);
	$offset += $B_DPOSLEN_EPW;
	$new->{'infoblock'}  = substr($arg, $offset, $B_INFBLEN_EPW);
	$offset += $B_INFBLEN_EPW;
	$new->{'appdef'}     = substr($arg, $offset, $B_APPLEN_EPW);
	$offset += $B_APPLEN_EPW;
	$new->{'zgaijifile'} = substr($arg, $offset, $B_ZGAILEN_EPW);
	$offset += $B_ZGAILEN_EPW;
	$new->{'hgaijifile'} = substr($arg, $offset, $B_HGAILEN_EPW);
	$offset += $B_HGAILEN_EPW;
    }
    return $new;
}

#
# (EPWING2ʹ)
#
sub epw2_t (;$) {
    my ($arg) = @_;
    my ($new, $offset);

    if (@_ == 0) {
	$new = {'reserved1'  => "\0" x $B2_RSV1LEN,
		'bookfile'   => "HONMON\0\0",
		'pad1'       => "\0" x $B2_PAD1LEN,
		'streamfile' => "\0" x $B2_STFILELEN,
		'pad2'       => "\0" x $B2_PAD2LEN,
		'reserved2'  => "\0" x $B2_RSV2LEN,
		'pad3'       => "\0" x $B2_PAD3LEN};
    } else {
	$new = {};
	$offset = 0;
	$new->{'reserved1'}  = substr($arg, $offset, $B2_RSV1LEN);
	$offset += $B2_RSV1LEN;
	$new->{'bookfile'}   = substr($arg, $offset, $B2_BKFILELEN);
	$offset += $B2_BKFILELEN;
	$new->{'pad1'}       = substr($arg, $offset, $B2_PAD1LEN);
	$offset += $B2_PAD1LEN;
	$new->{'streamfile'} = substr($arg, $offset, $B2_STFILELEN);
	$offset += $B2_STFILELEN;
	$new->{'pad2'}       = substr($arg, $offset, $B2_PAD2LEN);
	$offset += $B2_PAD2LEN;
	$new->{'reserved2'}  = substr($arg, $offset, $B2_RSV2LEN);
	$offset += $B2_RSV2LEN;
	$new->{'pad3'}       = substr($arg, $offset, $B2_PAD3LEN);
	$offset += $B2_PAD3LEN;
    }
    return $new;
}

#
# ƥȥեΥ
#
$EB_ID			= 'EB';
$EPW_ID			= 'EPWING';
$CAT_ENTRY		= '[Catalog]';
$CTAG_FILENAME		= 'FileName';
$CTAG_BOOKS		= 'Books';
$CTAG_CDTYPE		= 'Type';
$CTAG_SELECT		= 'BookSelect';
$CTAG_RESERVED		= 'Reserved';
$BOOK_ENTRY		= '[Book]';
$BTAG_BOOKTYPE		= 'BookType';
$BTAG_TITLE		= 'Title';
$BTAG_DIRECTORY		= 'Directory';
$BTAG_DIRPOS		= 'DirPos';
$BTAG_INFOBLOCK		= 'InfoBlock';
$BTAG_APPDEF		= 'AppDef';
$BTAG_ZGAIJIFILE	= 'ZenGaiji';
$BTAG_HGAIJIFILE	= 'HanGaiji';
$B2TAG_RSV1		= 'Reserved1';
$B2TAG_BKFILE		= 'BookFile';
$B2TAG_PAD1		= 'Padding1';
$B2TAG_STFILE		= 'StreamFile';
$B2TAG_PAD2		= 'Padding2';
$B2TAG_RSV2		= 'Reserved2';
$B2TAG_PAD3		= 'Padding3';

#
# Ѥߥޥ
#
$M_FILENAME		= 0x00000001;
$M_BOOKS		= 0x00000002;
$M_CDTYPE		= 0x00000004;	# ɬ
$M_SELECT		= 0x00000008;
$M_RESERVED		= 0x00000010;
$M_BOOKTYPE		= 0x00000020;	# ɬ
$M_TITLE		= 0x00000040;	# ɬ
$M_DIRECTORY		= 0x00000080;	# ɬ
$M_DIRPOS		= 0x00000100;
$M_INFOBLOCK		= 0x00000200;
$M_APPDEF		= 0x00000400;
$M_ZGAIJIFILE		= 0x00000800;
$M_HGAIJIFILE		= 0x00001000;
$M_RESERVED1		= 0x00002000;
$M_BOOKFILE		= 0x00004000;
$M_PADDING1		= 0x00008000;
$M_STREAMFILE		= 0x00010000;
$M_PADDING2		= 0x00020000;
$M_RESERVED2		= 0x00040000;
$M_PADDING3		= 0x00080000;

#
# getstr()νˡ
#
$F_NUL			= 0;	# ;0x00
$F_SPACE		= 1;	# ;򥹥ڡ

$proctype = $DUMP;
$type = 0;
$line = 0;
$catalog = '';
$txtfile = '';
$buf = '';

$EBGmode = 0;
$encoding = $EUC  if ("" eq "\xe0\xa1");
$encoding = $SJIS if ("" eq "\xe0\xa1");

sub main {
    my(@av) = 0;
    my($ac) = int(@ARGV);
    my($ret);

    while ($ac > 0 && $ARGV[$av] =~ /^-/) {
	if ($ARGV[$av] eq '-g' || $ARGV[$av] eq '-G') {
	    $EBGmode = 1;
	} elsif ($ARGV[$av] eq '-d' || $ARGV[$av] eq '-D') {
	    $proctype = $DUMP;
	} elsif ($ARGV[$av] eq '-u' || $ARGV[$av] eq '-U') {
	    $proctype = $UNDUMP;
	    $ac--, $av++;
	    if ($ac <= 0) {
		usage();
	    }
	    $txtfile = $ARGV[$av];
	} elsif ($ARGV[$av] eq '-e' || $ARGV[$av] eq '-E') {
	    $ac--, $av++;
	    if ($ac <= 0) {
		usage();
	    }
	    if ($ARGV[$av] eq 'EUC' || $ARGV[$av] eq 'euc') {
		$encoding = $EUC;
	    } elsif ($ARGV[$av] eq 'SJIS' || $ARGV[$av] eq 'sjis') {
		$encoding = $SJIS;
	    } else {
		usage();
	    }
	} else {
	    usage();
	}
	$ac--, $av++;
    }
    if ($ac != 1) {
	usage();
    }
    $catalog = $ARGV[$av];
    if ($proctype == $DUMP) {
	$ret = &dump($catalog);
    } else {
	$ret = &undump($txtfile, $catalog);
	break;
    }
    if (!defined($ret)) {
	exit(1);
    }
    exit(0);
}

sub usage {
    printf(STDERR "Żҥ֥å/EPWING /ƥѴ %s/Perl Ver.%s\n",
	   $progname, $version);
    printf(STDERR "Written by %s.\n", $author);
    printf(STDERR "Rewritten with Perl by %s.\n\n", $author2);
    printf(STDERR "ˡ: %s", $progname);
    printf(STDERR " [ץ...] <ե>\n\n");
    printf(STDERR "ץ:\n");
    printf(STDERR "    -g    EBG ѥ⡼ɤˤ\n");
    printf(STDERR "    -d    եɸϤ˥פ\n");
    printf(STDERR "    -u <ƥȥե>\n");
    printf(STDERR "          ƥȥե򥫥եѴ\n");
    printf(STDERR "    -e <sjis ޤ euc>\n");
    printf(STDERR "          ʸɤꤹ\n");
    exit(1);
}

sub dump ($) {
    my($catalog) = @_;
    my($fp, $i, $num);
    my($t);
    my($hdr);
    my($eb);
    my($epw);
    my($epw2);

    if (! -f $catalog) {
	printf(STDERR "%s ξ󤬼Ǥޤ\n", $catalog);
	return undef;
    }
    $size = -s $catalog;
    if ($size > $BLKSIZ * 2) {
	printf(STDERR "۾Ǥ\n");
	return undef;
    }
    $fp = FileHandle->new($catalog, 'r');
    if (!defined($fp)) {
	printf(STDERR "%s ץǤޤ\n", $catalog);
	return undef;
    }
    binmode($fp);
    if ($fp->read($buf, $size) != $size) {
	printf(STDERR "եɤ߹ߤ˼Ԥޤ\n");
	$fp->close();
	return undef;
    }
    $fp->close();

    $hdr = hdr_t($buf);
    $num = unpack('n', $hdr->{'books'});
    $type = unpack('xC', $hdr->{'cdtype'});
    printf("; Żҥ֥å/EPWING ");
    printf(" (generated by %s/Perl v%s)\n\n", $progname, $version);
    printf("%s\n", $CAT_ENTRY);
    printf("%-11s= %s\n", $CTAG_FILENAME, $catalog);
    if ($type == $EB) {
	printf("%-11s= %s\n", $CTAG_CDTYPE, $EB_ID);
    } else {
	printf("%-11s= %s%d\n", $CTAG_CDTYPE, $EPW_ID, $type);
    }
    printf("%-11s= %d\n", $CTAG_BOOKS, $num);
    $t = unpack('n', $hdr->{'select'});
    if ((($t >> 8) & 0xff) == 0x01) {
	printf("%-11s= %d\n", $CTAG_SELECT,
	       (($t >> 4) & 0x0f) * 10 + ($t & 0x0f));
    }
    if ($type >= $EPWING4 || nonzero($hdr->{'reserved'}, $C_RSVLEN)) {
	printf("%-11s= ", $CTAG_RESERVED);
	outhex($hdr->{'reserved'}, $C_RSVLEN);
	if ($type >= $EPWING4) {
	    $t = unpack('xxC', $hdr->{'reserved'});
	    printf(" (HD:%s, NETWORK:%s)",
		   ($t & 0x10)? "": "ػ", ($t & 0x01)? "": "ػ");
	}
	print("\n");
    }
    print("\n");
    if ($type == $EB) {
	for ($i = 0; $i < $num; $i++) {
	    $eb = eb_t(substr($buf, $C_LEN + $B_LEN_EB * $i));
	    printf("%s\n", $BOOK_ENTRY);
	    printf("%-11s= ", $BTAG_BOOKTYPE);
	    outhex($eb->{'booktype'}, $B_BKTYPELEN);
	    printf("\n");
	    printf("%-11s= \"", $BTAG_TITLE);

	    if (!$EBGmode) {
		outjstr($eb->{'title'}, $B_TTLLEN_EB);
	    } else {
		outstr($eb->{'title'}, $B_TTLLEN_EB);
	    }

	    printf("\"\n");
	    printf("%-11s= \"", $BTAG_DIRECTORY);
	    outstr($eb->{'directory'}, $B_DIRLEN);
	    printf("\"\n");
	    printf("\n");
	}
    } else {
	for ($i = 0; $i < $num; $i++) {
	    $epw = epw_t(substr($buf, $C_LEN + $B_LEN_EPW * $i));
	    $epw2 = epw2_t(substr($buf, $C_LEN + $B_LEN_EPW * $num
				  + $B2_LEN * $i));
	    printf("%s\n", $BOOK_ENTRY);
	    printf("%-11s= ", $BTAG_BOOKTYPE);
	    outhex($epw->{'booktype'}, $B_BKTYPELEN);
	    $t = unpack('n', $epw->{'booktype'});
	    printf(" (%02X:%s, %02X:EPWING%d)\n",
		   ($t >> 8) & 0xff, bookkind(($t >> 8) & 0xff),
		   $t & 0xff, $t & 0xff);
	    printf("%-11s= \"", $BTAG_TITLE);
	    if (!$EBGmode) {
		outjstr($epw->{'title'}, $B_TTLLEN_EPW);
	    } else {
		outstr($epw->{'title'}, $B_TTLLEN_EPW);
	    }
	    printf("\"\n");
	    printf("%-11s= \"", $BTAG_DIRECTORY);
	    outstr($epw->{'directory'}, $B_DIRLEN);
	    printf("\"\n");
	    if (nonzero($epw->{'dirpos'}, $B_DPOSLEN_EPW)) {
		printf("%-11s= ", $BTAG_DIRPOS);
		outhex($epw->{'dirpos'}, $B_DPOSLEN_EPW);
		printf("\n");
	    }
	    if (nonzero($epw->{'infoblock'}, $B_INFBLEN_EPW)) {
		printf("%-11s= ", $BTAG_INFOBLOCK);
		outhex($epw->{'infoblock'}, $B_INFBLEN_EPW);
		printf("\n");
	    }
	    if (nonzero($epw->{'appdef'}, $B_APPLEN_EPW)) {
		printf("%-11s= ", $BTAG_APPDEF);
		outhex($epw->{'appdef'}, $B_APPLEN_EPW);
		printf("\n");
	    }
	    if (nonzero($epw->{'zgaijifile'}, $B_ZGAILEN_EPW)) {
		printf("%-11s= \"", $BTAG_ZGAIJIFILE);
		outstr($epw->{'zgaijifile'}, $B_ZGAILEN_EPW);
		printf("\"\n");
	    }
	    if (nonzero($epw->{'hgaijifile'}, $B_HGAILEN_EPW)) {
		printf("%-11s= \"", $BTAG_HGAIJIFILE);
		outstr($epw->{'hgaijifile'}, $B_HGAILEN_EPW);
		printf("\"\n");
	    }
	    if ($type >= EPWING2) {
		if (nonzero($epw2->{'bookfile'}, $B2_BKFILELEN)) {
		    printf("%-11s= \"", $B2TAG_BKFILE);
		    outstr($epw2->{'bookfile'}, $B2_BKFILELEN);
		    printf("\"\n");
		}
		if (nonzero($epw2->{'streamfile'}, $B2_STFILELEN)) {
		    printf("%-11s= \"", $B2TAG_STFILE);
		    outstr($epw2->{'streamfile'}, $B2_STFILELEN);
		    printf("\"\n");
		}
		if (nonzero($epw2->{'reserved1'}, $B2_RSV1LEN)) {
		    printf("%-11s= ", $B2TAG_RSV1);
		    outhex($epw2->{'reserved1'}, $B2_RSV1LEN);
		    printf("\n");
		}
		if (nonzero($epw2->{'reserved2'}, $B2_RSV2LEN)) {
		    printf("%-11s= ", $B2TAG_RSV2);
		    outhex($epw2->{'reserved2'}, $B2_RSV2LEN);
		    printf("\n");
		}
		if (nonzero($epw2->{'pad1'}, $B2_PAD1LEN)) {
		    printf("%-11s= ", $B2TAG_PAD1);
		    outhex($epw2->{'pad1'}, $B2_PAD1LEN);
		    printf("\n");
		}
		if (nonzero($epw2->{'pad2'}, $B2_PAD2LEN)) {
		    printf("%-11s= ", $B2TAG_PAD2);
		    outhex($epw2->{'pad2'}, $B2_PAD2LEN);
		    printf("\n");
		}
		if (nonzero($epw2->{'pad3'}, $B2_PAD3LEN)) {
		    printf("%-11s= ", $B2TAG_PAD3);
		    outhex($epw2->{'pad3'}, $B2_PAD3LEN);
		    printf("\n");
		}
	    }
	    printf("\n");
	}
    }
    return OK;
}

sub bookkind ($) {
    my($t) = @_;

    if ($t == 0x00) {
	return "켭ŵ";
    } elsif ($t == 0x10) {
	return "¼ŵ";
    } elsif ($t == 0x20) {
	return "¼ŵ";
    } elsif ($t == 0x30) {
	return "±Ѽŵ";
    } elsif ($t == 0x40) {
	return "Ѹ켭ŵ";
    } elsif ($t == 0x50) {
	return "ɴʻŵ";
    } elsif ($t == 0x60) {
	return "̽ʪ";
    } elsif ($t == 0x70) {
	return "켭ŵ";
    } elsif ($t == 0xf0) {
	return "ȥ꡼";
    } else {
	return "";
    }
}

sub nonzero ($$) {
    my($p, $len) = @_;

    return ($p ne "\0" x $len);
}     

sub outhex ($$) {
    my($p, $len) = @_;

    while ($len--) {
        printf("%02X", ord($p));
	$p = substr($p, 1);
    }
}     

sub outstr ($$) {
    my($p, $len) = @_;

    $p =~ s/[ \x00]+$//;

    while ($p ne '') {
	if (ord($p) >= 0x20 && ord($p) <= 0x7f) {
            printf("%c", ord($p));
	} elsif (ord($p) == ord("\"") || ord($p) == ord("\\")) {
            printf("\\%c", ord($p));
        } elsif (ord($p) == 0x00) {
            printf("\\0");
        } else {
            printf("\\x%02X", ord($p));
	}
	$p = substr($p, 1);
    }
}

sub outjstr ($$) {
    my($p, $len) = @_;
    my($c1, $c2);

    $p =~ s/(\x00\x00|\x21\x21)+$//;

    if ($encoding == $EUC) {
	$p =~ tr/\x00-\x7f/\x80-\xff/;
	print $p;
    }
    if ($encoding == $SJIS) {
	while ($p ne '') {
	    $c1 = ord($p);
	    $p = substr($p, 1);
	    $c2 = ord($p);
	    $p = substr($p, 1);
	    if ($c1 & 0x01) {
		$c2 += 0x1f;
		if ($c2 > 0x7e) {
		    $c2++;
		}
	    } else {
		$c2 += 0x7e;
	    }
	    $c1 = ($c1 + 0xe1) >> 1;
	    if ($c1 > 0x9f) {
		$c1 += 0x40;
	    }
	    printf('%c%c', $c1, $c2);
	}
    }
}

sub undump ($$) {
    my($txtfile, $catalog) = @_;

    my($fp, $i, $st, $num, $len, $hex, $err);
    my($mask);
    my($name, $value);
    my(@dirs) = ();
    my($t);
    my($hdr) = hdr_t;
    my($eb) = [];
    my($epw) = [];
    my($epw2) = [];

    $fp = FileHandle->new($txtfile, 'r');
    if (!defined($fp)) {
	printf(STDERR "%s ץǤޤ\n", $txtfile);
	return undef;
    }

    $err = 0;
    $line = 0;

    $buf = getline($fp);
    if (!defined($buf) ||
	substr($buf, 0, length($CAT_ENTRY)) ne $CAT_ENTRY) {
	printf(STDERR "ERR:  %s ޤ\n", $CAT_ENTRY);
	$fp->close();
	return undef;
    }
    $type = $EB;
    $st = 0;
    $mask = 0;
    for (;;) {
	$buf = getline($fp);
	if (!defined($buf) || $buf =~ /^\[/) {
	    last;
	}
	($name, $value) = getvalue($buf);
	if (!defined($name)) {
	    printf(STDERR "ERR: line %d: ʸ˸꤬ޤ\n", $line);
	    $err++;
	    next;
	}
	if ($name eq $CTAG_FILENAME) {
	    if (($mask & $M_FILENAME) != 0) {
		goto ctag_dup;
	    }
	    #
	    # ե̾ξϻȤʤΤɤФ
	    #
	    $mask |= $M_FILENAME;
	} elsif ($name eq $CTAG_BOOKS) {
	    if (($mask & $M_BOOKS) != 0) {
		goto ctag_dup;
	    }
	    #
	    # ҿξϻȤʤΤɤФ
	    #
	    $mask |= $M_BOOKS;
	} elsif ($name eq $CTAG_CDTYPE) {
	    $len = length($EPW_ID);
	    if (($mask & $M_BOOKTYPE) != 0) {
		goto ctag_dup;
	    }
	    if ($value eq $EB_ID) {
		$type = $EB;
	    } elsif (substr($value, 0, $len) eq $EPW_ID &&
		     substr($value, $len, 1) =~ /^\d$/) {
		$type = substr($value, $len, 1);
	    } else {
		printf(STDERR "ERR: line %d: %s ͤ˸꤬ޤ(%s)\n",
		       $line, $CTAG_CDTYPE, $value);
		$fp->close();
		return undef;
	    }
	    $hdr->{'cdtype'} = pack('C2', 0, $type);
	    $mask |= $M_BOOKTYPE;
	} elsif ($name eq $CTAG_SELECT) {
	    if (($mask & $M_SELECT) != 0) {
		goto ctag_dup;
	    }
	    $st = 0;
	    while ($value =~ /^\d/) {
		$st = $st * 10 + ord($value) - ord('0');
		$value = substr($value, 1);
	    }
	    if ($value eq '') {
		$hdr->{'select'} = pack('C2', 0x01,
					(($st / 10) << 4) + ($st % 10));
	    } else {
		printf(STDERR "ERR: line %d: %s ͤ˸꤬ޤ(%s)\n",
		       $line, $CTAG_SELECT, $value);
		$fp->close();
		return undef;
	    }
	    $mask |= $M_SELECT;
	} elsif ($name eq $CTAG_RESERVED) {
	    if (($mask & $M_RESERVED) != 0) {
		goto ctag_dup;
	    }
	    $mask |= $M_RESERVED;
	    $hex = gethex($value, $C_RSVLEN);
	    if (!defined($hex)) {
		goto ctag_invalid;
	    }
	    $hdr->{'reserved'} = $hex;
	} else {
	    printf(STDERR "ERR: line %d: ΥǤ(%s)\n",
		   $line, $name);
	    $err++;
	    next;
	}
	next;
      ctag_dup:
	printf(STDERR "ERR: line %d: Ƥޤ(%s)\n",
	       $line, $name);
	$err++;
	next;
      ctag_invalid:
	printf(STDERR "ERR: line %d: ͤǤ(%s)\n", $line, $value);
	$err++;
	next;
    }
    if (($mask & $M_BOOKTYPE) == 0) {
	printf(STDERR "ERR: line %d: %s ĤޤǤ\n",
	       $line, $CTAG_CDTYPE);
	$err++;
    }

    $num = 0;
    while ($buf =~ /^\[/) {
	if (substr($buf, 0, length($BOOK_ENTRY)) ne $BOOK_ENTRY) {
	    printf(STDERR "ERR: line %d: ʹܤǤ(%s)\n", $line, $name);
	    $err++;
	    for (;;) {
		$buf = getline($fp);
		if (!defined($buf) || $buf !~ /^\[/) {
		    last;
		}
	    }
	    if (!defined($buf)) {
		last;
	    }
	    next;
	}
	if (($type == $EB && $MAXENT_EB <= $num) ||
	    ($type > $EB && $MAXENT_EPW <= $num)) {
	    printf(STDERR "ERR: line %d:  %s θĿ¿ޤ\n",
		   $line, $BOOK_ENTRY);
	    $err++;
	    last;
	}
	$mask = 0;

	if ($type == $EB) {
	    push(@{$eb}, eb_t);
	} elsif ($type == $EPWING) {
	    push(@{$epw}, epw_t);
	} else {
	    push(@{$epw}, epw_t);
	    push(@{$epw2}, epw2_t);
	}

	for (;;) {
	    $buf = getline($fp);
	    if (!defined($buf) || $buf =~ /^\[/) {
		last;
	    }
	    ($name, $value) = getvalue($buf);
	    if (!defined($name)) {
		printf(STDERR "ERR: line %d: ʸ˸꤬ޤ\n", $line);
		$err++;
		next;
	    }
	    if ($name eq $BTAG_BOOKTYPE) {
		if (($mask & $M_BOOKTYPE) != 0) {
		    goto btag_dup;
		}
		$mask |= $M_BOOKTYPE;
		$t = gethex($value, $B_BKTYPELEN);
		if (!defined($t)) {
		    goto btag_invalid;
		}
		if ($type == $EB) {
		    $eb->[$num]->{'booktype'} = $t;
		} else {
		    $epw->[$num]->{'booktype'} = $t;
		}
	    } elsif ($name eq $BTAG_TITLE) {
		if (($mask & $M_TITLE) != 0) {
		    goto btag_dup;
		}
		$mask |= $M_TITLE;
		if (!$EBGmode) {
		    if ($type == $EB) {
			$t = getjstr($value, $B_TTLLEN_EB);
		    } else {
			$t = getjstr($value, $B_TTLLEN_EPW);
		    }
		} else {
		    if ($type == $EB) {
			$t = getstr($value, $B_TTLLEN_EB);
		    } else {
			$t = getstr($value, $B_TTLLEN_EPW);
		    }
		}
		if (!defined($t)) {
		    goto btag_invalid;
		}
		if ($type == $EB) {
		    $eb->[$num]->{'title'} = $t;
		} else {
		    $epw->[$num]->{'title'} = $t;
		}
	    } elsif ($name eq $BTAG_DIRECTORY) {
		if (($mask & $M_DIRECTORY) != 0) {
		    goto btag_dup;
		}
		$mask |= $M_DIRECTORY;
		$t = getstr($value, $B_DIRLEN, $F_SPACE);
		if (!defined($t)) {
		    goto btag_invalid;
		}
		if ($type == $EB) {
		    $eb->[$num]->{'directory'} = $t;
		} else {
		    $epw->[$num]->{'directory'} = $t;
		}
		if ((grep {$_ eq $t} @dirs) != 0) {
		    printf(STDERR
			   "ERR: line %d: %s ͤʣƤޤ(%s)\n",
			   $line, $buf, value);
		    $err++;
		    next;
		}
	        push(@dirs, $t);
	    } elsif ($name eq $BTAG_DIRPOS) {
		if ($type < $EPWING) {
		    goto btag_epwonly;
		}
		if (($mask & $M_DIRPOS) != 0) {
		    goto btag_dup;
		}
		$mask |= $M_DIRPOS;
		$t = gethex($value, $B_DPOSLEN_EPW);
		if (!defined($t)) {
		    goto btag_invalid;
		}
		$epw->[$num]->{'dirpos'} = $t;
	    } elsif ($name eq $BTAG_INFOBLOCK) {
		if ($type < $EPWING) {
		    goto btag_epwonly;
		}
		if (($mask & $M_INFOBLOCK) != 0) {
		    goto btag_dup;
		}
		$mask |= $M_INFOBLOCK;
		$t = gethex($value, $B_INFBLEN_EPW);
		if (!defined($t)) {
		    goto btag_invalid;
		}
		$epw->[$num]->{'infoblock'} = $t;
	    } elsif ($name eq $BTAG_APPDEF) {
		if ($type < $EPWING) {
		    goto btag_epwonly;
		}
		if (($mask & $M_APPDEF) != 0) {
		    goto btag_dup;
		}
		$mask |= $M_APPDEF;
		$t = gethex($value, $B_APPLEN_EPW);
		if (!defined($t)) {
		    goto btag_invalid;
		}
		$epw->[$num]->{'appdef'} = $t;
	    } elsif ($name eq $BTAG_ZGAIJIFILE) {
		if ($type < $EPWING) {
		    goto btag_epwonly;
		}
		if (($mask & $M_ZGAIJIFILE) != 0) {
		    goto btag_dup;
		}
		$mask |= $M_ZGAIJIFILE;
		$t = getstr($value, $B_ZGAILEN_EPW, $F_NUL);
		if (!defined($t)) {
		    goto btag_invalid;
		}
		$epw->[$num]->{'zgaijifile'} = $t;
	    } elsif ($name eq $BTAG_HGAIJIFILE) {
		if ($type < $EPWING) {
		    goto btag_epwonly;
		}
		if (($mask & $M_HGAIJIFILE) != 0) {
		    goto btag_dup;
		}
		$mask |= $M_HGAIJIFILE;
		$t = getstr($value, $B_HGAILEN_EPW, $F_NUL);
		if (!defined($t)) {
		    goto btag_invalid;
		}
		$epw->[$num]->{'hgaijifile'} = $t;
	    } elsif ($name eq $B2TAG_RSV1) {
		if ($type < $EPWING2) {
		    goto btag_epw2only;
		}
		if (($mask & $M_RESERVED1) != 0) {
		    goto btag_dup;
		}
		$mask |= $M_RESERVED1;
		$t = gethex($value, $B2_RSV1LEN);
		if (!defined($t)) {
		    goto btag_invalid;
		}
		$epw2->[$num]->{'reserved1'} = $t;
	    } elsif ($name eq $B2TAG_BKFILE) {
		if ($type < $EPWING2) {
		    goto btag_epw2only;
		}
		if (($mask & $M_BOOKFILE) != 0) {
		    goto btag_dup;
		}
		$mask |= $M_BOOKFILE;
		$t = getstr($value, $B2_BKFILELEN, $F_SPACE);
		if (!defined($t)) {
		    goto btag_invalid;
		}
		$epw2->[$num]->{'bookfile'} = $t;
	    } elsif ($name eq $B2TAG_PAD1) {
		if ($type < $EPWING2) {
		    goto btag_epw2only;
		}
		if (($mask & $M_PADDING1) != 0) {
		    goto btag_dup;
		}
		$mask |= $M_PADDING1;
		$t = gethex($value, $B2_PAD1LEN);
		if (!defined($t)) {
		    goto btag_invalid;
		}
		$epw2->[$num]->{'padding1'} = $t;
	    } elsif ($name eq $B2TAG_STFILE) {
		if ($type < $EPWING2) {
		    goto btag_epw2only;
		}
		if (($mask & $M_STREAMFILE) != 0) {
		    goto btag_dup;
		}
		$mask |= $M_STREAMFILE;
		$t = getstr($value, $B2_STFILELEN, $F_SPACE);
		if (!defined($t)) {
		    goto btag_invalid;
		}
		$epw2->[$num]->{'streamfile'} = $t;
	    } elsif ($name eq $B2TAG_PAD2) {
		if ($type < $EPWING2) {
		    goto btag_epw2only;
		}
		if (($mask & $M_PADDING2) != 0) {
		    goto btag_dup;
		}
		$mask |= $M_PADDING2;
		$t = gethex($value, $B2_PAD2LEN);
		if (!defined($t)) {
		    goto btag_invalid;
		}
		$epw2->[$num]->{'pad2'} = $t;
	    } elsif ($name eq $B2TAG_RSV2) {
		if ($type < $EPWING2) {
		    goto btag_epw2only;
		}
		if (($mask & $M_RESERVED2) != 0) {
		    goto btag_dup;
		}
		$mask |= $M_RESERVED2;
		$t = gethex($value, $B2_RSV2LEN);
		if (!defined($t)) {
		    goto btag_invalid;
		}
		$epw2->[$num]->{'reserved2'} = $t;
	    } elsif ($name eq $B2TAG_PAD3) {
		if ($type < $EPWING2) {
		    goto btag_epw2only;
		}
		if (($mask & $M_PADDING3) != 0) {
		    goto btag_dup;
		}
		$mask |= $M_PADDING3;
		$t = gethex($value, $B2_PAD3LEN);
		if (!defined($t)) {
		    goto btag_invalid;
		}
		$epw2->[$num]->{'pad3'} = $t;
	    } else {
		printf(STDERR "ERR: line %d: ΥǤ(%s)\n",
		       $line, $name);
		$err++;
		next;
	    }
	    next;

	  btag_epwonly:
	    printf(STDERR "ERR: line %d: ΥEPWINGѤǤ(%s)\n",
		   $line, $buf);
	    $err++;
	    next;
	  btag_epw2only:
	    printf(STDERR "ERR: line %d: ΥEPWING2ʹѤǤ(%s)\n",
		   $line, $buf);
	    $err++;
	    next;
	  btag_dup:
	    printf(STDERR "ERR: line %d: Ƥޤ(%s)\n",
		   $line, $buf);
	    $err++;
	    next;
	  btag_invalid:
	    printf(STDERR "ERR: line %d: ͤǤ(%s)\n", $line, $value);
	    $err++;
	    next;
	}
	if ($type >= EPWING && ($mask & $M_BOOKTYPE) == 0) {
	    printf(STDERR "ERR: line %d: %s ĤޤǤ\n",
		   $line, $BTAG_BOOKTYPE);
	    $err++;
	}
	if (($mask & $M_TITLE) == 0) {
	    printf(STDERR "ERR: line %d: %s ĤޤǤ\n",
		   $line, $BTAG_TITLE);
	    $err++;
	}
	if (($mask & $M_DIRECTORY) == 0) {
	    printf(STDERR "ERR: line %d: %s ĤޤǤ\n",
		   $line, $BTAG_DIRECTORY);
	    $err++;
	}
	if ($type >= EPWING && ($mask & $M_INFOBLOCK) == 0) {
	    if ($epw->[$num]->{'booktype'} !~ /^\xf0/) {
		#
		# ȥ꡼Ұʳʤ
		# Ҵ֥å
		# 1֥åȲꤹ
		#
		$epw->[$num]->{'infoblock'} =~ s/(.)./$1\x01/;
	    }
	}
	$num++;
    }

    $hdr->{'books'} = pack('C2', ($num >> 8) & 0xff, $num & 0xff);
    if ($st > $num) {
	printf(STDERR "ERR: %s ͤҿĶƤޤ\n", $CTAG_SELECT);
	$err++;
    }
    $fp->close();
    if ($err) {
	return undef;
    }

    $fp = FileHandle->new($catalog, 'w');
    if (!defined($fp)) {
	printf(STDERR "%s Ǥޤ\n", $catalog);
	return undef;
    }
    binmode($fp);

    $buf = '';
    $buf .= $hdr->{'books'};
    $buf .= $hdr->{'cdtype'};
    $buf .= $hdr->{'select'};
    $buf .= $hdr->{'reserved'};
    if (!$fp->print($buf)) {
	printf(STDERR "񤭹ߤ˼Ԥޤ\n");
	$fp->close();
	return undef;
    }

    for ($i = 0; $i < $num; $i++) {
	$buf = '';
	if ($type == $EB) {
	    $buf .= $eb->[$i]->{'booktype'};
	    $buf .= $eb->[$i]->{'title'};
	    $buf .= $eb->[$i]->{'directory'};
	} elsif ($type == $EPWING || $type > $EPWING) {
	    $buf .= $epw->[$i]->{'booktype'};
	    $buf .= $epw->[$i]->{'title'};
	    $buf .= $epw->[$i]->{'directory'};
	    $buf .= $epw->[$i]->{'dirpos'};
	    $buf .= $epw->[$i]->{'infoblock'};
	    $buf .= $epw->[$i]->{'appdef'};
	    $buf .= $epw->[$i]->{'zgaijifile'};
	    $buf .= $epw->[$i]->{'hgaijifile'};
	}
	if (!$fp->print($buf)) {
	    printf(STDERR "񤭹ߤ˼Ԥޤ\n");
	    $fp->close();
	    return undef;
	}
    }

    if ($type > $EPWING) {
	for ($i = 0; $i < $num; $i++) {
	    $buf = '';
	    $buf .= $epw2->[$i]->{'reserved1'};
	    $buf .= $epw2->[$i]->{'bookfile'};
	    $buf .= $epw2->[$i]->{'pad1'};
	    $buf .= $epw2->[$i]->{'streamfile'};
	    $buf .= $epw2->[$i]->{'pad2'};
	    $buf .= $epw2->[$i]->{'reserved2'};
	    $buf .= $epw2->[$i]->{'pad3'};
	}
	if (!$fp->print($buf)) {
	    printf(STDERR "񤭹ߤ˼Ԥޤ\n");
	    $fp->close();
	    return undef;
	}
    }

    if ($fp->tell() % $BLKSIZ != 0) {
	$buf = "\0" x ($BLKSIZ - $fp->tell() % $BLKSIZ);
	if (!$fp->print($buf)) {
	    printf(STDERR "񤭹ߤ˼Ԥޤ\n");
	    $fp->close();
	    return undef;
	}
    }

    $fp->close();
    return 1;
}

sub getline ($) {
    my($fp) = @_;
    my($buf);

    for (;;) {
	$buf = $fp->getline();
	$line++;
	if (!defined($buf)) {
	    return undef;
	}
	$buf =~ s/\r?\n?$//;
	if ($buf !~ /^$/ && $buf !~ /^;/) {
	    last;
	}
    }
    return $buf;
}

sub getvalue ($) {
    my($buf) = @_;
    my($name, $value);

    if ($buf !~ /^([^=]+)=(.*)$/) {
	return undef;
    }
    ($name, $value) = ($1, $2);
    $name =~ s/^[ \t]+//;
    $name =~ s/[ \t]+$//;
    $value =~ s/^[ \t]+//;
    $value =~ s/[ \t]+$//;

    if ($value =~ /^\"/) {
	if ($value !~ /\"$/) {
	    return undef;
	}
    } else {
	$value =~ s/ .*$//;
    }

    return ($name, $value);
}

sub gethex ($$) {
    my($str, $len) = @_;
    my($buf) = '';
    
    while ($len-- > 0) {
	if ($str !~ /^[0-9A-Fa-f]/) {
	    last;
	}
	$buf .= pack('C', hex(substr($str, 0, 2)));
	$str = substr($str, 2);
    }
    if ($str ne '') {
	return undef;
    }
    while ($len-- > 0) {
	$buf .= "\0";
    }
    return $buf;
}

sub getstr($$$) {
    my($str, $len, $type) = @_;
    my($buf) = '';
    my($hex);

    if ($str !~ /^\"/) {
	return undef;
    }
    $str = substr($str, 1);
    while ($len > 0) {
	if ($str eq '') {
	    return undef;
	}
	if ($str =~ /^\"/) {
	    last;
	}
	if ($str !~ /^\\/) {
	    $buf .= substr($str, 0, 1);
	    $str = substr($str, 1);
	    $len--;
	    next;
	}
	$str = substr($str, 1);
	if ($str eq '') {
	    next;
	} elsif ($str =~ /^[xX]/) {
	    $str = substr($str, 1);
	    $hex = gethex($str, 1);
	    if (!defined($hex)) {
		return undef;
	    }
	    $buf .= $hex;
	    $str = substr($str, 2);
	} else {
	    $buf .= substr($str, 0, 1);
	}
    }
    if ($str !~ /^\"/) {
	return undef;
    }
    if ($type == $F_NUL) {
	while ($len-- > 0) {
	    $buf .= "\0";
	}
    } else {
	while ($len-- > 0) {
	    $buf .= ' ';
	}
    }
    return $buf;
}

sub getjstr($$) {
    my($str, $len) = @_;
    my($buf) = '';
    my($c1, $c2);

    if ($str !~ /^\"/) {
	return undef;
    }
    $str = substr($str, 1);

    if ($encoding == $EUC) {
	while ($len > 0) {
	    if ($str eq '') {
		return undef;
	    }
	    if ($str =~ /^\"/) {
		last;
	    }
	    if ($str =~ /^[\x00-\xa0\xff]/ || $str =~ /^.[\x00-\xa0\xff]/) {
		return undef;
	    }
	    $buf .= pack('C', ord($str) & 0x7f);
	    $str = substr($str, 1);
	    $buf .= pack('C', ord($str) & 0x7f);
	    $str = substr($str, 1);
	    $len -= 2;
	}
    }
    if ($encoding == $SJIS) {
	while ($len > 0) {
	    if ($str eq '') {
		return undef;
	    }
	    if ($str =~ /^\"/) {
		last;
	    }
	    $c1 = ord($str);
	    $str = substr($str, 1);
	    $c2 = ord($str);
	    $str = substr($str, 1);
	    if ($c1 < 0x81 || $c1 > 0x9f && $c1 < 0xe0 || $c1 > 0xef) {
		return undef;
	    }
	    if ($c1 > 0x9f) {
		$c1 -= 0x40;
	    }
	    $c1 += $c1;
	    if ($c2 <= 0x9e) {
		$c1 -= 0xe1;
		if ($c2 >= 0x80) {
		    $c2 -= 1;
		}
		$c2 -= 0x1f;
	    } else {
		$c1 -= 0xe0;
		$c2 -= 0x7e;
	    }
	    $buf .= pack('C', $c1);
	    $buf .= pack('C', $c2);
	    $len -= 2;
	}
    }

    if ($str !~ /^\"/) {
	return undef;
    }
    while ($len-- > 0) {
	$buf .= "\0";
    }
    return $buf;
}

main;
