Listing du fichier strFuncs.pm
00001 Pour ne pas voir les numéros de ligne, ajoutez &nl=non à la suite du nom du fichier. |
Retour à la page principale de
(gH)
Listing du fichier strFuncs.pm
00001# (gH) -_- strFuncs.pm ; TimeStamp (unix) : 25 Janvier 2007 vers 16:08
00002 # #
00003 ##############################################################################
00004 # #
00005 # #
00006 # Fichier : strFuncs.pm v-1.05 #
00007 # #
00008 # #
00009 # Gilles.HUNAULT@univ-angers.fr #
00010 # http://www.info.univ-angers.fr/~gh/gh.html #
00011 # #
00012 # #
00013 # " Sous-programmes perl de fonctions utiles sur chaine de caractères " #
00014 # #
00015 # #
00016 ##############################################################################
00017 # #
00018 # 1. peut s'utiliser par #
00019 # #
00020 # use strFuncs ; #
00021 # #
00022 # si le module est dans le répertoire courant #
00023 # #
00024 ##############################################################################
00025 # #
00026 # 2. peut s'utiliser par #
00027 # #
00028 # use lib "/usr/local/bin/scriptsPerl/" ; #
00029 # use strFuncs ; #
00030 # #
00031 # si le module est dans le répertoire /usr/local/bin/scriptsPerl/ #
00032 # #
00033 ##############################################################################
00034 # #
00035 # 3. peut s'utiliser par #
00036 # #
00037 # use lib $ENV{"PERL_MACROS"} ; #
00038 # use strFuncs ; #
00039 # #
00040 # si le module est dans le répertoire indiqué par la variable #
00041 # d'environnement PERL_MACROS, par exemple : #
00042 # #
00043 # export PERL_MACROS=/usr/local/bin/scriptsPerl/ #
00044 # (pour bash, sous Linux) #
00045 # set PERL_MACROS=c:\Scripts\Perl\ #
00046 # (sous Dos/Windows) #
00047 # #
00048 # #
00049 ##############################################################################
00050
00051 package strFuncs ;
00052 require Exporter ;
00053 @ISA = qw(Exporter) ;
00054
00055 @EXPORT = (<<"FIN_DE_LA_LISTE_DES_FONCTIONS" =~ m/^\s*(.+)/xgm) ;
00056 dateEtHeure
00057 formatEntier
00058 surncarg
00059 premierMot
00060 phraseSansDernierMot
00061 phraseSansPremierMot
00062 premierEtReste
00063 debutEtDernier
00064 sprintG
00065 verifAdr
00066 nsuivant
00067 nettoieId
00068 initialeMajuscule
00069 nbMots
00070 attends
00071 sansEspaceAuDebut
00072 sansEspaceEnFin
00073 sansEspaceDebutEtFin
00074 nomFichierSansExtension
00075 dernierePosition
00076 chaineVide
00077 maju
00078 sansCmt
00079 cpy
00080 mot
00081 PosMotDsPhraz
00082 IndentEtReste
00083 Cmt
00084 copies
00085 trim
00086 debutPageHtml
00087 debutPageHtmlNoXml
00088 finPageHtml
00089 debutSection
00090 finSection
00091 ajouteS
00092 valeurAttribut
00093 nettoieSequence
00094 FIN_DE_LA_LISTE_DES_FONCTIONS
00095
00096 #############################################################
00097 #############################################################
00098
00099 sub dateEtHeure {
00100
00101 my ($sec,$min,$hour,$mday,$mmon,$year)=localtime();
00102 $mmon = $mmon + 1 ;
00103 $year = $year + 1900 ;
00104 if (length($sec)<2) { $sec = "0$sec" } ;
00105 if (length($mday)<2) { $mday = "0$mday" } ;
00106 if (length($mmon)<2) { $mmon = "0$mmon" } ;
00107 $now = $mday."/".$mmon."/".$year;
00108 $now .= " ".$hour.":".$min ;
00109
00110 return $now ;
00111
00112 } ; # fin sub datHeur
00113
00114 #############################################################
00115
00116 sub formatEntier {
00117 return(sprintf("%$_[1]d",$_[0])) ;
00118 } ; # fin sub formatEntier
00119
00120 #############################################################
00121
00122 sub surncarg {
00123 my ($ac,$lo) = @_ ;
00124 $ch = $ac ;
00125 while (length($ch)<$lo) { $ch.= " " ; } ;
00126 return($ch) ;
00127 } ; # fin sub formatEntier
00128
00129 #############################################################
00130
00131 sub debutPageHtml {
00132
00133 @ch = (<<"D_HTML") ;
00134 <?xml version="1.0" encoding="ISO-8859-1" ?>\n
00135 <!DOCTYPE html\n
00136 PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"\n
00137 "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">\n
00138 <html xmlns="http://www.w3.org/1999/xhtml" lang="fr" xml:lang="fr">\n
00139 <head>\n
00140 <meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1" />
00141 <style type="text/css"><!--
00142 .cadre { border: thin solid; margin-left: 30p; background-color: #EEEEEE; margin-right: 80p }
00143 .rouge { color: #990000 }
00144 .grouge { font-weight : bold ; color: #990000 }
00145 .gbleu { font-weight : bold ; color: blue }
00146 .vert { color: green }
00147 .gvert { font-weight : bold ; color: green }
00148 .it { font-style : italic }
00149 --></style>
00150 <title>
00151 $_[0]
00152 </title>
00153 </head>
00154 <body background="beige.jpg">
00155
00156 <p align="right">
00157 <a href="http://validator.w3.org/check/referer">
00158 <img src="valid.png" height="31" width="88" alt="Valid XHTML 1.0!" />
00159 </a>
00160
00161
00162
00163 </p>
00164
00165 <p> </p>
00166 D_HTML
00167 return(@ch) ;
00168
00169 } ; # fin sub debutPageHtml
00170
00171 #############################################################
00172
00173 sub debutPageHtmlNoXml {
00174
00175 @ch = (<<"D_HTML") ;
00176 <?xml version="1.0" encoding="ISO-8859-1" ?>\n
00177 <!DOCTYPE html\n
00178 PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"\n
00179 "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">\n
00180 <html xmlns="http://www.w3.org/1999/xhtml" lang="fr" xml:lang="fr">\n
00181 <head>\n
00182 <meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1" />
00183 <style type="text/css"><!--
00184 .cadre { border: thin solid; margin-left: 30p; background-color: #EEEEEE; margin-right: 80p }
00185 .rouge { color: #990000 }
00186 .grouge { font-weight : bold ; color: #990000 }
00187 .gbleu { font-weight : bold ; color: blue }
00188 .vert { color: green }
00189 .gvert { font-weight : bold ; color: green }
00190 .it { font-style : italic }
00191 --></style>
00192 <title>
00193 $_[0]
00194 </title>
00195 </head>
00196 <body background="beige.jpg">
00197 D_HTML
00198 return(@ch) ;
00199
00200 } ; # fin sub debutPageHtml
00201
00202 #############################################################
00203
00204 sub finPageHtml {
00205
00206 @ch = (<<"F_HTML") ;
00207 <p> </p>
00208
00209 <a href="http://www.info.univ-angers.fr/pub/gh/"><img src="return.gif" alt="retour gH" /></a>
00210 Retour à la page principale de
00211 <font color="#008800">(gH)</font>
00212 <p> </p>
00213 <p> </p>
00214 </body>
00215 </html>
00216 F_HTML
00217 return(@ch) ;
00218
00219 } ; # fin sub finPageHtml
00220
00221 #############################################################
00222
00223 sub debutSection {
00224
00225 @ch = (<<"D_HTML") ;
00226
00227 <table cellpadding="50" bgcolor="white" width="65%"><tr><td bgcolor="white">
00228 D_HTML
00229 return(@ch) ;
00230
00231 } ; # fin sub debutSection
00232
00233 #############################################################
00234
00235 sub finSection {
00236
00237 @ch = (<<"F_HTML") ;
00238
00239 </td></tr></table>\n
00240 <p> </p>
00241 F_HTML
00242 return(@ch) ;
00243
00244 } ; # fin sub finSection
00245
00246 #############################################################
00247 #############################################################
00248
00249
00250 # la fonction initialeMajuscule n'est pas une erreur
00251 # (à cause de ucfirst, /i et \u en perl) mais une
00252 # volonté de "nettoyer" la chaine
00253
00254 #############################################################
00255 ## #
00256 ## C. Sous-programmes sur chaines de caractères #
00257 ## #
00258 #############################################################
00259
00260 sub premierMot {
00261 my $phr = $_[0] ;
00262 my @mt = split(" ",$phr) ;
00263 my $mu = $mt[0] ;
00264 if ($ghDbg) { print STDERR " mot 1 : -- $mu -- \n"; } ;
00265 return $mu ;
00266 } ; # sub premierMot {
00267
00268 #########################################################################################
00269
00270 sub dernierMot {
00271 my $phr = $_[0] ;
00272 my @mt = split(" ",$phr) ;
00273 my $mu = $mt[$#mt] ;
00274 if ($ghDbg) { print STDERR " mot x : -- $mu -- \n"; } ;
00275 return $mu ;
00276 } ; # sub dernierMot {
00277
00278 #########################################################################################
00279
00280 sub phraseSansDernierMot {
00281 my $phr = $_[0] ;
00282 my @mt = split(" ",$phr) ;
00283 $mt[$#mt] = "" ;
00284 my $mu = join(" ",@mt) ;
00285 if ($ghDbg) { print STDERR " sans x : -- $mu -- \n"; } ;
00286 return $mu ;
00287 } ; # sub phraseSansDernierMot
00288
00289 #########################################################################################
00290
00291 sub phraseSansPremierMot {
00292 my $phr = $_[0] ;
00293 my @mt = split(" ",$phr) ;
00294 $mt[0] = "" ;
00295 my $mu = join(" ",@mt) ;
00296 if ($ghDbg) { print STDERR " sans 1 : -- $mu -- \n"; } ;
00297 return $mu ;
00298 } ; # sub phraseSansPremierMot
00299
00300 #########################################################################################
00301
00302 sub premierEtReste {
00303 my $phr = $_[0] ;
00304 my @mt = split(" ",$phr) ;
00305 my $pm = $mt[0] ;
00306 $mt[0] = "" ;
00307 my $re = join(" ",@mt) ;
00308 return ($pm,$re) ;
00309 } ; # sub premierEtReste
00310
00311 #########################################################################################
00312
00313 sub debutEtDernier {
00314 my $phr = $_[0] ;
00315 #$phr =~ s/^ //g ;
00316 while (substr($phr,0,1) eq " ") { $phr = substr($phr,1) ; } ;
00317 ##if ($ghDbg) { print STDERR " phr =*$phr*\n" ; } ;
00318 if ($phr eq "") { $phr="### ###" ; } ;
00319 my @mt = split(" ",$phr) ;
00320 my $dm = $mt[$#mt] ;
00321 $mt[$#mt] = "" ;
00322 my $re = join(" ",@mt) ;
00323 return ($re,$dm) ;
00324 } ; # fin de sub debutEtDernier
00325
00326 #########################################################################################
00327
00328 sub sprintG { # comme sprintf mais ne déborde pas
00329 # par exemple sprintG(25,$pom) équivaut à sprintf("%-25s",$pom)
00330 my $len = $_[0] ;
00331 my $phr = $_[1] ;
00332 my $fmt = "%-".$len."s" ;
00333 my $lph = sprintf($fmt,$phr).(" "x50) ;
00334 return substr($lph,0,$len) ;
00335 } ; # fin sub sprintG
00336
00337 #########################################################################################
00338
00339 sub verifieAdrWeb { #BL&EL: corrige une ADResse WEB
00340 my $ancAdr = $_[0] ;
00341 $ancAdr =~ s/ //g ;
00342 my $retAdr = "???" ;
00343 if (length($ancAdr)==0) { $retAdr = "???" ; } else { $retAdr = $ancAdr ; } ;
00344 return $retAdr ;
00345 } ; # fin de sub verifAdr
00346
00347 #########################################################################################
00348
00349 sub verifiePseudoEbay {
00350 my $ancPse = $_[0] ;
00351 $ancPse =~ s/ //g ;
00352 my $retPse = "???" ;
00353 if (length($ancPse)==0) { $retPse = "???" ; } else { $retPse = $ancPse ; } ;
00354 return $retPse ;
00355 } ; # fin de sub verifAdr
00356
00357 #########################################################################################
00358
00359 sub verifieCoteEbay {
00360 my $ancCote = $_[0] ;
00361 if (length($ancCote)==0) { $retCote = -9999 ; } else { $retCote = $ancCote ; } ;
00362 return $retCote ;
00363 } ; # fin de sub verifAdr
00364
00365 #########################################################################################
00366
00367 sub nsuivant {
00368
00369 $dbgSuiv = 0 ; # 0 normal, 1 pour debug simple 2 pour debug lourd
00370
00371 $oldNom = $_[0] ;
00372 $vxl = length($oldNom) ;
00373 if ($dbgSuiv>0) { if ($ghDbg) { print STDERR " on veut le nom suivant de $oldNom longueur $vxl\n" ; } ; } ;
00374
00375 $oldNom =~ tr /A-Z/a-z/ ;
00376 $debNom = substr($oldNom,0,$vxl-1) ;
00377 $lastCar = substr($oldNom,$vxl-1,1) ;
00378
00379 if (ord($lastCar) < ord("z")) {
00380
00381 $newNom = $debNom.chr(1+ord($lastCar)) ;
00382 if ($dbgSuiv>1) {
00383 $olc = ord($lastCar) ;
00384 $cdz = ord("z") ;
00385 if ($ghDbg) { print STDERR " ord de last car vaut $olc et celui de z est $cdz " ; } ;
00386 if ($ghDbg) { print STDERR " avant le while : debnom $debNom \n" ; } ;
00387 } ; # fin de si
00388 } else {
00389
00390 $debNom = $oldNom ;
00391 $lastCar = substr($oldNom,$vxl-1,1);
00392
00393 if ($dbgSuiv>1) { if ($ghDbg) { print STDERR " avant le while : debnom $debNom \n" ; } ; } ;
00394
00395 $nbw = 0 ;
00396 while (($lastCar eq "z") and (length($debNom)>0)) {
00397 $nbw++ ;
00398 $debNom = substr($debNom,0,length($debNom)-1) ;
00399 if (length($debNom)>0) {
00400 $lastCar = substr($debNom,length($debNom)-1,1) ;
00401 } else {
00402 $lastCar = "" ;
00403 } ; # fin de si
00404 $debNom =~ s/ //g ;
00405 if ($dbgSuiv>1) { if ($ghDbg) { print STDERR " $nbw dans le while : debnom *$debNom* lc $lastCar \n" ; } ; } ;
00406 } ; # end /* fin tant que */
00407 if ($dbgSuiv>1) { if ($ghDbg) { print STDERR " apres le while : debnom $debNom lastcar $lastCar on a $nbw fois z \n" ; } ; } ;
00408
00409 if (length($debNom)>0) {
00410 $debNom = substr($debNom,0,length($debNom)-1) ;
00411 $newNom = $debNom.chr(1+ord($lastCar)) ;
00412 } else {
00413 $vxl = $vxl + 1 ;
00414 $newNom = "" ;
00415 } ; # fin de si
00416
00417 if ($nbw==$vxl) { $vxl = $vxl + 1 } ;
00418
00419 while (length($newNom) < $vxl) {
00420 $newNom .= "a" ;
00421 } ; # fin de tant que
00422
00423 } ; # fin du si sur le tout premier lastCar
00424
00425 $newNom =~ tr/A-Z/a-z/ ;
00426 if ($dbgSuiv>0) {
00427 if ($ghDbg) { print STDERR " ce doit etre $newNom\n" ; } ;
00428 &attends() ;
00429 } ; # fin de si
00430
00431 return $newNom ;
00432
00433 } ; # fin sub nsuivant
00434
00435 #########################################################################################
00436
00437 sub nettoieId {
00438 $entree = $_[0] ; $modeNom = $_[1] ; # 1 pour nom, 0 pour prenom, 2 pour ignorer chasse
00439 $sortie = $entree ;
00440 $sortie =~ s/^ //g ; #BL&EL supression du premier blanc de tete
00441 $sortie =~ s/ $//g ; #BL&EL supression du dernier blanc de queue
00442 $sortie =~ s/\(//g ; # supression de parenthèse ouvrante
00443 $sortie =~ s/\)//g ; # supression de parenthèse fermante
00444 $sortie =~ s/>//g ; # supression de >
00445 $sortie =~ s/<//g ; # supression de <
00446 $sortie =~ s/"//g ; # supression de guillemet
00447 $sortie =~ s/'//g ; # supression d'apostrophe
00448 $sortie =~ s/\\//g ; # supression d'anti-slash
00449 $sortie =~ s/&//g ; # supression du &
00450 $sortie =~ s/^ //g ; # supression des blancs de tete
00451 $sortie =~ s/ $//g ; # supression des blancs de queue
00452 # certains utilisent =iso
00453 if ($modeNom==1) { $sortie =~ tr/a-z/A-Z/ ; } ; # passage en majuscules
00454 if (substr($sortie,0,5) eq "=?ISO") { $sortie = "" } ;
00455 if (substr($sortie,0,5) eq "=?iso") { $sortie = "" } ;
00456 return $sortie ;
00457 } ; # fin sub nettoieId
00458
00459 #########################################################################################
00460
00461 sub initialeMajuscule {
00462
00463 $entree = $_[0] ;
00464 $sortie = $entree ;
00465 $sortie =~ s/^ //g ; #BL&EL supression du premier blanc de tete
00466 $sortie =~ s/ $//g ; #BL&EL supression du dernier blanc de queue
00467 $sortie =~ tr/A-Z/a-z/ ; # passage en minuscules
00468 $premc = substr($sortie,0,1) ; # premier caractère
00469 $premc =~ tr/a-z/A-Z/ ; # passage en majuscules
00470 $sortie = "$premc".substr($sortie,1,length($sortie)-1) ;
00471
00472 } ; # fin de sub initialeMajuscule
00473
00474 #########################################################################################
00475
00476 sub nbMots {
00477
00478 my $nbesp ;
00479 my $entre = $_[0] ;
00480 $entree = $_[0] ;
00481 $entree =~ s/,/ /g ; # remplaces les virgules par des blancs
00482 $entree =~ s/^ //g ; # supression des blancs de tete
00483 $entree =~ s/ $//g ; # supression des blancs de queue
00484 while ($entree =~ s/ / /g) { } ;
00485 if (length($entree)==0) { $nbesp = 0 ; } else {
00486 $nbesp = 1 + ($entree =~ s/ /*/g) ;
00487 } ; # fin de si
00488 return $nbesp ;
00489
00490 } ; # fin de sub nbMots
00491
00492 #########################################################################################
00493
00494 sub sansEspaceAuDebut {
00495
00496 my $entre = $_[0] ;
00497 while ($entre =~ s/^ //g) { } ;
00498 return $entre ;
00499
00500 } ; # fin de sub sansEspaceAuDebut
00501
00502 #########################################################################################
00503
00504 sub sansEspaceEnFin {
00505
00506 my $entre = $_[0] ;
00507 while ($entre =~ s/ $//g) { } ;
00508 return $entre ;
00509
00510 } ; # fin de sub sansEspaceEnFin
00511
00512 #########################################################################################
00513
00514 sub sansEspaceDebutEtFin {
00515
00516 my $entre = $_[0] ;
00517 $entre = &sansEspaceAuDebut($entre) ;
00518 $entre = &sansEspaceEnFin($entre) ;
00519 return $entre ;
00520
00521 } ; # fin sub sansEspaceDebutEtFin
00522
00523 #########################################################################################
00524
00525 sub dernierePosition {
00526
00527 my $aig = $_[0] ; # aiguille
00528 my $phraz = $_[1] ; # botte de foin
00529 my $pdr = index(reverse($phraz),$aig) ;
00530 my $dp = -2 ;
00531 if ($pdr == -1) { $dp = -1 } else { $dp = length($phraz)-$pdr-1 ; } ;
00532 return $dp ;
00533
00534 } ; # fin sub dernierePosition
00535
00536 #########################################################################################
00537
00538 sub chaineVide { # renvoie 1 si la chaine est vide, 0 sinon
00539
00540 if (length(&sansEspaceDebutEtFin($_[0]))>0) { return 0 ; } else { return 1 ; } ;
00541
00542 } ; # fin sub chaineVide
00543
00544 #########################################################################################
00545
00546 sub nomFichierSansExtension {
00547
00548 my $nomF = $_[0] ;
00549 my $dpdp = &dernierePosition(".",$nomF) ;
00550 my $nNom = substr($nomF,0,$dpdp) ;
00551 return $nNom ;
00552
00553 } ; # sub nomFichierSansExtension
00554
00555 #########################################################################################
00556
00557 sub sansCmt {
00558
00559 $sansCmt_dbg = 0 ; # mettre 1 pour affichage de debug, 0 en mode normal
00560
00561 $ligneAvant = $_[0] ;
00562 $ligneApres = $ligneAvant ;
00563 if ($sansCmt_dbg>0) { print " avant : $ligneAvant \n" ; }
00564 $posDiese = index($ligneAvant,"#") ;
00565 if ($sansCmt_dbg>0) { print " diese vu en $posDiese \n" ; }
00566 if ($posDiese>-1) { $ligneApres = substr($ligneAvant,0,$posDiese) ; } ;
00567 if ($sansCmt_dbg>0) { print " apres = $ligneApres\n" ; }
00568
00569 return $ligneApres ;
00570
00571 } ; # fin sub sansCmt
00572
00573 #########################################################################################
00574
00575 sub maju { # mode français : gère les accents (sans passer par les LOCALE)
00576
00577 $ligneAvant = $_[0] ;
00578 $ligneApres = uc($ligneAvant) ;
00579 $ligneApres =~ s/à/A/g ;
00580 $ligneApres =~ s/â/A/g ;
00581 $ligneApres =~ s/ç/C/g ;
00582 $ligneApres =~ s/é/E/g ;
00583 $ligneApres =~ s/è/E/g ;
00584 $ligneApres =~ s/ê/E/g ;
00585 $ligneApres =~ s/î/I/g ;
00586 $ligneApres =~ s/ô/O/g ;
00587 $ligneApres =~ s/û/U/g ;
00588
00589 return $ligneApres ;
00590
00591 } ; # fin sub maju
00592
00593 #########################################################################################
00594
00595 sub cpy {
00596
00597 print "\n" ;
00598 print " Copyright 2000 - email : gilles.hunault\@univ-angers.fr \n" ;
00599 print " http://www.info.univ-angers.fr/~gh/gh.html \n" ;
00600 print "\n" ;
00601
00602 } ; # fin sub cpy
00603
00604 #########################################################################################
00605
00606 sub attends {
00607
00608 print STDERR " ok ? " ;
00609 chop (my $repgh = <STDIN>);
00610 if (length($repgh)>0) { exit -1 } ;
00611 return ;
00612
00613 } ; # fin sub attends
00614
00615 #BL&EL########################################################################################
00616
00617 # Retourne le MOT n dans la PHRAse
00618 sub mot {
00619 my @TPhraz;
00620
00621 @TPhraz=split(" ", $_[0]);
00622
00623 return $TPhraz[$_[1]-1];
00624 } ; # FIN sub mot
00625
00626 #BL&EL########################################################################################
00627
00628 # retourne la POSition d'un MOT DanS une PHRAse
00629 # si le MOT n'appartient pas à la PHRAse, la valeur retournée est -1
00630 sub PosMotDsPhraz {
00631 my @TPhraz;
00632 my $Mot;
00633 my $PosMot;
00634
00635 $Mot=$_[0];
00636 @TPhraz=split(" ", $_[1]);
00637 $PosMot=$#TPhraz;
00638
00639 while (($PosMot != -1) and ($Mot ne $TPhraz[$PosMot-1])) {
00640 $PosMot--;
00641 }; # Fin_Tant_Que le mot n'est pas présent
00642
00643 return $PosMot;
00644
00645 } ; # FIN sub PosMotDsPhraz
00646
00647 #BL&EL########################################################################################
00648
00649 # retourne le couple formé de l'INDENTation ET du RESTE de la ligne
00650
00651 sub IndentEtReste {
00652 my $LCourante; # Ligne COURANTE
00653 my $Indent; # INDENTation
00654 my $Reste; # RESTE de la ligne
00655 my $CarCour; # CARactère COURant
00656 my $NbEsp; # NomBre d'ESPaces
00657 my $NbTabu; # NomBre de TABUlations
00658
00659 $LCourante=$_[0];
00660
00661 $CarCour=0;
00662 $NbIndent=0;
00663 $NbTabu=0;
00664 while ((substr($LCourante, $CarCour, 1) eq " ") or (substr($LCourante, $CarCour, 1) eq "\t")) {
00665 if (substr($LCourante, $CarCour, 1) eq " ") {
00666 $NbEsp++;
00667 }; # Fin_Si le caractère est un espace
00668 if (substr($LCourante, $CarCour, 1) eq "\t") {
00669 $NbTabu++;
00670 }; # Fin_Si le caractère est une tabulation
00671 $CarCour++;
00672 }; # Fin_Tant_Que le caractère courant est un espace ou une tabulation
00673 $Indent=("\t" x $NbTabu).(" " x $NbEsp); # Important : NbTabu avant NbEsp
00674 $Reste=substr($LCourante, $NbIndent+$NbTabu);
00675
00676 return($Indent, $Reste);
00677 }
00678
00679 #BL&EL########################################################################################
00680
00681 # retourne le CoMmenTaire d'une ligne passée en paramètre
00682
00683 sub Cmt {
00684 my $LCourante; # Ligne COURANTE
00685 my $PosCom; # POSition du COMmentaire
00686
00687 $LCourante=$_[0];
00688 $PosCom=index($LCourante, "#");
00689 if ($PosCom != -1) {
00690 substr($LCourante, 0, $PosCom+1)="";
00691 }
00692 else {
00693 $LCourante="";
00694 }; # Fin_Si il y a un commentaire
00695
00696 return($LCourante);
00697
00698 } ;
00699
00700 #########################################################################################
00701
00702 sub copies {
00703 return( $_[0] x $_[1]) ;
00704 } ; # fin copies
00705
00706 #########################################################################################
00707
00708 sub trim {
00709 my $string = shift;
00710 for ($string) {
00711 s/^\s+//;
00712 s/\s+$//;
00713 }
00714 return $string;
00715 } ; # fin fonction trim
00716
00717 #########################################################################################
00718
00719 sub ajouteS { # ajoute un s minscule en fin
00720
00721 if ($_[0]>1) { return "s" ; } else { return " " ; } ;
00722
00723 } ; # fin sub ajouteS
00724
00725
00726 #########################################################################################
00727
00728 sub valeurAttribut { # trouve la valeur de l'attribut (au sens XML) à l'intérieur des guillemets
00729
00730 $chaine = $_[0] ;
00731 $attribut = $_[1] ;
00732 $resultat = "N/A" ;
00733 chomp($chaine) ;
00734 $pdtp = index($chaine,$attribut) ;
00735 if ($pdtp>-1) {
00736 $fdm = substr($chaine,$pdtp+2+length($attribut)) ;
00737 $resultat = substr($fdm,0,index($fdm,'"')) ;
00738 } ; # fin de si
00739
00740 return $resultat ;
00741
00742 } ; # fin de sub valeurAttribut
00743
00744 #########################################################################################
00745
00746 sub nettoieSequence {
00747 $entree = $_[0] ;
00748 $sortie = $entree ;
00749 $sortie =~ s/ //g ; # supression les blancs
00750 $sortie =~ s/\n//g ; # supression les retours-charriots
00751 $sortie =~ s/\d//g ; # supression les chiffres
00752 return $sortie ;
00753 } ; # fin sub nettoieSequence
00754
00755 #########################################################################################
00756
00757 # cette dernière ligne est obligatoire pour dire que le chargement est ok :
00758
00759 1 ;
00760
00761 # faut-il implémenter les fonctions qui suivent ?
00762 #
00763 # iota mot d2c c2d copies datatype sourceline wordindex wordpos
00764 # progBar (barre de progression) sansCharRedondant droite gauche
00765 #
00766 ##################################### fin du fichier strFuncs.pm ##########
Pour ne pas voir les numéros de ligne, ajoutez &nl=non à la suite du nom du fichier.