#!/usr/um/bin/perl

# MH script to automatically set fcc field based on  header contents.
# does completion on aliases, too.
# by Dave Disser (disser@engin.umich.edu)
#
# depends on file named below, with format similar to following:
#
# header:regexp:folder
# from:bob:friends/bob
# subject:software.*install:packages/install

require('complete.pl');

$refiles="$ENV{'HOME'}/.refiles";
$editor=$ENV{'editor'};
$editor=$ENV{'EDITOR'} unless $editor;
$editor="/bin/true" unless $editor;

$refiled=0;

$file=shift;
open(FILE,$file);

# Read the header

while(<FILE>) {
    last if /^$/;
    if (/^\s+/) {
	$value .= $_;
    } elsif (/:\s*/) {
	if ($header) {
	    push(@hlist,$header);
	    $header=~y/A-Z/a-z/;
	    $header{$header}=$value;
	}

	$header=$`;
	$value=$';
    } elsif ($header) {
	push(@hlist,$header);
	$header=~y/A-Z/a-z/;
	$header{$header}=$value;
	last;
    }
}

# Read the body

while(<FILE>) {
    push(@body,$_);
}

close(FILE);

# Check for critical fields

for (@hlist) { 
    $v=$_;
    $v=~y/A-Z/a-z/;
    &prompt($_) unless $header{$v};
}

# Munge it.

open(FILE,$refiles) || die $!;

while(<FILE>) {
    next if /^#/;
    next if /^\s*$/;
    split(/:/);
    last if &setfield($_[0],$_[1],"fcc",$_[2]);
}
close(FILE) || die $!;

print STDERR "Warning: no sort found on headers\n" 
    unless $refiled;

# Write it.

open(FILE,">$file") || die $!;
for (@hlist) {
    $v=$_;
    $v=~y/A-Z/a-z/;
    print FILE "$_: $header{$v}";
}

print FILE "--------\n";

print FILE @body;

close(FILE) || die $!;

exec("$editor $file") || die $!;

sub setfield {
    local($f1, $v1, $f2, $v2)=@_;
    if ($header{$f1}=~/$v1/i) {
	$header{$f2}=$v2;
	$refiled++;
	return 1;
    }

    0; 
}

sub prompt {
    local($field)=shift;
    local($_);
    local($val);

    &setcompletes;

    if ($field=~/(to|cc)/i) {
        $val=&Complete("$field: ", @completes);
	$val .= "\n";
	undef $Complete'return;
    } else { 
        print "$field: ";
        $val=<STDIN>;
    }
    $field=~y/A-Z/a-z/;
    $header{$field}=$val;
}

sub setcompletes {
    local($_);
    return if @completes;

    open(ALI, "ali|") || return;
    while(<ALI>) {
        next unless /:/;
        push(@completes,$`);
    }
    close(ALI);
}