1. #!/usr/bin/perl
  2. use Unicode::String qw(utf8);
  3. use XML::XPath;
  4. use XML::LibXML;
  5. use Tk;
  6. use Tk::DropSite 'Win32';
  7. use Tk::Text;
  8.  
  9. my $mw = MainWindow->new( -background => '#E0F0FF', );
  10.  
  11. $mw->Label(
  12.   -text       => 'Script_RegExp : Faire un glisser-deposer du repertoire a traiter avec le script contenant des expressions regulieres',
  13.   -background => '#E0F0FF',
  14. )->pack(qw/ -side top -pady 2/);
  15.  
  16. my $widgetRegExp= $mw->Scrolled(
  17.   'Text',
  18.   -background => 'white',
  19.   -scrollbars => 'osoe',
  20.   -wrap       => 'none',
  21.   -height     => 7,
  22. )->pack(qw/ -side top -pady 2/);
  23.  
  24. $mw->Label(
  25.   -text       => 'Script_LibXml : Faire un glisser-deposer du repertoire a traiter avec le script utilisant le module XML::LibXML',
  26.   -background => '#E0F0FF',
  27. )->pack(qw/ -pady 2/);
  28.  
  29. my $widgetLibXml = $mw->Scrolled(
  30.   'Text',
  31.   -background => 'white',
  32.   -scrollbars => 'osoe',
  33.   -wrap       => 'none',
  34.   -height     => 7,
  35. )->pack(qw/ -pady 2 /);
  36.  
  37. $mw->Label(
  38.   -text       => 'Script_XmlXpath : Faire un glisser-deposer du repertoire a traiter avec le script utilisant le module XML::XPath',
  39.   -background => '#E0F0FF',
  40. )->pack(qw/ -pady 3/);
  41.  
  42. my $widgetXmlXpath = $mw->Scrolled(
  43.   'Text',
  44.   -background => 'white',
  45.   -scrollbars => 'osoe',
  46.   -wrap       => 'none',
  47.   -height     => 7,
  48. )->pack(qw/ -pady 3 /);
  49.  
  50.  
  51. # Conception du glisser-déposer
  52. $widgetRegExp->DropSite(
  53.   -dropcommand => [ \&ActionDrop_regexp, $widgetRegExp],
  54.   -droptypes   => 'Win32',
  55. );
  56. $widgetLibXml->DropSite(
  57.   -dropcommand => [ \&ActionDrop_libxml, $widgetLibXml],
  58.   -droptypes   => 'Win32',
  59. );
  60. $widgetXmlXpath->DropSite(
  61.   -dropcommand => [ \&ActionDrop_xpath, $widgetXmlXpath],
  62.   -droptypes   => 'Win32',
  63. );
  64. MainLoop;
  65.  
  66. sub ActionDrop_regexp {
  67.   my ( $widgetRegExp ) = @_;
  68.  
  69.   my $sel = $widgetRegExp->SelectionGet( -selection => 'CLIPBOARD' );
  70.   foreach my $fichier_rep ( split( /\n/, $sel ) ) {
  71.     $widgetRegExp->insert( 'end', "$fichier_rep\n" );
  72.     $widgetRegExp->SelectionOwn(-command=>&RegExp($fichier_rep));
  73.   }
  74.   return;
  75. }
  76.  
  77. sub ActionDrop_libxml {
  78.   my ( $widgetLibXml ) = @_;
  79.  
  80.   my $sel = $widgetLibXml->SelectionGet( -selection => 'CLIPBOARD' );
  81.   foreach my $fichier_rep ( split( /\n/, $sel ) ) {
  82.     $widgetLibXml->insert( 'end', "$fichier_rep\n" );
  83.     $widgetLibXml->SelectionOwn(-command=>&LibXml($fichier_rep));
  84.   }
  85.   return;
  86. }
  87.  
  88. sub ActionDrop_xpath {
  89.   my ( $widgetXmlXpath ) = @_;
  90.  
  91.   my $sel = $widgetXmlXpath->SelectionGet( -selection => 'CLIPBOARD' );
  92.   foreach my $fichier_rep ( split( /\n/, $sel ) ) {
  93.     $widgetXmlXpath->insert( 'end', "$fichier_rep\n" );
  94.     $widgetXmlXpath->SelectionOwn(-command=>&Xpath($fichier_rep));
  95.   }
  96.   return;
  97. }
  98.  
  99.  
  100. #################################################################
  101. #---------- RegExp ---------------------------------------------
  102. #################################################################
  103. sub RegExp {
  104. my $rep = $_[0] || '';
  105. $rep=~ s/[\/]$//;
  106.  
  107. my $dossier = $rep;
  108. $dossier =~ s/.+\\(.+)$/$1/;
  109.  
  110. mkdir("resultat_regxp_$dossier");
  111. mkdir("./resultat_regxp_$dossier/resultat");
  112. mkdir("./resultat_regxp_$dossier/cordial");
  113. mkdir("./resultat_regxp_$dossier/cordial/fichiers");
  114.  
  115. my %tabcontenu = ();
  116.  
  117. #-----------------------------------------------------------------
  118. &parcoursarborescencefichiers_RegExp($rep,$dossier);    #recurse!
  119. #------------------------------------------------------------------
  120.  
  121. $cheminrep ="./resultat_regxp_$dossier/resultat";
  122. opendir(DIRS,$cheminrep) or die "can't open $cheminrep: $!\n";
  123. my @files = readdir(DIRS);
  124. closedir(DIRS);
  125. foreach my $file(@files){
  126.     next if $file =~ /^\.\.?$/;
  127.             if($file =~/\.xml$/){
  128.                 open(OUT,">>:encoding(utf-8)","./resultat_regxp_$dossier/resultat/$file");
  129.                 print OUT "</file>\n";
  130.                 close(OUT);
  131.             }
  132.         if($file=~/\.txt$/){
  133.     open(IN,"<:encoding(utf8)","./resultat_regxp_$dossier/resultat/$file");
  134.     open (OUT4, ">:encoding(iso-8859-1)","./resultat_regxp_$dossier/cordial/iso_$file");
  135.     while(<IN>){
  136.          print OUT4 $_;
  137.     }
  138.         close (OUT4);
  139.         close (IN);
  140.     }
  141. }
  142.  
  143. my $methode = "regxp";
  144. $cordial="./resultat_regxp_$dossier/cordial";
  145. opendir(COR, $cordial) or die "can't open $path: $!\n";
  146. my @fics = readdir(COR);
  147. closedir(COR);
  148. foreach my $fich(@fics){
  149.     next if $fich =~ /^\.\.?$/;
  150.     &decoupe($fich,$dossier,$methode); # Procédure qui permet un fichier en plusieurs fichiers de 2Mo
  151. }
  152.  
  153. system("del texteaetiqueter.txt");
  154. system("del treetagger.txt");
  155. system("del treetagger.txt.xml");
  156.  
  157. $response = $mw->messageBox(-icon => 'info', -message => 'Extraction terminée !', -title => 'Extraction finie', -type => 'OK');
  158.  
  159. exit;
  160. }
  161.  
  162. sub parcoursarborescencefichiers_RegExp {
  163.     my $path = shift(@_);
  164.     my $dossier = shift(@_);
  165.    
  166.     opendir(DIR, $path) or die "can't open $path: $!\n";
  167.     my @files = readdir(DIR);
  168.     closedir(DIR);
  169.  
  170.     foreach my $file (@files) {
  171.         next if $file =~ /^\.\.?$/;
  172.         $file = $path."/".$file;
  173.         if (-d $file) {
  174.             &parcoursarborescencefichiers_RegExp($file);    #recurse!
  175.         }
  176.         if (-f $file) {
  177.             if(($file=~/\.xml$/) && ($file!~/\/fil.+\.xml$/) && ($file !~/0,2-3404,1-0,0\.xml$/)) {
  178.             my $rubrique="";
  179.             my $encodage = "";
  180.             my $encodagesortie="utf-8";
  181.             my $texte="";
  182.             if (-z $file) {
  183.                 print "$file est vide: pas de traitement\n";
  184.             }else{
  185.                     open(FIC,$file);
  186.                     while (my $ligne=<FIC>) {
  187.                     $ligne =~ s/\n//g;
  188.                     if($ligne =~/(iso-8859-1|utf-8)/ig){
  189.                         $encodage = $1;
  190.                     }
  191.                 }          
  192.                 close(FIC);
  193.            
  194.                 open(FILE,"<:encoding($encodage)",$file);
  195.                 while (my $ligne=<FILE>){
  196.                     $ligne =~ s/\n//g;
  197.                     $texte .= $ligne;
  198.                     }
  199.                  close(FILE);
  200.                     if ($texte=~/<channel><title>([^<]+)<\/title>/){
  201.                         $rubrique = $1;  
  202.                         $rubrique=~s/é/e/gi;
  203.                         $rubrique=~s/è/e/gi;
  204.                         $rubrique=~s/ê/e/gi;
  205.                         $rubrique=~s/à/a/gi;
  206.                         $rubrique=~s/es /e/i;
  207.                         $rubrique=~ s/Le ?Monde.fr ?://;
  208.                         $rubrique=~ s/ ?- ?Le ?Monde.fr//;
  209.                         $rubrique=~ s/es$/e/i;
  210.                         $rubrique=~ s/ //g;
  211.                         $rubrique=uc($rubrique);
  212.                     }
  213.                                
  214.                 if($rubrique eq ""){
  215.                     $rubrique = "non-classe";
  216.                 }  
  217.                
  218.                 open(OUT1,">>:encoding(utf-8)","./resultat_regxp_$dossier/resultat/$rubrique.txt");
  219.                 open(OUT2,">>:encoding(utf-8)","./resultat_regxp_$dossier/resultat/$rubrique.xml");
  220.                 open(OUT3,">>:encoding(utf-8)","./resultat_regxp_$dossier/resultat/$rubrique-treetagger.xml");
  221.                 if(-z OUT2){   
  222.                     print OUT2 "<?xml version=\"1.0\" encoding=\"$encodagesortie\" ?>\n";
  223.                     print OUT2 "<file>\n";
  224.                     print OUT2 "<name>$ARGV[0]</name>\n";
  225.                 }
  226.                     if(-z OUT3){   
  227.                     print OUT3 "<?xml version=\"1.0\" encoding=\"$encodagesortie\" ?>\n";
  228.                     print OUT3 "<file>\n";
  229.                     print OUT3 "<name>$ARGV[0]</name>\n";
  230.                 }
  231.                 $texte =~ s/> *</></g;
  232.                 $texte=~/<pubDate>([^<]+)<\/pubDate>/;
  233.                 my $date=$1;
  234.                 if (uc($encodage) ne "UTF-8") {utf8($date);}
  235.                 print OUT2 "<date>".$date."</date>\n";
  236.                 print OUT2 "<items>\n";
  237.                 print OUT3 "<date>".$date."</date>\n";
  238.                 print OUT3 "<items>\n";
  239.                 while ($texte =~ /<item><title>(.+?)<\/title>.+?<description>(.+?)<\/description>/g) {
  240.                     my $titre=$1;
  241.                     my $resume=$2;
  242.                     my $test = $titre;
  243.                     if(!exists $tabcontenu{$test}){
  244.                         if (uc($encodage) ne "UTF-8") {utf8($titre);utf8($resume);}
  245.                             $titre = &nettoietexte($titre);
  246.                             $resume = &nettoietexte($resume);
  247.                             my ($titreetiquete, $resumeetiquete) = &etiquetage ($titre, $resume);
  248.                             print OUT1 "Titre : $titre \n";
  249.                             print OUT1 "Resume : $resume \n";
  250.                             print OUT2 "<item><title>$titre</title><abstract>$resume</abstract></item>\n";
  251.                             print OUT3 "<item>\n<title>\n$titreetiquete</title>\n<abstract>\n$resumeetiquete</abstract>\n</item>\n";
  252.                             $tabcontenu{$test}++;
  253.                         }
  254.                     }
  255.                 print OUT2 "</items>\n";
  256.                 print OUT3 "</items>\n";
  257.                 close(OUT1);
  258.                 close(OUT2);
  259.                 close(OUT3);
  260.                 }
  261.             }
  262.         }
  263.     }
  264. }
  265.  
  266. #################################################################
  267. #---------- LibXml ---------------------------------------------
  268. #################################################################
  269. sub LibXml {
  270. my $rep = $_[0] || '';
  271. $rep=~ s/[\/]$//;
  272.  
  273. my $dossier = $rep;
  274. $dossier =~ s/.+\\(.+)$/$1/;
  275.  
  276. mkdir("resultat_libxml_$dossier");
  277. mkdir("./resultat_libxml_$dossier/resultat");
  278. mkdir("./resultat_libxml_$dossier/cordial");
  279. mkdir("./resultat_libxml_$dossier/cordial/fichiers");
  280.  
  281. my %tabcontenu = ();
  282.  
  283. #-----------------------------------------------------------------
  284. &parcoursarborescencefichiers_LibXml($rep,$dossier);    #recurse!
  285. #------------------------------------------------------------------
  286.  
  287. $cheminrep ="./resultat_libxml_$dossier/resultat";
  288. opendir(DIRS,$cheminrep) or die "can't open $cheminrep: $!\n";
  289. my @files = readdir(DIRS);
  290. closedir(DIRS);
  291. foreach my $file(@files){
  292.     next if $file =~ /^\.\.?$/;
  293.             if($file =~/\.xml$/){
  294.                 open(OUT,">>:encoding(utf-8)","./resultat_libxml_$dossier/resultat/$file");
  295.                 print OUT "</file>\n";
  296.                 close(OUT);
  297.             }
  298.         if($file=~/\.txt$/){
  299.     open(IN,"<:encoding(utf8)","./resultat_libxml_$dossier/resultat/$file");
  300.     open (OUT4, ">:encoding(iso-8859-1)","./resultat_libxml_$dossier/cordial/iso_$file");
  301.     while(<IN>){
  302.          print OUT4 $_;
  303.     }
  304.         close (OUT4);
  305.         close (IN);
  306.     }
  307. }
  308.  
  309. my $methode = "libxml";
  310. $cordial="./resultat_libxml_$dossier/cordial";
  311. opendir(COR, $cordial) or die "can't open $path: $!\n";
  312. my @fics = readdir(COR);
  313. closedir(COR);
  314. foreach my $fich(@fics){
  315.     next if $fich =~ /^\.\.?$/;
  316.     &decoupe($fich,$dossier,$methode); # Procédure qui permet un fichier en plusieurs fichiers de 2Mo
  317. }
  318.  
  319. system("del texteaetiqueter.txt");
  320. system("del treetagger.txt");
  321. system("del treetagger.txt.xml");
  322.  
  323. $response = $mw->messageBox(-icon => 'info', -message => 'Extraction terminée !', -title => 'Extraction finie', -type => 'OK');
  324.  
  325. exit;
  326. }
  327.  
  328. sub parcoursarborescencefichiers_LibXml {
  329.     my $path = shift(@_);
  330.     my $dossier = shift(@_);
  331.    
  332.     opendir(DIR, $path) or die "can't open $path: $!\n";
  333.     my @files = readdir(DIR);
  334.     closedir(DIR);
  335.     foreach my $file (@files) {
  336.         next if $file =~ /^\.\.?$/;
  337.         $file = $path."/".$file;
  338.         if (-d $file) {
  339.             &parcoursarborescencefichiers_LibXml($file);    #recurse!
  340.         }
  341.         if (-f $file) {
  342.             if(($file=~/\.xml$/) && ($file!~/\/fil.+\.xml$/) && ($file !~/0,2-3404,1-0,0\.xml$/)){
  343.             my $encodage = "";
  344.             my $encodagesortie="utf-8";
  345.             my $texte="";
  346.             if(-z $file){
  347.                 print "$file est vide pas de traitement\n";
  348.             }else{
  349.                 open(FIC,$file);
  350.                 while (my $ligne=<FIC>) {
  351.                     $ligne =~ s/\n//g;
  352.                     if($ligne =~/(iso-8859-1|utf-8)/ig){
  353.                         $encodage = $1;
  354.                     }
  355.                 }
  356.                 close(FIC);
  357.                 open(FILE,"<:encoding($encodage)", $file);
  358.                 my $texte="";
  359.                 while (my $ligne=<FILE>) {
  360.                     $ligne =~ s/\n//g;
  361.                     $ligne =~ s/\r//g;
  362.                     $texte .= $ligne;
  363.                    
  364.                 }
  365.                 close(FILE);
  366.                
  367.                 if($texte =~/<channel><title>([^<]+)<\/title>/ig){
  368.                     $rubrique = $1;
  369.                     $rubrique=~s/é/e/gi;
  370.                     $rubrique=~s/è/e/gi;
  371.                     $rubrique=~s/ê/e/gi;
  372.                     $rubrique=~s/à/a/gi;
  373.                     $rubrique=~ s/Le ?Monde.fr ?://;
  374.                     $rubrique=~s/ ?- ?Le ?Monde\.fr//;
  375.                     $rubrique=~s/es$/e/i;
  376.                     $rubrique=~ s/ //g;
  377.                     $rubrique=uc($rubrique);
  378.                 }
  379.                                
  380.                 if($rubrique eq ""){
  381.                     $rubrique = "NONCLASSE";
  382.                 }
  383.                 open(OUT1,">>:encoding(utf-8)","./resultat_libxml_$dossier/resultat/$rubrique.txt");
  384.                 open(OUT2,">>:encoding(utf-8)","./resultat_libxml_$dossier/resultat/$rubrique.xml");
  385.                 open(OUT3,">>:encoding(utf-8)","./resultat_libxml_$dossier/resultat/$rubrique-treetagger.xml");
  386.                 if(-z OUT2){
  387.                     print OUT2 "<?xml version=\"1.0\" encoding=\"$encodagesortie\" ?>\n";
  388.                     print OUT2 "<file>\n";
  389.                     print OUT2 "<name>$ARGV[0]</name>\n";
  390.                 }
  391.                     if(-z OUT3){   
  392.                     print OUT3 "<?xml version=\"1.0\" encoding=\"$encodagesortie\" ?>\n";
  393.                     print OUT3 "<file>\n";
  394.                     print OUT3 "<name>$ARGV[0]</name>\n";
  395.                 }
  396.                 print OUT2 "<items>\n";
  397.                 print OUT3 "<items>\n";
  398.            
  399.                 my $input_file= $file;
  400.                 my $parser = XML::LibXML->new();
  401.                 my $xp = $parser->parse_file($input_file);
  402.                 my $date = "";
  403.                 foreach my $noeud_date ( $xp->findnodes('//channel')->get_nodelist ) {
  404.                     $date=$noeud_date->findnodes('//pubDate')->string_value;
  405.                     if (uc($encodage) ne "UTF-8") {utf8($date);}
  406.                 }
  407.                 print OUT2 "<date>$date</date>\n";
  408.                 print OUT3 "<date>\n$date</date>\n";
  409.                
  410.                 foreach my $noeud ( $xp->findnodes('//item')->get_nodelist ) {
  411.                     my $titre=$noeud->findnodes('title')->string_value;
  412.                     my $resume=$noeud->findnodes('description')->string_value;             
  413.                     my $test=$titre;
  414.                     if(!exists $tabcontenu{$test}){
  415.                         if (uc($encodage) ne "UTF-8") {utf8($titre);utf8($resume);}
  416.                         $titre=&nettoietexte($titre);
  417.                         $resume=&nettoietexte($resume);
  418.                         my ($titreetiquete, $resumeetiquete) = &etiquetage ($titre, $resume);
  419.  
  420.                         print OUT1 "Titre : $titre \n";
  421.                         print OUT1 "Resume : $resume \n";
  422.                         print OUT2 "<item><title>$titre</title><abstract>$resume</abstract></item>\n";
  423.                         print OUT3 "<item>\n<title>\n$titreetiquete</title>\n<abstract>\n$resumeetiquete</abstract>\n</item>\n";
  424.  
  425.                         $tabcontenu{$test}++;
  426.                     }
  427.                 }
  428.                 print OUT2 "</items>\n";
  429.                 print OUT3 "</items>\n";
  430.                 close(OUT1);
  431.                 close(OUT2);
  432.                 close(OUT3)
  433.             }
  434.         }
  435.         }
  436.     }
  437. }
  438.  
  439.  
  440. #################################################################
  441. #---------- Xpath ---------------------------------------------
  442. #################################################################
  443. sub Xpath {
  444. my $rep = $_[0] || '';
  445. $rep=~ s/[\/]$//;
  446.  
  447. my $dossier = $rep;
  448. $dossier =~ s/.+\\(.+)$/$1/;
  449.  
  450. mkdir("resultat_xpath_$dossier");
  451. mkdir("./resultat_xpath_$dossier/resultat");
  452. mkdir("./resultat_xpath_$dossier/cordial");
  453. mkdir("./resultat_xpath_$dossier/cordial/fichiers");
  454.  
  455. my %tabcontenu = ();
  456.  
  457. #-----------------------------------------------------------------
  458. &parcoursarborescencefichiers_Xpath($rep,$dossier); #recurse!
  459. #------------------------------------------------------------------
  460.  
  461. $cheminrep ="./resultat_xpath_$dossier/resultat";
  462. opendir(DIRS,$cheminrep) or die "can't open $cheminrep: $!\n";
  463. my @files = readdir(DIRS);
  464. closedir(DIRS);
  465. foreach my $file(@files){
  466.     next if $file =~ /^\.\.?$/;
  467.             if($file =~/\.xml$/){
  468.                 open(OUT,">>:encoding(utf-8)","./resultat_xpath_$dossier/resultat/$file");
  469.                 print OUT "</file>\n";
  470.                 close(OUT);
  471.             }
  472.         if($file=~/\.txt$/){
  473.     open(IN,"<:encoding(utf8)","./resultat_xpath_$dossier/resultat/$file");
  474.     open (OUT4, ">:encoding(iso-8859-1)","./resultat_xpath_$dossier/cordial/iso_$file");
  475.     while(<IN>){
  476.          print OUT4 $_;
  477.     }
  478.         close (OUT4);
  479.         close (IN);
  480.     }
  481. }
  482.  
  483. my $methode = "xpath";
  484. $cordial="./resultat_xpath_$dossier/cordial";
  485. opendir(COR, $cordial) or die "can't open $path: $!\n";
  486. my @fics = readdir(COR);
  487. closedir(COR);
  488. foreach my $fich(@fics){
  489.     next if $fich =~ /^\.\.?$/;
  490.     &decoupe($fich,$dossier,$methode); # Procédure qui permet un fichier en plusieurs fichiers de 2Mo
  491. }
  492.  
  493. system("del texteaetiqueter.txt");
  494. system("del treetagger.txt");
  495. system("del treetagger.txt.xml");
  496.  
  497. $response = $mw->messageBox(-icon => 'info', -message => 'Extraction terminée !', -title => 'Extraction finie', -type => 'OK');
  498.  
  499. exit;
  500. }
  501.  
  502. sub parcoursarborescencefichiers_Xpath {
  503.     my $path = shift(@_);
  504.     my $dossier = shift(@_);
  505.    
  506.     opendir(DIR, $path) or die "can't open $path: $!\n";
  507.     my @files = readdir(DIR);
  508.     closedir(DIR);
  509.     foreach my $file (@files) {
  510.         next if $file =~ /^\.\.?$/;
  511.         $file = $path."/".$file;
  512.         if (-d $file) {
  513.             &parcoursarborescencefichiers_Xpath($file); #recurse!
  514.         }
  515.         if (-f $file) {
  516.             if(($file=~/\.xml$/) && ($file!~/\/fil.+\.xml$/) && ($file !~/0,2-3404,1-0,0\.xml$/)){
  517.             my $encodage = "";
  518.             my $encodagesortie="utf-8";
  519.             my $texte="";
  520.            
  521.             if(-z $file){
  522.                 print "$file est vide pas de traitement\n";
  523.             }else{
  524.                 open(FIC,$file);
  525.                 while (my $ligne=<FIC>) {
  526.                     $ligne =~ s/\n//g;
  527.                     if($ligne =~/(iso-8859-1|utf-8)/ig){
  528.                         $encodage = $1;
  529.                     }
  530.                 }
  531.                 close(FIC);
  532.                 #-----------------------------------------------------------
  533.                 open(FILE,"<:encoding($encodage)", $file);
  534.                 my $texte="";
  535.                 while (my $ligne=<FILE>) {
  536.                     $ligne =~ s/\n//g;
  537.                     $ligne =~ s/\r//g;
  538.                      $texte .= $ligne;
  539.                    
  540.                 }
  541.                
  542.                     if($texte =~/<channel><title>([^<]+)<\/title>/ig){
  543.                         $rubrique = $1;
  544.                         $rubrique=~s/é/e/gi;
  545.                         $rubrique=~s/è/e/gi;
  546.                         $rubrique=~s/ê/e/gi;
  547.                         $rubrique=~s/à/a/gi;
  548.                         $rubrique=~ s/Le ?Monde.fr ?://;
  549.                         $rubrique=~s/ ?- ?Le ?Monde\.fr//;
  550.                         $rubrique=~s/es$/e/i;
  551.                         $rubrique=~ s/ //g;
  552.                         $rubrique=uc($rubrique);
  553.                     }
  554.                
  555.                 close(FILE);
  556.                 if($rubrique eq ""){
  557.                     $rubrique = "NONCLASSE";
  558.                 }
  559.                
  560.                 #-----------------------------------------------------------
  561.                 open(OUT1,">>:encoding(utf-8)","./resultat_xpath_$dossier/resultat/$rubrique.txt");
  562.                 open(OUT2,">>:encoding(utf-8)","./resultat_xpath_$dossier/resultat/$rubrique.xml");
  563.                 open(OUT3,">>:encoding(utf-8)","./resultat_xpath_$dossier/resultat/$rubrique-treetagger.xml");
  564.                 if(-z OUT2){
  565.                     print OUT2 "<?xml version=\"1.0\" encoding=\"$encodagesortie\" ?>\n";
  566.                     print OUT2 "<file>\n";
  567.                     print OUT2 "<name>$ARGV[0]</name>\n";
  568.                 }
  569.                     if(-z OUT3){   
  570.                     print OUT3 "<?xml version=\"1.0\" encoding=\"$encodagesortie\" ?>\n";
  571.                     print OUT3 "<file>\n";
  572.                     print OUT3 "<name>$ARGV[0]</name>\n";
  573.                 }
  574.                 #-----------------------------------------------------------
  575.                 print OUT2 "<items>\n";
  576.                 print OUT3 "<items>\n";
  577.                 my $input_file= $file;
  578.                 my $xp = XML::XPath->new( filename => $input_file ) or die "big trouble";
  579.                 my $date = "";
  580.                 my $date_path="//channel";
  581.                 foreach my $date_noeud ( $xp->find($date_path)->get_nodelist ) {
  582.                     $date=$date_noeud->find('pubDate')->string_value;
  583.                 }
  584.                 print OUT2 "<date>$date</date>\n";
  585.                 print OUT3 "<date>\n$date</date>\n";
  586.                 my $search_path.="//item";
  587.                 foreach my $noeud ( $xp->find($search_path)->get_nodelist ) {
  588.                     my $titre=$noeud->find('title')->string_value;
  589.                     my $resume=$noeud->find('description')->string_value;
  590.                     $titre=&nettoietexte($titre);
  591.                     $resume=&nettoietexte($resume);
  592.                     my $test=$titre;
  593.                     if (uc($encodage) ne "UTF-8") {utf8($titre);utf8($resume);}
  594.                     if(!exists $tabcontenu{$test}){
  595.                             my ($titreetiquete, $resumeetiquete) = &etiquetage ($titre, $resume);
  596.                             print OUT1 "Titre : $titre \n";
  597.                             print OUT1 "Resume : $resume \n";
  598.                             print OUT2 "<item><title>$titre</title><abstract>$resume</abstract></item>\n";
  599.                             print OUT3 "<item>\n<title>\n$titreetiquete</title>\n<abstract>\n$resumeetiquete</abstract>\n</item>\n";
  600.                             $tabcontenu{$test}++;
  601.                     }
  602.                 }
  603.                 print OUT2 "</items>\n";
  604.                 print OUT3 "</items>\n";
  605.                 close(OUT1);
  606.                 close(OUT2);
  607.                 close(OUT3);
  608.             }
  609.         }
  610.         }
  611.     }
  612. }
  613.  
  614.  
  615. #################################################################
  616. #---------- Tree-Tagger -----------------------------------------
  617. #################################################################
  618. sub etiquetage($titre, $resume) {
  619.     my ($titre, $resume) = @_;
  620.     my $tmptag="texteaetiqueter.txt";
  621.     open (TMPFILE,">:encoding(utf-8)", $tmptag);
  622.     print TMPFILE $titre,"\n";
  623.     close(TMPFILE);
  624.     my $tokenisefr = "\"./tree-tagger/tokenise-fr\"";
  625.     my $treetaggerexe = "\"./tree-tagger/tree-tagger\"";
  626.     my $treetagger2xml = "\"./tree-tagger/treetagger2xml\"";
  627.     system("$tokenisefr $tmptag | $treetaggerexe ./tree-tagger/french-utf8.par -lemma -token -no-unknown -sgml > treetagger.txt");
  628.     system("$treetagger2xml treetagger.txt utf-8");
  629.     # lecture du resultat tagge en xml :
  630.     open(OUT,"<:encoding(utf-8)","treetagger.txt.xml");
  631.     my $firstline=<OUT>;
  632.     my $titreetiquete="";
  633.     while (my $l=<OUT>) {
  634.        $titreetiquete.=$l;
  635.     }
  636.     close(OUT);
  637.     #----- le resume
  638.     open (TMPFILE,">:encoding(utf-8)", $tmptag);
  639.     print TMPFILE $resume,"\n";
  640.     close(TMPFILE);
  641.     system("$tokenisefr $tmptag | $treetaggerexe ./tree-tagger/french-utf8.par -lemma -token -no-unknown -sgml > treetagger.txt");
  642.     system("$treetagger2xml treetagger.txt utf-8");
  643.     # lecture du resultat tagge en xml :
  644.     open(OUT,"treetagger.txt.xml");
  645.     my $firstline=<OUT>;
  646.     my $resumeetiquete="";
  647.     while (my $l=<OUT>) {
  648.        $resumeetiquete.=$l;
  649.     }
  650.     close(OUT);
  651.     # on renvoie les resultats :
  652.     return ($titreetiquete,$resumeetiquete);
  653. }
  654.  
  655. #################################################################
  656. #---------- NettoieTexte ---------------------------------------
  657. #################################################################
  658. sub nettoietexte {
  659.     my $texte=shift;
  660.     $texte =~ s/&lt;/</g;
  661.     $texte =~ s/&gt;/>/g;
  662.     $texte =~ s/<a href[^>]+>//g;
  663.     $texte =~ s/<img[^>]+>//g;
  664.     $texte =~ s/<\/a>//g;
  665.     $texte =~ s/&#38;#39;/'/g;
  666.     $texte =~ s/&#38;#34;/"/g;
  667.     $texte =~ s/&#233;/é/g;
  668.     $texte =~ s/&#234;/ê/g;
  669.     $texte =~ s/<[^>]+>//g;
  670.     $texte =~ s/&nbsp;/ /g;
  671.     $texte=~s/&#39;/'/g;
  672.     $texte=~s/&#34;/"/g;
  673.     $texte=~s/&amp;#39;/'/g;
  674.     $texte=~s/&amp;#34;/"/g;
  675.     return $texte;
  676. }
  677.  
  678. #################################################################
  679. #---------- Decoupe pour Cordial --------------------------------
  680. #################################################################
  681. sub decoupe{
  682. my $fichier = shift(@_);
  683. my $dossier = shift(@_);
  684. my $methode = shift(@_);
  685. my $chemin = "./resultat_$methode";
  686. $chemin .= "_$dossier/cordial";
  687. open(F,"$chemin/$fichier");
  688. my $num = 1;
  689. my $taille = 0;
  690. while($ligne = <F>) {
  691.     if($taille < 2000){ # On veut des fichiers de 2Mo = 2000000 octets
  692.     open (OUT,">>$chemin/fichiers/$fichier".$num.".txt");
  693.     print OUT $ligne;
  694.     $taille = -s OUT;
  695.     close(OUT);
  696.     }else{
  697.      $num++;
  698.      $taille = 0;
  699.     }
  700. }
  701. close (F);
  702. }
  703.  
  704.  
  705.