#!/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 (($_ = ) && (!$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"; } }