Trucsweb.com

Forum de discussion

 Forum « Programmation CGI » (archives)

Optimisation de code perl

Envoyé: 22 août 2003, 4h34 par mikila


Bonjour,

J'ai developpé un filtre Perl pour traiter un fichier de log de Smtp. Il marche mais malheureusement, son execution fait monter la charge Cpu à 100%. Auriez vous des conseils d'optimisation à me donner ?

Noter qu'il y'a au moins 2 lignes pour chaque mail : 1 pour le from et un autre pour le to.
Format des lignes de log :
Jul 31 23:59:42 machine1 sendmail[4841]: [ID 801593 mail.info] h6VLxg2D004841: from=<xxxxx>, size=5046, class=0, nrcpts=1, msgid=<OFDDB6907F.DF9D5C47-ON85256D74.007907C1@yyyy>, proto=ESMTP, daemon=Daemon0, relay=station_relay [196.20.20.3]

Jul 31 23:59:43 machine1 sendmail[22972]: [ID 801593 mail.info] h6V489gV013841: to=<xxxx>, delay=17:51:34, xdelay=00:07:30, mailer=esmtp, pri=3090883, relay=serveur_relay[10.0.0.5], dsn=4.0.0, stat=Deferred: Connection timed out with serveur_relay

Voici le code :

use POSIX;
use Time::Local;

my $MonthList ={ 'Jan'=>1, 'Feb'=>2, 'Mar'=>3, 'Apr'=>4, 'May'=>5, 'Jun'=>6,
'Jul'=>7, 'Aug'=>8, 'Sep'=>9, 'Oct'=>10, 'Nov'=>11, 'Dec'=>12 };
my $r_space = '([^\s]*)\s+';
my $r_host = '.*\]:\s';
my $r_debug = '.*\]\s';
my $r_id = '([^:]*):\s';
#my $r_to = 'to=(.*),\s';
my $r_to = 'to=\<*([^(\s\>)]*)\>*,\s';
my $r_from = 'from=([^,]*),\s';
my $r_size = 'size=(\d*)';
my $r_nrcpts = 'nrcpts=(\d*)';
my $r_xdelay = 'xdelay=([^,]*),';
my $r_relay = 'relay=([^\s][^\s]*)';
my $r_stat = 'stat=([^\n\(]*)\s';
my $r_NULL = '.*';
my $FROM,$TO,$COMMON;
my $lignes ;
my @tab_mail ;

###### parsing commun a FROM et a TO
$COMMON = $r_space; # $1
$COMMON .= $r_space; # $2
$COMMON .= $r_space; # $3
$COMMON .= $r_host; #
$COMMON .= $r_debug; #
$COMMON .= $r_id; # $4
###### ligne FROM
$FROM = $COMMON;
$FROM .= $r_from; # $5
$FROM .= $r_size; # $6
$FROM .= $r_NULL;
$FROM .= $r_nrcpts; # $7
###### ligne TO
$TO = $COMMON;
$TO .= $r_to; # $5
$TO .= $r_NULL; #
$TO .= $r_xdelay; # $6
$TO .= $r_NULL; #
$TO .= $r_relay; # $7
$TO .= $r_NULL;
$TO .= $r_stat; # $8

#########################################################################

