#! /usr/local/bin/perl
# 	@(#)btfar 01-09-13
#	(C) Copyright 2001 by Personal Media Corporation
#
# 	ɸϤ⤷ϥޥɥ饤󤫤ե(ӥץ)
#	ꡢǥ쥯ȥĥ꡼ݤäޤޡbtfñե
#	֤롣

sub usage {
    print STDERR "usage: btfar [-n] -o output-file [-t BTRON-filename] [-c]\n";
    print STDERR "       [-a application-type] [-f file-type] \n";
    print STDERR "       [-m mkbtf-path] [-w work-directory]\n";
    print STDERR "       ( -r record-type[.record-subtype] | filename)*\n";
    print STDERR "       filenameȤ󤵤줿ե뷲UNIXΥǥ쥯ȥ깽¤\n";
    print STDERR "       ޤ.btfBTRONեȤƹե̾output-file\n";
    print STDERR "       ƺ롣\n";
    print STDERR "       filenameХѥǤʤФʤʤ\n";
    print STDERR "       ¿̾ϡ롼ȼ¿ȤBTRON-filenameȤʤꡢʳfilename\n";
    print STDERR "       ޤޤȤʤ롣\n";
    print STDERR "       -rץλϡʸfilenameƤͭȤʤ롣\n";
    print STDERR "       filenameȤ'-'ͿȡɸϤ饳ޥɥ饤\n";
    print STDERR "       롣\n";
    print STDERR "       -nץꤹȡºݤϹԤ鷺ˡ¹Ԥmkbtf\n";
    print STDERR "       ޥɤɽ롣\n";
    exit(1);
}

# ------------------------------------------------------------
# options' default
$application_type = 3;		# 
$with_compaction = 0;
$output_file = $btron_filename = '';
$file_type = 0;
$record_type = 31;		# ץꥱ쥳
$record_subtype = 0;
$cmd_mkbtf = '/usr4/3bv/etc/mkbtf';
$work_directory = '/tmp';
$dont_create = 0;

# ------------------------------------------------------------
# 
&read_args;
&parse_filename;
&make_link;
&make_btfile(0);
&cleanup;

# ------------------------------------------------------------
sub error {
    &cleanup;
    print STDERR @_, "\n";
    exit(1);
}

