#/usr/bin/perl
#BAO1
#======
#Nom : KLJ
 #usage : perl bao&_script_JKL_2012.pl 2012
 #Le programme prend en entrée le nom du répertoire contenant les fichiers à traiter
 #Le programme construit en sortie un fichier structuré contenant sur chaque
 #ligne le nom du fichier et le résultat du filtrage :
#<FICHIER><NOM>du fichier</NOM></FICHIER><CONTENU>du filtrage</CONTENU></FICHIER>
#======

use XML::RSS;
use HTML::Entities;
use Unicode::String qw(utf8);
use Unicode::Normalize; #for deleting diacritics
use Time::Stopwatch;    #additionally installed

#-----------------------------------------------------------

#printing usage if no argument set
if (!$ARGV[0]){
  $0 =~ s/.*\\(.*)/$1/; #name of this script without path
  print "\nUSAGE:\nperl $0 <name of directory with xmls>\n";
  exit;
}

#-----------------------------------------------------------
#		READING ARGUMENTS, DECLARATION OF VARIABLES ...
#-----------------------------------------------------------

my $rep="$ARGV[0]"; #save argument of programme into variable
# on s'assure que le nom du répertoire ne se termine pas par un "/"
$rep=~ s/[\/]$//;
# on déclare les tableaux associatifs permettant de traiter la duplication des contenus
my %dicoTitre=(); #two empty hashes for saving info
my %dicoDescription=();

tie my $timer, 'Time::Stopwatch'; #start counting time

#-----------------------------------------------------------
#		CREATING EXPORT DIRECTORY AND DELETING IF EXISTS
#-----------------------------------------------------------

use File::Path;
my $path = './RESULTS_'.$rep;
rmtree($path);
mkdir($path);

#-----------------------------------------------------------
#		CALLING ...
#-----------------------------------------------------------

#recurse! #calls external programme #rep=2008
&parcoursarborescencefichiers($rep);	

#adding xml necessarities into created file (in RESULTS_yyyy directory)
add_header_footer_xml($path);

print "\n\n === DONE in $timer s ===\n"; #printing time

#===========================================================
#		SUBPROGRAM :: parcoursarborescencefichiers
#===========================================================

sub parcoursarborescencefichiers {

    my $path = shift(@_); #creates variable which contains the path
    opendir(DIR, $path) or die "can't open $path: $!\n"; #open child directory

    my @files = readdir(DIR); #read filenames in the directory and add into the list @files
    closedir(DIR);

    foreach my $file (@files) { #for each file we parse them
  		next if $file =~ /^\.\.?$/; #if file has extension
  		$file = $path."/".$file; #add to the pathname
  		
      if (-d $file) { #if it's a directory, get inside and run it again
  			&parcoursarborescencefichiers($file);	#recurse!
  		}
      
  		if (-f $file and -s $file > 0) { #if it's a file
  			 if ($file=~/0,2-3...,1-0,0\.xml$/) { 	#read the name of the xml file (every)
        #if ($file=~/0,2-32(08|10),1-0,0\.xml$/) { 	#read the name of the xml file (just some of them)
            print $file,"\n"; #print the name of the file
            export_xml($file); # run export subprogram
        }
  		}
	  }
}


#===========================================================
#		SUBPROGRAM :: export_xml
#===========================================================

sub export_xml {
# making SORTIE-file
# ARGUMENTS:  path of the file 

  my $file = $_[0];		#$_	temporary list saved as $file
  my $sortie; #new local variable
  my $path = "./RESULTS_".substr($file, 0,4); #path to extual result file (year readed from path of file) 

    my $rss = new XML::RSS; #run module
          $rss->parsefile($file); #parse the file - go inside and make a list of the tags ($item) inside
  				
          #reading category from title of xml, using function of xml:rss, lowercase
          my $category = nospace(lc(decode_entities($rss->channel(title)))); 
          $category =~ s/_?lemonde_fr_?//g; #no " - Lemonde.fr"
                              
          #browsing every tag inside tages <items>, so, not reading the header of xml (!)
          foreach my $item (@{$rss->{'items'}}) {
  				  
  					my $titre=decode_entities($item->{'title'});
  					my $description=decode_entities($item->{'description'});
             					
            #if we haven't read titre and description before
            if ((!(exists $dicoTitre{$titre})) and (!(exists $dicoDescription{$description}))){
  						$dicoTitre{$titre}=1; # key is titre, variable is 1

              my $output_xml=$path."/S-".$category.".xml"; # name of export file with path (temporary)
              my $output_txt=$path."/SORTIE-".$category.".txt"; # name of export file with path (temporary)

  						# save as xml (temporary - without header and footer of xml) 
              if (!open (XML,">>:encoding(UTF-8)",$output_xml)) { die "Pb a l'ouverture du fichier $output_xml"}; # >> adds
  						print XML "<item><titre>".$titre."</titre><description>".$description."</description></item>\n";
  						close XML;
              
              #save as plain text
              if (!open (TXT,">>:encoding(UTF-8)",$output_txt)) { die "Pb a l'ouverture du fichier $output_txt"}; # >> adds
  						print TXT $titre.". ".$description.".\n";
  						close TXT;		
  					}
  				}         
}

#===========================================================
#		SUBPROGRAM :: add_header_footer_xml
#===========================================================

sub add_header_footer_xml {
# printing footer of SORTIE-file
# ARGUMENTS: path

  #saving argument into $path
  $path = $_[0]."/";
  
  opendir(DIR, $path) or die "I cannot open dir: $!";
  
  #browsing opened directory and searching for *.xml files
  while (my $file = readdir(DIR)) { 
     next unless ($file =~ m/\.xml/);
     my $rubrique = substr($file,2,-4);
     
     #creating final export file
     open (SORTIE,">:encoding(UTF-8)",$path."SORTIE-".$rubrique.".xml") or die "Pb a l'ouverture du fichier $fi";
     
     #writing head of xml file     
     print SORTIE "<?xml version=\"1.0\" encoding=\"utf-8\" ?>\n";
     print SORTIE "<rubrique nom=\"".uc($rubrique)."\">\n";
    
     #pasting xml data (from temporary file)
     open (IN,"<:encoding(UTF-8)",$path.$file) or die "Pb a l'ouverture du fichier $fi";
     while ($line = <IN>){ #reading line by line
        print SORTIE $line; #printing every line (keeps formatting)
     }
     #closing temporary file
     close IN;
  
     #writing end of xml file
     print SORTIE "</rubrique>\n";
     close SORTIE;
     
     #deleting teporary S-category.xml
     unlink($path.$file);
   }
}

#===========================================================
#		SUBPROGRAM :: nospace
#===========================================================
# ARGUMENTS: string
# RETURNS: string without spaces and diacritics, all in lowercase

sub nospace
{
  my $s = $_[0];
	
  #REGEXP replacing: $string = =~ s/<what we are looking for>/<replaced by>/g; (in entire string)
  
  $s =~ s/\s//g; #no spaces
  $s =~ s/[,\.:-]/_/g; #replace "." or "," or ':' with "_"
  
  $s = NFD($s); #initializing module Normalize
  $s =~ s/\pM//g; #deleting diacritics
	
  return lc($s); #return lowercased 
}
