#!/usr/bin/perl

# trailing slash!
$archive = "/var/spool/news/faq.archive/";

chdir("/var/spool/news/news/answers/") || die "can't chdir to FAQ directory";

opendir(FAQ, ".") || die "can't open FAQ directory";
@faqs = grep(/^\d+$/, readdir(FAQ));
closedir(FAQ);

$maxline = 100;
foreach $artno ( @faqs ) {
    if (open(I, "< $artno")) {
	$foundeoh = 0;
	$line = 0;
	while (($_ = <I>) && (!$foundeoh || $line < $maxline)) {
	    $line++;
	    $foundeoh = 1 if /^$/;
	    if (/^Archive-name:\s+(\S+)\s*$/i) {
	        $name = $archive . $1;
		$name =~ s:/+$::;
	        $dir = $name;
	        &mkpdir( $name ) if ! -d $name;
		# I couldn't understand the original code.
		# It's removing an original file under news/answers directory
		# if it is not able to be linked as an archived file.
		# unlink( $artno ) unless ( link( $artno, $name ) );
		#
		# If you want to remove all saved answers from new/answers
		# directory, use following codes.
		# unlink $name;
		# unlink $artno if link($artno, $name);
		#
		# If you want to just make links to the archived directory,
		# use following codes.
		unlink $name;
		link $artno, $name ;
		#
		# do the same work for the next file.
		last;
	    }
        }
	close(I);
    }
}
	




#
# make parent directory of argument
#
sub mkpdir {
    local( $dir ) = @_;

    $dir =~ s-/[^/]+$--;
    unlink $dir if ( -e $dir && ! -d _ );
    unless ( -d _ ) {
	&mkpdir( $dir );
	mkdir $dir, 0775;
	print "made ", $dir, "\n";
    }
}


syntax highlighted by Code2HTML, v. 0.9.1