#!/usr/bin/perl -w

# version: 0.1
# Serge Sharoff 
# December 2002, Moscow
# sharoff@aha.ru

# Functionality: 
# outputs the list of files in a text corpus
$filemask='*.txt';
$output = shift;  # the output file
$outputbat = shift;  # the output file

if (!$outputbat) {die "Usage: corpusstat.pl outfile outbatfile [corpusdir]\n"}
else {
    open (OUT, "> $output") or die "\n The output file $output couldn't be created!!\n" ;
    open (OUTBAT, "> $outputbat") or die "\n The output batch file $outputbat couldn't be created!!\n" ;}


$rootdir= shift || '.';

recursivedir($rootdir);

close(OUT);

sub recursivedir {
    my ($rootdir)=@_;
    my @dirlist=();
    opendir(DIR, $rootdir) or die "Can't open directory $rootdir: $!\n";
    $rootdir=~/([^\\\/]+)$/;
    $dirid=uc($1);
    $i=1;
    while (($dirids{substr($dirid,0,$i)}) and ($i<length($dirid))) {$i++};
    $dirid=substr($dirid,0,$i);
    foreach (<$rootdir/$filemask>) {
	$dirids{$dirid}=1; #only if maskfiles files
	processfile($_,$dirid);
    };
    while (my $dir= readdir DIR) {
	$dir= "$rootdir/".$dir;
	if ((-d $dir) and (not $dir=~/\./)) { 
	    push @dirlist, $dir;
	}
    };
    closedir(DIR);
    foreach (@dirlist) {
	recursivedir($_);
    }  
}

sub processfile {
    my ($input,$dirid)=@_;
    if ($input=~/([^\\\/]+).\w*$/) {
	  $fname=$1;} 
    else {print "Can't get the doc id in $input\n"; next}
    next if ($fname=~/^(copyright|about)$/);
    $i=length($dirid)+2; $docid=uc("$dirid-$fname");
    while (($docids{substr($docid,0,$i)}) and ($i<length($docid))) {$i++};
    $docid=substr($docid,0,$i);
    while ($docids{$docid}) {$docid.='x'}; #in the unlikely event of identical filenames in two subdirectories with identical names
    $docids{$docid}=1;
    print "$input: $docid\n";
    $author="";
    $title="";
    $date="";
    $read=1;
    if (open (IN, "< $input")) {
	@text = <IN>;             # read the whole file into a list
	close(IN);
	$i=0;
	while ($read) {
		$_=$text[$i];
		if (/([À-ßà-ÿ\w].+)$/) {
		  if ($title) {
			if (not $author) {$author=$1}
		  }
		  else {$title=$1;}
		};
		if ($text[-$i]=~/(\d{4})$/)  {
			$date=$1;
		} elsif (/(\d{4})$/) {
			$date=$1;
		};
		if ($title=~/^([^\"]+)\.\s*([^\.]+)([\.\)]*)$/) { 
		   ($author, $title)=($1,$2);
		};

		if ($author and $title and $date or ($i>5)) {$read=0};
		$i++;
	};
	if (length($author)>30) {
		$title="$author $title"; $author="" };
	if ($author=~/^(.|.\..)$/) {
		$title="$author. $title";
		$author="";
	};
	if (not $author) {
	    if ($title=~/(.+)[\.,]\s*(.+)/) {
		if (length($1)<40) {($author, $title)=($1,$2);}
	}};
	$title=substr($title,0,70);
	$text = join('', @text); # create a string with the whole file in it
	$text =~ s/\s+/ /gs;     # remove all extra spaces and returns
	$text =~ s/-+//g;       # remove all hyphens, as well as line separators
	@text = split /[\s:;,.!]+/, $text; # now it contains a list of words
	$wordnumber = grep /[À-ßà-ÿ]+/, @text; # the number of elements consisting of Cyr chars
	unless ($author) {$author="!!author"};
	unless ($date) {$date="!!year"};
	print OUT "$docid|$author|$title|$date|$input|$wordnumber\n";
	print OUTBAT "\ndialingprocessor $input $docid.xml -gr\n";
	print OUTBAT "perl unkn.pl $docid.xml errors.lst\n";
	print OUTBAT "perl tagpos.pl $docid.xml $docid.ctt\n";
     }
    else {print "\n Input file $input couldn't be opened!!\n"};
    undef @text;
};