# ------------------------------------------------------------
# ޥɥ饤ɤ߹
sub read_args {
    local ($arg, @arg);

    @arg = @ARGV;
    while ($arg = shift(@arg)) {
	if ($arg eq '-o') {
	    $output_file = shift(@arg);
	} elsif ($arg eq '-a') {
	    $application_type = shift(@arg);
	} elsif ($arg eq '-c') {
	    $with_compaction = 1;
	} elsif ($arg eq '-t') {
	    $btron_filename = shift(@arg);
	} elsif ($arg eq '-f') {
	    $file_type = shift(@arg);
	} elsif ($arg eq '-m') {
	    $cmd_mkbtf = shift(@arg);
	} elsif ($arg eq '-w') {
	    $work_directory = shift(@arg);
	} elsif ($arg eq '-n') {
	    $dont_create = 1;
	} elsif ($arg eq '-') {
	    @arg = &read_filenames();
	} elsif ($arg eq '-r') {
	    $_ = shift(@arg);
	    ($record_type, $record_subtype) = (/^([\dxa-f]+)(\.([\dxa-f]+))?/)[0,2];
            $record_type = oct $record_type if $record_type =~ /^0/;
            $record_subtype = oct $record_subtype if $record_subtype =~ /^0/;
        } elsif ($arg eq '-h') {
            help ();
	} else {
	    &add_filename($arg, $record_type, $record_subtype);
	}
    }

    # ¿̾ά줿UNIXե̾򤽤Τޤ޻Ȥ
    if ($btron_filename eq '') {
	local (@path);
	@path = split('/', $output_file);
	$btron_filename = $path[$#path];
    }

    $work_directory .= '/' if ($work_directory !~ m:/$:);

    &usage if ($output_file eq '');
    &usage if (@filename_bpath == 0);
}

# ɸϤե̾Ϥ
sub read_filenames {
    local ($s, $in);
    while (read(STDIN, $s, 4096)) {
	$in .= $s;
    }

    local ($arg, @arg);
    for (;;) {
	$in =~ s/^\s+//;
	last if ($in eq '');

	# 'filename' / "filename" / filename
	if ($in =~ s/^\'//) {
	    ($arg) = ($in =~ /([^\']*)\'/);
	    $in = $';	# XXX ³γǧϾά
	} elsif ($in =~ s/^\"//) {
	    ($arg) = ($in =~ /([^\"]*)\"/);
	    $in = $';	# XXX ³γǧϾά
	} else {
	    ($arg) = ($in =~ /([^\s]+)/);
	    $in = $';
	}

	push (@arg, $arg);
    }
    
    return @arg;
}

# ------------------------------------------------------------
# Ϥե͡(б쥳ɥ/֥)Υꥹ
# @filename_bpath
# @filename_realpath
# @filename_record_type
# @filename_record_subtype

sub split_btfpath {
    local ($path) = @_;
    local ($linkattr) = ($path =~ /^\@([\dxa-f]+\.[\dxa-f]+\.[\dxa-f]+\.[\dxa-f]+\.[\dxa-f]+\.)/);
    local ($realpath) = $';
    return ($realpath, $linkattr);
}

# UNIXեΥꥹȤɲä
sub add_filename {
    local ($filename, $rectype, $subtype) = @_;
    local ($idx, $realpath, $bpath, @path, $i);

    ($realpath, $bpath) = ($filename =~ /^([^=]+)(=.*)?/);

    if ($realpath =~ /\./) {
	# . / .. ؤн
	@path = split('/', $realpath);
	$i = $#path;
	while ($i >= 0) {
	    if ($path[$i] eq '.') {
		splice(@path, $i, 1);
		$i--;
	    } elsif ($path[$i] eq '..') {
		# XXX 롼ȤοƤθƤʤ
		splice(@path, $i - 1, 2);
		$i -= 2;
	    } else {
		$i--;
	    }
	}
	$realpath = join('/', @path);
    }

    return if ($realpath eq '');

    # XXX ХѥΤȤcwd٤?

    $idx = @filename_realpath;
    if ($bpath eq '') {
	$bpath = $realpath;
    } elsif ($bpath eq '=') {
	$bpath = '';
    } else {
	$bpath =~ s/^=//;
	if ($bpath =~ m:/$:) {
	    # foo/bar=baz/  ->  foo/bar=baz/bar
	    @path = split('/', $realpath);
	    $bpath .= $path[$#path];
	}
    }

    local ($real_filepath) = $realpath;
    if ($real_filepath =~ /^\@/) {
	($real_filepath) = &split_btfpath($real_filepath);
    }
    if (-d $real_filepath) {
	$rectype = $subtype = 0;
    } elsif (!-e $real_filepath) {
	print STDERR "No such file: '$realpath'\n";
	exit(1);
    }
   
    $filename_realpath[$idx] = $realpath;
    $filename_bpath[$idx] = $bpath;
    $filename_record_type[$idx] = $rectype;
    $filename_record_subtype[$idx] = $subtype;
}

# ------------------------------------------------------------
# ޥɥ饤Υե뷲ϤBTRONե󤹤
sub parse_filename {
    local ($i, $j, @path);

    for ($i = 0; $i < @filename_bpath; $i++) {
	if ($filename_record_type[$i] == 0) {
	    &add_bfiledir($filename_bpath[$i]);
	} else {
	    &add_bfile($filename_realpath[$i], $filename_bpath[$i], 
		       $filename_record_type[$i], 
		       $filename_record_subtype[$i]);
	}
	@path = split('/', $filename_bpath[$i]);
	for ($j = $#path - 1; $j >= 0; $j--) {
	    last if (&add_bfiledir(join('/', @path[0..$j])) == 0);
	}
    }
}

# ------------------------------------------------------------
# ե֤Υ󥯤
sub make_link {
    local ($i, $idx, @path, $dirbpath);
    for ($i = 1; $i < @bfile_bpath; $i++) {
	@path = split('/', $bfile_bpath[$i]);
	$dirbpath = join('/', @path[0..($#path - 1)]);
	$idx = $bfile_bpath_to_idx{$dirbpath};
	$bfile_child[$idx] .= pack("I", $i);
    }
}

# ------------------------------------------------------------
# BTRONե(Ƶ)
sub make_btfile {
    local ($idx) = @_;

    if ($bfile_btffile[$idx] ne '') {
	# Ǥ
	return $bfile_btffile[$idx];
    }

    local ($childidx, @child, @childfile, $linkattr);
    @child = unpack("I*", $bfile_child[$idx]);
    
    foreach $childidx (@child) {
	&error("assert[idx=$idx]") if ($childidx == 0);
	$linkattr = "0.0.0.0.0.";
	if ($bfile_linkattr[$childidx] ne '') {
	    $linkattr = $bfile_linkattr[$childidx];
	}

	push (@childfile, 
	      sprintf("\@%s%s", $linkattr, &make_btfile($childidx)));
    }

    local ($btffile, $objname, @cmd, @path);
    if ($idx == 0) {
	$btffile = $output_file;
	$objname = $btron_filename;
	push (@cmd, $cmd_mkbtf, 
	      "-o$btffile", "-t$objname", 
	      "-a$application_type", "-f$file_type");
	push (@cmd, "-c") if ($with_compaction);
    } else {
	@path = split('/', $bfile_bpath[$idx]);
	$btffile = &tmp_filename($idx);
	$objname = $path[$#path];
	push (@cmd, $cmd_mkbtf, "-o$btffile", "-t$objname");
	$bfile_btffile_tmp[$idx] = 1;
    }

    if ($bfile_records[$idx] ne '') {
	push (@cmd, split("\0", $bfile_records[$idx]));
    } else {
	push (@cmd, 'N');
    }

    if (@childfile > 0) {
	foreach (@childfile) {
	    push (@cmd, "$_");
	}
    }

    if ($dont_create) {
	print join(' ', @cmd), "\n";
    } else {
	if (system(@cmd) != 0) {
	    &error("Error: command [", join(' ', @cmd), "]");
	}
    }

    foreach $childidx (@child) {
	if ($bfile_btffile_tmp[$childidx]) {
	    unlink($bfile_btffile[$childidx]);
	}
    }

    $bfile_btffile[$idx] = $btffile;
    return $btffile;
}

# ------------------------------------------------------------
# ե
sub cleanup {
    local ($i);

    for ($i = 1; $i < @bfile_btffile; $i++) {
	if ($bfile_btffile_tmp[$i]) {
	    unlink($bfile_btffile[$i]);
	}
    }
}

# ------------------------------------------------------------
# @bfile_bpath		# BTRONեpath
# %bfile_bpath_to_idx	# bpathidxؤΥޥå
# @bfile_child		# ҥեidxpack("I")
# @bfile_linkattr	# °
# @bfile_btffile	# UNIXBTRONեΥե̾
# @bfile_btffile_tmp
# @bfile_records	

sub reg_bfile {
    local ($bpath) = @_;
    local ($idx);

    if ($bpath eq '') {
	$idx = 0;
    } else {
	$idx = @bfile_bpath;
	$idx = 1 if ($idx == 0);
    }

    $bfile_bpath[$idx] = $bpath;
    $bfile_bpath_to_idx{$bpath} = $idx;
}

sub find_bfile {
    local ($bpath) = @_;

    return $bfile_bpath_to_idx{$bpath};
}

sub add_bfile {
    local ($realpath, $bpath, $recordtype, $subtype) = @_;
    local ($idx);

    $idx = &find_bfile($bpath);
    if (!defined($idx)) {
	$idx = &reg_bfile($bpath);
    }

    if ($realpath =~ /^\@/) {
	local ($realpath, $linkattr) = &split_btfpath($realpath);

	# btfեλ
	&error("Error: btf file is already specified.") if ($bfile_btffile[$idx] ne '');
	
	$bfile_btffile[$idx] = $realpath;
	$bfile_linkattr[$idx] = $linkattr;
	return;
    }

    $bfile_records[$idx] .= 
	sprintf("%d.%d.%s\0", $recordtype, $subtype, $realpath);
}

sub add_bfiledir {
    local ($bpath) = @_;

    if (defined(&find_bfile($bpath))) {
	# Ǥɲú
	return 0;
    }

    &reg_bfile($bpath);
    return 1;
}

# ------------------------------------------------------------
# ե̾
sub tmp_filename {
    local ($idx) = @_;
    return sprintf("%s#btfar-%d.%d", $work_directory, $$, $idx);
}

sub help {
    while (<DATA>) { print STDERR; }
    exit (2);
}

__END__


        btfar [-n] -o output-file [-t BTRON-filename] [-c]
              [-a application-type] [-f file-type]
              [-m mkbtf-path] [-w work-directory]
              ( -r record-type[.record-subtype] | filename)*

ץ

        -h      Υإפɽ롣

        -n      ¹Ԥmkbtfޥɤΰɽ롣ºݤΥե
                Ԥʤ

        -o output-file
                btfեoutput-file Ȥ롣UNIXѥ̾ǻꤹ롣

        -t BTRON-filename
                btfեΥ롼ȼ¿Ȥμ¿̾ꤹ롣
                -tץ󤬾ά줿硢-oץ
                output-fileΤޤ޻Ѥ롣

        -c      btfե򰵽̤롣

        -a application-type
                롼ȼ¿ȤΥץꥱ󥿥פꤹ롣
                ά줿3()

        -f file-type
                롼ȼ¿ȤΥե륿פꤹ롣
                ά줿0

        -m mkbtf-path
                mkbtfޥɤUNIXѥ̾ꤹ롣
                ά줿 /usr4/3bv/etc/mkbtf

        -w work-directory
                եǥ쥯ȥꤹ롣
                btfar̤ΰեΤդ롣
                ά줿 /tmp

        -r record-type[.record-subtype]
                оݥեΥ쥳ɥפȥ쥳ɥ֥פ
                ꤹ롣
                ͤ31.0
                -rʸ˻ꤹ륢оݥե(btfΥե
                )ŬѤ롣

        filename
                оݥե롢Ӥְ֤ꤹ롣

                        UNIXѥ̾
                        UNIXѥ̾=BTRONǥ쥯ȥ̾/
                        UNIXѥ̾=BTRONǥ쥯ȥ̾/BTRON¿̾

                Τ줫ǻꤹ롣
                UNIXѥ̾'@ե̾'ξ硢btfΥեȤߤ
                '@n.n.n.n.n.ե̾'ξ硢'n.n.n.n.n'ϥ°
    		λȤߤʤ롣BTRON¿̾ϻꤷƤ̵뤵롣

                '-' ꤵ줿ϡʸΥѥ᡼Ϥ򥳥ޥ
                饤󤫤ɸ(stdin)ڤؤ롣