#fichiers de sauvegarde
$fic_brut="SMTP";
$fic_FORMAT=$fic_brut."_format.txt" ;
$fic_In=$fic_brut."_Trait.txt" ;
@liste_mois = ('Jan', 'Fev', 'Mar', 'Apr', 'May', 'Jun', 'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec' ) ;
########################################################################
# ETAPE 1 : Formatage du fichier d'entree : chaque ligne commence
# par un mois ( cf $COMMON )
########################################################################
open (FILE2,">$fic_FORMAT") || die "Pb d'ouverture : $! ";
while (<STDIN>)
{
chop;
if ( m#$COMMON#o )
{
if ( length($ligne) != 0 )
{
print FILE2 "$ligne \n";
}
$ligne = $_;
}
else
{
$ligne .= $_;
}
}
if ( length($ligne) != 0 )
{
print FILE2 "$ligne \n";
}
close FILE2;
########################################################################
# ETAPE 2 : Traitement du fichier formate
########################################################################
# On cherche les paires from - to et on implemente un objet "mail"
# pour chaque paire formee
# attention, un mail peut etre envoye a plusieures personnes...
########################################################################
open (FILE2,$fic_FORMAT) || die "Pb d'ouverture : $!";

$NB_FROM=0;

while (<FILE2>)
{
chop;
$NB8++;

if ( m#$FROM#o )
{
$mois = $1;
$jour = $2;
$heure = $3;
$id = $4;
$from = $5; # from=
$size = $6; # size=
$rec = $7; # nrcpts=

$tab_mail[$NB_FROM] = new mail($id, $mois, $jour, $heure, $from, $size, $rec);
$NB_FROM++;
}
elsif ( m#$TO#o )
{
$id2 = $4;
$to = $5; # to=
$to =~ tr/,/:/;
$delai = $6; # xdelay=
$relay = $7; # relay=
$status = $8; # stat=

for ( $incr=0; $incr < $NB_FROM; $incr++ )
{
if ( ( $tab_mail[$incr]->{Id}) eq $id2 )
{
$tab_mail[$incr]->mail_to($to, $delai,$status );
$tab_type[$incr]=$relay;
}
}
}
}

close FILE2 ;
########################################################################
# ETAPE 3 : Parcourt et tri des objets
########################################################################
#
# Format du fichier de sortie :
# Mois jour ts#Id#NbRec#from#to#status#taille#delai#type
########################################################################
my ($secondes, $minutes, $heures, $jour_mois, $mois, $annee, $jour_semaine, $jour_calendaire, $heure_ete) = localtime(time);
for ( $incr=0; $incr < $NB_FROM; $incr++ )
{
foreach $key (keys %{$tab_mail[$incr]->{tab_to}})
{
$mon = $$MonthList{$tab_mail[$incr]->{mois}}-1;
$time = timelocal(0, 0, $tab_mail[$incr]->{heure},
$tab_mail[$incr]->{jour}, $mon, "$annee");
$start_rq = POSIX::strftime("%d/%b/%Y %T", localtime($time));
($h, $m, $s)= split(":",$tab_mail[$incr]->{delai});
$delay = $s + ( 60 * $m ) + ( 3600 * $h );
$myfrom = $tab_mail[$incr]->{from};
$relayer = $tab_mail[$incr]->{relay};
if ( ! $tab_mail[$incr]->{from} )
{
$myfrom = '-';
}
if ( $tab_type[$incr] =~ /smtp1|smtp2 |smtp3/ )
{ $type="INBOUND" ;}
else { $type="OUTBOUND";
}
printf ( "%s;%s;%s;%s;%s;%s;%s;%s;%s;%s\n",
$start_rq,
$tab_mail[$incr]->{Id},
$tab_type[$incr],
$tab_mail[$incr]->{NbRec},
$myfrom,
$key,
$tab_mail[$incr]->{tab_to}{$key},
$type,
$tab_mail[$incr]->{taille},
$delay,
$type);
}
}


Réponses

 Aucune réponse à ce message... 
Aucun médias sociaux
X

Trucsweb.com Connexion

Connexion

X

Trucsweb.com Mot de passe perdu

Connexion

X

Trucsweb.com Conditions générales

Conditions

Responsabilité

La responsabilité des Trucsweb.com ne pourra être engagée en cas de faits indépendants de sa volonté. Les informations mises à disposition sur ce site le sont uniquement à titre purement informatif et ne sauraient constituer en aucun cas un conseil ou une recommandation de quelque nature que ce soit.

Aucun contrôle n'est exercé sur les références et ressources externes, l'utilisateur reconnaît que les Trucsweb.com n'assume aucune responsabilité relative à la mise à disposition de ces ressources, et ne peut être tenue responsable quant à leur contenu.

Droit applicable et juridiction compétente

Les règles en matière de droit, applicables aux contenus et aux transmissions de données sur et autour du site, sont déterminées par la loi canadienne. En cas de litige, n'ayant pu faire l'objet d'un accord à l'amiable, seuls les tribunaux canadien sont compétents.

X

Trucsweb.com Trucsweb

X

Trucsweb.com Glossaire

X

Trucsweb.com Trucsweb

X

Trucsweb.com Trucsweb

Conditions

Aucun message!

Merci.

X
Aucun message!
X

Trucsweb.com Créer un compte

Créer un compte

.
@