#!/usr/bin/perl -s
sub Help {
    print <<HELP;
Synopsis:
    1. Get the category information from the Reuters' HTML files
    2. Update the category information such that only categories appearing
       in both the training and testing documents survive.
    3. Dump categories used in the training or the test set (for validation).
Examples:
  perl -s GetCat.pl /test-html > test-cat.txt
    => Get category information from test set
  perl -s GetCat.pl /train-html > train-cat.txt
    => Get category information from training set
  perl -s GetCat.pl -Oupdate train-cat.txt test-cat.txt
    => Update category information
  perl -s GetCat.pl -Odump train-cat.txt
    => Dump used categories
    
Author: Yuen-Hsien Tseng
Date: September 10, 2002
HELP
exit;
}
    &Help() if $help or $h or @ARGV == 0;
    if ($Odump) { &DumpCat(@ARGV);
    } elsif ($Oupdate) { &Update(@ARGV);
    } else {
    	&ExtractCat_from_Dir(@ARGV);
    }
    exit;
    
# Extract categories from files in a directory and write the results to STDOUT
sub ExtractCat_from_Dir {
    my($Dir) = @_;
    opendir(DIR, $Dir) or die "Cannot open dir:$Dir, $!";
    @DIR = readdir(DIR) or warn "$!";
    foreach $f (@DIR) {
	next if $f =~ /^\./;
# open and get file's content
	local $/; undef $/;
	open F, "$Dir/$f" or warn "Cannot open file:'$Dir/$f', $!";
	$L = <F>;	close(F);
# get the categories
	my(@Cat) = (); 
	if ($L =~ m|<TOPICS>(.+)</TOPICS>|i) {
#print "cat=$1\n";
	    $catstr = $1;
	    while ($catstr =~ s|<D>([^<]+)</D>||i) {
	    	push @Cat, $1;
	    }
	}
	$f =~ s/\.html?|\.txt//; # delete file extension
	print "$f\t", join ("\t", @Cat), "\n";
    }
    close(DIR);
}


# Set file with File_to_Categories information, set %$rCat
sub SetCat {
    my($File, $rCat) = @_;  my($c, @Cat);
    open T, $File or die "Cannot open: '$File', $!";
    while (<T>) {
    	chomp; next if /^\s*$|^#/;
    	@Cat = split /\t/, $_;
    	shift @Cat; # remove file id, leaving only categories
    	foreach $c (@Cat) { $rCat->{$c} = 1; }
    }
    close(T);
}

# Given the file with File_to_Categories information, find out all the 
# categories used in all files.
sub DumpCat {
    my($file) = @_;
    &SetCat($file, \%Cat); # Set %Cat
    my $n = 0;
    foreach my $c (sort keys %Cat) { $n++; print "$n : $c\n"; }
}

# Find the common categories that appear in both the training set and the test
# set, and then update the file with File_to_Categories information for later
# use.
sub Update {
    ($TrainFile, $TestFile) = @_; 
    &SetCat($TrainFile, \%TrainCat); # Set %TrainCat
    &SetCat($TestFile, \%TestCat); # Set %TestCat
    foreach $c (keys TrainCat, keys TestCat) {
    	$CommonCat{$c}++;
    } # Set %CommonCat, i.e., categories occur both in training and test set
    UpdateFile($TrainFile, \%CommonCat);
    UpdateFile($TestFile, \%CommonCat);
}

# Given 'train-cat.txt', write results to 'train-cat2.txt'
sub UpdateFile {
    my($File, $rComCat) = @_;
    my @Out = ();
    open T, $File or die "Cannot open: '$File', $!";
    while (<T>) {
    	chomp; next if /^\s*$|^#/;
    	@Cat = split /\t/, $_;
    	$f = shift @Cat; # shift out file id, leaving only categories
    	@C = ();
    	foreach $c (@Cat) { push @C, $c if $rComCat->{$c} == 2; }
print STDERR "$File:$f becomes no category\n" if @C==0;
    	push @Out, join ("\t", $f, @C) . "\n";
#	print join ("\t", $f, @C) . "\n";
    }
    close(T);
    $File =~ s/\.txt/2.txt/;
    print STDERR "Now write result to $File...\n";
    open T, ">$File" or die "Cannot open: '$File', $!";
    print T @Out;
    close(T);
}
