L’attractivité de l'économie de la Birmanie

Le script PERL

Télécharcher le script

making it better:

  • make more independent subprograms (html_table is bit messy, but I bit lazy to do it now)
  • reading the keywords from a file or standard input from user (60)
  • maybe using references in perl it will be whole faster
  • ...

problems and solutions:

  •  (60) keyword in burmese have should be in this format: "x{1005}\x{102E}\x{1038}\x{1015}\x{103C}\x{102C}\x{1038}\x{1031}\x{101B}\x{1038}" not as "\xe1\x80\x85\xe1\x80\xae\xe1\x80\xb8\xe1\x80\x95\xe1\x80\xbc
  • \xe1\x80"(which was used in bash file) I'm not that sure why, but probably because I'm reading files as utf8, but I'm not sure. But anyway, like this it works prefectely.
  • I've got a typic problem with encoding, but I think it's more than good resolved using two modules in perl (Decode and Guess) and after all converting html entities into utf-8 (using Entities)
  • if a link is not downloaded its skipped and program pass onto next one
  • there are some cases when occurence wasn't find in dumped filed, it's caused probably by bad stuction of webpage (link inside link or too dynamic content, I don't know) usually is downloaded just title of page

Code source Comments
  1. #!/usr/bin/perl
  2. #use warnings;

  4. use LWP::Simple;
  5. use Encode;
  6. require Encode::Detect;
  7. use Encode::Guess;
  8. use Data::Dumper;
  9. use Time::Stopwatch;
  10. use HTML::TreeBuilder;
  11. use HTML::Entities;

  13. mkdir("../CONTEXTS");
  14. mkdir("../DUMP_TEXT");
  15. mkdir("../IMAGES");
  16. mkdir("../PAGES_ASPIREES");
  17. mkdir("../TABLEAUX");

  19. opendir(DIR, "../URLS") or die "I cannot open dir: $!";
  20. open(ERROR,">:utf8","error_reading_url.txt") or die "I'm not able to open a file.";

  22. print "\noperation started:\n";

  24. while (my $file = readdir(DIR)) { #open directory with urls
  25.         next unless ($file =~ m/\.txt$/); #open each file.txt
  26.         print "\n-> processing urls (".$file.")";
  27.         tie my $timer, 'Time::Stopwatch';
  28.         html_table($file);                #processing html file
  29.       print "\n    done in $timer s";
  30.      
  31.     }
  32.    
  33. close DIR;
  34. close ERROR;

  36. print "\n-> dumping results together";

  38. dump_globaux();
  39. dump_globaux_context();
  40. tabs_globaux();

  42. print "\n\nsuccesfully done\n";
  43. print "(list of wrong urls here: error_reading_url.txt)\n";

  45. ##################################################
  46. # SUBPROGRAMS                                    #
  47. ##################################################

  49. sub html_table {
  50. # create a html-table with urls and downloaded links
  51. # ARGUMENTS: file
  53.     my $file=$_[0];
  54.     my $lang=substr($file,0,-4);
  55.        my $n=1;
  56.     my $nf=0;
  57.     my $occurences;
  58.    
  59.     my %motivy = ("allemand" => "inve[rs]t", "anglais" => "inve[rs]t", "espagnol" => "inve[rs]t", "francais" => "invest", "myanmar" => "\x{1005}\x{102E}\x{1038}\x{1015}\x{103C}\x{102C}\x{1038}\x{1031}\x{101B}\x{1038}", "norvegien" => "invest", "tcheque" => "invest");
  60.     
  61.     my $motif = $motivy{$lang};  #searched word
  62.    
  63.     open(INPUT,"<:utf8","../URLS/".$file) or die "I'm not able to open a file.";  #open file with urls
  64.     open(EXP,">:utf8","../TABLEAUX/".$lang.".html") or die "I'm not able to open a file."; #create html file named by language
  65.     mkdir("../PAGES_ASPIREES/".$lang); #create directory for downloaded pages
  66.     mkdir("../DUMP_TEXT/".$lang); #create directory for dumped pages
  67.    
  68.     print EXP "<html>\n\n<head>\n<meta http-equiv=\"Content-Type\" content=\"text/htm;charset=utf-8\">\n<title>$lang</title>\n</head>\n\n<body bgcolor=\"#003\">\n\n<table align=\"center\" border=\"1\">\n<tr align=\"center\" bgcolor=\"#D2E6FF\"><td width=\"20px\"><b>n&deg</b></td><td><b>URL</b></td><td width=\"90px\"><b>PAGES<br>ASPIREES</b></td><td width=\"100px\"><b>DUMP initial</b></td><td width=\"100px\"><b>DUMP utf-8</b></td><td width=\"100px\"><b>CONTEXTE utf-8</b><br>motif: <blue>$motif</blue></td><td width=\"100px\"><b>CONTEXTE HTML</b><br>motif: <blue>$motif</blue></td><td width=\"60px\"><b>OCCS</b></td></tr>\n";
  70.     while(<INPUT>) {  
  71.     #reading each url file and processing it
  72.            chomp($_);
  73.            my $url=$_;
  74.           
  75.            $tmp=substr($_,0, 30);
  76.           
  77.            my $charset = download_html($_,$lang,$n); #download and charset
  78.                              
  79.            my $occs = context_txt_html($n,$lang,$motif);
  80.            $occurences = $occurences + $occs;
  81.             
  82.            if ($charset ne "not downloaded") {
  83.            #if page is not downloaded: row in table is not created, file is owerwrited by next successfully downloaded page
  84.          
  85.                 print EXP "<tr align=\"center\" bgcolor=\"#D2E6FF\"><td>$n</td><td><a href=\"$url\">$tmp</a></td><td><a href=\"../PAGES_ASPIREES/$lang/$n.html\">$n.html</a></td><td>";
  86.                 if ($charset ne "UTF-8" or $charset ne "utf8") {
  87.                     print EXP "<a href=\"../DUMP_TEXT/$lang/$n.txt\">$n.txt</a><br><small>($charset)</small>";
  88.                 } 
  89.                
  90.                 print EXP "</td><td><a href=\"../DUMP_TEXT/$lang/$n-utf8.txt\">$n-utf8.txt</a></td>";
  91.                
  92.                 if ($occs != 0) {
  93.                     print EXP "<td><a href=\"../CONTEXTS/$lang/$n-utf8.txt\">$n-utf8.txt</a></td><td><a href=\"../CONTEXTS/$lang/$n-utf8.html\">$n-utf8.html</a></td><td>$occs</td></tr>\n";
  94.                     $nf++;
  95.                    
  96.                 }               
  97.                 else{
  98.                     print EXP "<td bgcolor=\"#B0C4DE\">not found</td><td bgcolor=\"#B0C4DE\">not found</td><td bgcolor=\"#B0C4DE\">$occs</td></tr>\n";
  99.                 }
  100.                
  101.                 $n++;
  102.              
  103.               #svetlejsi #D2E6FF
  104.               #tmavsi    #B0C4DE
  105.              
  106.           }     
  107.       }
  108.     
  109.    print EXP "<tr align=\"center\" bgcolor=\"#B0C4DE\"><td></td><td></td><td></td><td></td><td></td><td bgcolor=\"#D2E6FF\"><a href=\"../FICHIERGLOBAUX/DUMP-GLOBAUX_$lang.txt\">Fichier DUMP global</a><br><small>$nf fichier(s)</small></td><td bgcolor=\"#D2E6FF\"><a href=\"../FICHIERGLOBAUX/CONTEXTES-GLOBAUX_$lang.txt\">Fichier CONTEXTES global</a><br><small>$nf fichier(s)</small></td><td bgcolor=\"#D2E6FF\"><b>$occurences</b></td></tr>\n";
  110.    print EXP "</table>\n\n</body></html>";
  111.   
  112.    close INPUT;
  113.    close EXP;
  114.   
  115. }
  117. sub download_html {
  118. # download each html file which got from url and return its encoding
  119. # ARGUMENTS: url, language, number
  120. # RETURNS: encoding
  122.     my $content = get($_[0]) or print ERROR $_[2]."\t".$_[1]."\t".$_[0]."\n";  #download of content of url
  123.     my $enc;
  124.    
  125.     if ($content) {
  126.     #saving of html file and getting encoding
  127.          
  128.           open(S,">:utf8","../PAGES_ASPIREES/".$_[1]."/".$_[2].".html") or die "I'm not able to open a file.";
  129.           print S $content; #saved to file
  130.           close S;
  131.          
  132.           $enc= Encode::Detect::Detector::detect($content);   #getting encoding
  133.        
  134.           if ($enc eq "") {   #guessing encoding
  135.                     $x = Dumper(guess_encoding($content)->name);
  136.                 $x =~ /\'(.*)\'/;
  137.                 $enc = $1;
  138.           }
  139.          
  140.           txt_save($content,$_[1],$_[2],$enc);
  141.           #dumping file (utf8 and if necessary originall)     
  142.     }
  143.        
  144.     else {
  145.         $enc = "not downloaded";
  146.     }
  147.    
  148.     return $enc; #returns encoding
  149.        
  150. }
  152. sub txt_save {
  153. # saves a dumped text
  154. # ARGUMENTS: html-content, language, number, charset                   
  155.    
  156.     open(TXTU,">:utf8","../DUMP_TEXT/".$_[1]."/".$_[2]."-utf8.txt") or die "I'm not able to create dumped txt-utf8 file.";
  157.    
  158.     if ($_[3] ne "UTF-8" and $_[3] ne "utf8") {
  159.     #non utf-8 => save and convert
  160.         open(TXT,">:utf8","../DUMP_TEXT/".$_[1]."/".$_[2].".txt") or die "I'm not able to create dumped txt file.";   
  161.         print TXT delete_html($_[0]);
  162.         $_[0]= decode($_[3], $_[0] );   
  163.     }
  164.    
  165.     print TXTU decode_entities(delete_html($_[0]));
  166.    
  167.     close TXTU;            
  168. }
  170. sub delete_html{
  171. # delete every html tag
  172. # ARGUMENTS: html-content
  173. # RETURNS: content-without-html
  174.     my $tree = HTML::TreeBuilder->new;
  175.     $tree->parse($_[0]);
  176.     $non_html = $tree->as_text();
  177.     return $non_html;
  178. }
  180. sub context_txt_html {
  181. # finds a KWIC and print it into TXT, HTML
  182. # ARGUMENTS: number, language, motif
  183. # RETURNS: number-of-occurence
  184.     my $n=$_[0];
  185.     my $lang=$_[1];
  186.     my $motif=$_[2];
  187.     my $context=200;
  188.     my $x = 0;
  189.    
  190.     #print "\ncislo souboru: $n\tjazyk: $lang\tmotiv: $motif";
  191.    
  192.     mkdir("../CONTEXTS/".$lang); #create directory for contexts
  193.     #print "\nadresar vytvoren";
  194.     open(UTF_TXT,"<:utf8","../DUMP_TEXT/".$lang."/".$n."-utf8.txt"); #or print "\n\tI'm not able to read dumped file $n-utf.8.txt, but I keep working, you don't need to be worry about."; #pokud problem, tak smazat ten posledni konstrukt
  195.     open(CONT_TXT,">:utf8","../CONTEXTS/".$lang."/".$n."-utf8.txt") or die "I'm not able to create context $n-utf.8.txt.";
  196.     open(CONT_HTML,">:utf8","../CONTEXTS/".$lang."/".$n."-utf8.html") or die "I'm not able to create context $n-utf.8.html.";
  197.    
  198.     #print "\nsoubory otevreny";
  199.    
  200.     print CONT_HTML "<html>\n<head>\n<title>minigrep : $motif ($lang)</title>\n";
  201.     print CONT_HTML "<meta http-equiv=\"Content-Type\" content=\"text/html; charset=utf8\" />\n";
  202.     print CONT_HTML "<body bgcolor=\"white\">\n";
  203.     print CONT_HTML "<p align=\"justify\"><b>Input file :</b> $n-utf.txt<br>\n";
  204.     print CONT_HTML "<b>KeyWord :</b> $motif<br>\n";
  205.     print CONT_HTML "<b>Language :</b> $lang<br>\n";
  206.     print CONT_HTML "<b>Number of context-characters :</b> +- $context</p>\n<hr><hr>\n";
  207.    
  208.     print CONT_TXT "LEFT CONTEXT\tKEY-WORD\tRIGHT CONTEXT\n";
  209.    
  210.     #print "\nposledni radka vytisknuta, samotne zpracovani UTF_TXT";
  211.    
  212.     while(<UTF_TXT>) {  
  213.         chomp($_);
  214.  
  215.         #print "oriznuto";
  216.                
  217.         while ($_ =~/($motif[^ ]*)/gi) {
  218.        
  219.         #searching for keyword
  220.              
  221.             #print "motiv nalezen";
  222.            
  223.             $x++;
  224.             my $cl = $context;
  225.             my $cr = $context;
  226.            
  227.             my $motif_ok= $1;        #potřebuju to tam?
  228.             my $left = $`;           #potřeba vypsat jenom xy znaků před a po keyword
  229.             my $right = $';
  230.            
  231.             ### left context
  232.             if (length($left)>$cl) {
  233.                 until (substr($left,-$cl-1,1) eq " ") {   #gets first whole word in a row
  234.                    $cl=$cl-1;
  235.                 }
  236.                 $left = substr($left,-$cl,$cl);      #print xy first characters, beging with whole word
  237.             }
  238.            
  239.             ### right context
  240.             if (length($right)>$cr) {
  241.               until (substr($right,$cr+1,1) eq " ") {
  242.                 $cr=$cr-1;
  243.               }
  244.               $right = substr($right,0,$cr);
  245.             }
  246.            
  247.             ### printing
  248.             print CONT_TXT $left."\t".$motif_ok."\t".$right."\n"; 
  249.             print CONT_HTML "<p align=\"justify\">$left<font style=\"background-color: #FC3;\"><b>$motif_ok</b></font>$right</p>\n<hr>\n";
  250.            
  251.             }
  252.        
  253.         print CONT_HTML "</body></html>\n";
  254.         close CONT_TXT;
  255.         close CONT_HTML;
  256.         close UTF_TXT;
  257.     }
  258.     if ($x == 0){
  259.       unlink("../CONTEXTS/".$lang."/".$n."-utf8.txt");
  260.       unlink("../CONTEXTS/".$lang."/".$n."-utf8.html");
  261.     }
  262.     return $x;
  263. }
  265. sub dump_globaux {
  266. #makes global dumped file (from DUMP_TEXT) for every language (directory), containg every dumped file, saves into created file FISCHIERGLOBAUX
  267.   mkdir("../FICHIERGLOBAUX/");
  268.   opendir(DIR, "../DUMP_TEXT") or die "I cannot open dir: $!";
  269.  
  270.   while (my $dir = readdir(DIR)) { #open directory with urls
  271.      next unless ($dir !~ m/\./);
  272.           
  273.      opendir(DIRE, "../DUMP_TEXT/".$dir) or die "I cannot open dir: $!";
  274.      open(DUMP,">:utf8","../FICHIERGLOBAUX/DUMP-GLOBAUX_".$dir.".txt") or die "I'm not able to create dump_globaux for $dir.";
  275.        
  276.         while (my $file = readdir(DIRE)) { #open directory with urls
  277.            next unless ($file =~ m/\.txt$/);
  278.                         
  279.            open(INPUT,"<:utf8","../DUMP_TEXT/".$dir."/".$file) or die "I'm not able to open a file $file in directory $dir.";
  280.            while(<INPUT>) {
  281.               print DUMP $_;
  282.            }
  283.           
  284.            close INPUT;
  285.        
  286.         }
  287.     closedir DIRE;
  288.     close DUMP;
  289.          
  290.   }
  291.  
  292.   closedir DIR;
  293. }
  295. sub dump_globaux_context {
  296. #makes global dumped file (from CONTEXTS) for every language (directory), containg every context-file (whithout headder), saves into FISCHIERGLOBAUY
  297.   opendir(DIR, "../CONTEXTS") or die "I cannot open dir: $!";
  298.  
  299.   while (my $dir = readdir(DIR)) { #open directory with urls
  300.      next unless ($dir !~ m/\./);
  301.           
  302.      opendir(DIRE, "../CONTEXTS/".$dir) or die "I cannot open dir: $!";
  303.      open(DUMP,">:utf8","../FICHIERGLOBAUX/CONTEXTES-GLOBAUX_".$dir.".txt") or die "I'm not able to create dump_globaux for $dir.";
  304.        
  305.         while (my $file = readdir(DIRE)) { #open directory with urls
  306.            next unless ($file =~ m/\.txt$/);
  307.                         
  308.            open(INPUT,"<:utf8","../CONTEXTS/".$dir."/".$file) or die "I'm not able to open a file $file in directory $dir.";
  309.            while(<INPUT>) {
  310.               next unless ($_ !~ m/RIGHT CONTEXT$/);
  311.               print DUMP $_;
  312.            }
  313.            close INPUT;
  314.        
  315.         }
  316.  
  317.   closedir DIRE;
  318.   close DUMP;
  319.          
  320.   }
  321.   closedir DIR;     
  322. }
  324. sub tabs_globaux {
  325. #dumping tableaux files into one (taking every line which begin with "<TR"), giving header
  326.   opendir(DIR, "../TABLEAUX") or die "I cannot open dir: $!";
  327.   open(EXP,">:utf8","../TABLEAUX/tabs_globaux.html") or die "I'm not able to create dump_globaux for $dir.";
  328.   my $n=0;
  329.  
  330.   print EXP "<html>\n\n<head>\n<meta http-equiv=\"Content-Type\" content=\"text/htm;charset=utf-8\">\n<title>Tableux_globaux</title>\n</head>\n\n<body bgcolor=\"#4B0082\">\n\n";
  331.  
  332.   while (my $file = readdir(DIR)) { #open directory with urls
  333.      next unless ($file =~ m/\.html/ and $file ne "tabs_globaux.html");
  334.      my $fic=substr($file,0,-5);
  335.      $n++;
  336.     
  337.      print EXP "<table align=\"center\" border=\"1\">\n";
  338.      print EXP "<tr><td colspan=\"8\" align=\"center\" bgcolor=\"black\"><font color=\"white\"><b>Tableau n&deg $n</b>\<br><small>fichier : $fic.txt</small></font></td></tr>";
  339.                             
  340.      open(INPUT,"<:utf8","../TABLEAUX/".$file) or die "I'm not able to open a file $file in directory $dir.";
  341.      while(<INPUT>) {
  342.         next unless ($_ =~ m/<tr/);
  343.         print EXP $_;
  344.      }
  345.     
  346.      close INPUT;
  347.      print EXP "</table>\n\n<br><hr><br>\n\n";
  348.        
  349.   }
  350.  
  351.   print EXP "</body></html>";
  352.  
  353.   closedir DIR;
  354.   close EXP;       
  355. }  



    4-11 calling  used modules








    13-17 making directories which script uses, it expect being placed in directory "PROGRAMME"




    19 opening directory containing urls in text file
    20 creating a file for saving errors occured during reading the urls files


    24-31 reading every txt file (containging urls) in dir URL

    27 start counting the time
    28 runs subprogram html_table (49-114), gives variable contaning name of file
    29 stopping the time and printing it







    38-40 calling subprograms making global files (see bellow)







    ---------------------------------------
    SUBPROGRAM HTML_TABLE
    creates a html-file with links and runs subprograms which are getting and processing webpages
    ARGUMENT: file

    54 extract name of langue from name of file




    59 hash containg keywords which will be finaly searched in text



    61 keyword for actual language saved into variable
    63 opening a file containging urls
    64 making html page coresponding to language

    65-66 creating directories for saving the files named by language

    68 printing first part of html into html file








    70 reading text file containging urls




    77 calling download_html (arg: url, language, number) which saves it and returns encoding
    79 calling context_txt_html (arg: number, langue, keyword), return occurence in the document

    80 counting occurences for whole language

    81-106 if is page not downloaded skipped this part, number is not increased and I go for next file (not continuating with table)

    85 other part of row in table
    86-88 if charset isn't utf-8 printing link for non-converted file





    92-99 verifing occurences - if 0 printing not found, else prints links into table









    101 changing number, it means switching onto next line of url-file (next link)






    109-110 printing end of table and html document


    ---------------------------------------
    SUBPROGRAM DOWNLOAD_HTML
    download each html file which got from url and return its encoding
    ARGUMENTS: url, language, number
    RETURNS: encoding

    122 downloading pages content (using module LWP::Simple), if it's not downloaded, it prints an error into the error file.
    125-142 if web site downloaded:


    129 saving into a html file


    132 detecting content encoding (module Encode::Detect)
    134 if it's not detected it try to guess it (module Encode::Guess)




    140 calling a sub-program which makes a txt file from html.



    144-146 if not downloaded, encoding is set as "not downloaded"

    148 returns encoding/not downloaded


    ---------------------------------------
    SUBPROGRAM TXT_SAVE
    saves a dumped text
    ARGUMENTS: html-content, language, number, charset


    158-163 if it's encoding isn't utf-8 save a non converted copy without html tags (using delete_html subprogram)




    165 saves txt files in utf-8 without html tags (using delete_html subprogram)


    ---------------------------------------
    SUBPROGRAM DELETE_HTML
    delete every html tag
    ARGUMENTS: html-content
    RETURNS: content-without-html

    174-177 using features of HTML::TreeBuilder;



    ---------------------------------------
    SUBPROGRAM CONTEXT_TXT_HTML
    finds a KWIC and print it into TXT, HTML
    ARGUMENTS: number, language, motif
    RETURNS: number-of-occurence



    187 setting a length of context around key-word






    194-196 opening a source file and two export files (txt, html)





    200-206 printing header of html and additional info






    208 printing header of txt file



    212-261 reading of the source file and looking up for context and exporting, counting number of occs ($x)

















    232-237 and 239-244 looking up for first/last whole word in range of context length

























    258-261 if keyword wasnt found, deleting of files created in this case




    ---------------------------------------
    SUBPROGRAM DUMP_GLOBAUX
    makes global dumped file (from DUMP_TEXT) for every language (directory), containg every dumped file, saves into created file FISCHIERGLOBAUX

    270-290 browsing the directory and opening every txt file









    281 printing content of txt files into one dumped file











    ---------------------------------------
    SUBPROGRAM DUMP_GLOBAUX_CONTEXT
    same as subprogram above, just one difference, it skips first line in a file.



























    ---------------------------------------
    SUBPROGRAM TABS_GLOBAUX
    dumping tableaux files into one (taking every line which begin with "<TR"), giving header to the tab


    330 and 337-338 printing beggining of the global html file

    332-333 and 340 browsing directory and opening a html file









    341-344 reading a html file and every line which begins with "tr" is printed into global html file



    347 closing html-table



    351 closing html file