Hi to all,
I have come here due to the high reputation in coding perl you seem to have developed among the people i ran into in the web.
Let me explain:
I've written a mailing script, the main part of whic is in PHP (sorry the rest of my site is in PHP so...) but the actual part which sends the newsletter to my list is in Perl. Now the script works fine but it needs to be speeded up.
Why?
Because my server (low cost hosting) times out after about one hour. Considering it sends approx 12000 30k messages in this time even shing off 0.1 second per mail sent would mean increasing production by one third.
So what I'm here for is your experience and your ability.
How can I cut useless process time?

Here is the script:


#!/usr/bin/perl

read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
@pairs = split(/&/, $buffer);
foreach $pair (@pairs) {
    ($name, $value) = split(/=/, $pair);
    $value =~ tr/+/ /;
    $value =~ s/%0D%0A/|/g;
    $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
        if ($in{$name}) {
         $in{$name} = $in{$name}.",".$value;
          }
        else {
         $in{$name} = $value;
          }
}

    $in{'txt_message'} =~ s/\|/%0D%0A/g;
    $in{'txt_message'} =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1
+))/eg;
    $text_message = $in{'txt_message'};
    $in{'html_message'} =~ s/\|/%0D%0A/g;
    $in{'html_message'} =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($
+1))/eg;
    $html_message = $in{'html_message'};
    $totalEmails = $in{'rightrange'} - $in{'leftrange'} + 1;
    $time_start = time() + $in{'time_diff'}*3600;
    $lock = "2";

$pid = fork();
print "Content-type: text/html \n\n fork failed: $!" unless defined $p
+id;
if ($pid) {

    if ($in{'archive'} eq "1") {
    &archive;
     #an archiving procedure at the end of this script
    }

    print "Content-type: text/html \n\n";
    print "<html><head><title>List Administration</title></head><body>
    <br><br><br><center>
    Congratulations!<br>The mailing has been started. You will receive
+ a confirmation e-mail when the mailing has been completed.
    <P><FORM><INPUT TYPE=BUTTON VALUE=\"Back\" onClick=\"history.go(-1
+)\"></form></center></body></html>";

    exit(0);
}
else {
    close (STDOUT);
    $count = 0;

    open(LIST,"$in{'list_dir'}/$in{'list'}/$in{'list'}.txt");
    if ($lock){flock(LIST, $lock);}
    @addresses=<LIST>;
    close(LIST);

    $text_message =~ s/(.{60}\s)/$1\n/g;
    
    my @boundaryv = (0..9, 'A'..'F');
    srand(time ^ $$);
    for (my $i = 0; $i++ < 24;) {
    $boundary .= $boundaryv[rand(@boundaryv)];
    }

for ($count = ($in{'leftrange'} - 1); $count < $in{'rightrange'}; $cou
+nt++) {
    
     $member = @addresses[$count];
    chomp($member);

open (MAIL, "|$in{'mailprog'} -t") || die "Can't open $in{'mailprog'}!
+\n";
    if ($in{'type'} eq "html") {
        print MAIL "Content-type:text/html\n";
    }     
    print MAIL "From: $in{'adminMail'}\n";
    print MAIL "To: $member\n";
    print MAIL "Subject: $in{'subject'}\n";
     if ($in{'type'} eq "multipart") {
        print MAIL "MIME-Version: 1.0\n";
        print MAIL "Content-Type: multipart/mixed; boundary=\"----=_Ne
+xt_Part_$boundary\"\n";
    }
    if ($in{'type'} eq "multipart") {
        print MAIL "------=_Next_Part_$boundary\n";
        print MAIL "Content-type: text/plain;\n";
        print MAIL "charset=us-ascii\n";
        print MAIL "Content-Transfer-Encoding: quoted-printable\n\n";
    }

     if ($in{'type'} eq "text" || $in{'type'} eq "multipart") {
        print MAIL "$text_message\n\n";
              if ($in{'remove_notice'} eq "1") {
                  print MAIL "----------------------------------------
+-----------------------------\n";
                  print MAIL "Removal notice";
                  print MAIL "$in{'subscribeUrl'}?$unsubscribe&$in{'li
+st'}&member\n";
                  print MAIL "----------------------------------------
+-----------------------------\n\n";
            }
     }
    if ($in{'type'} eq "multipart") {
        print MAIL "------=_Next_Part_$boundary\n";
        print MAIL "Content-type: text/html;\n";
        print MAIL "charset=\"base64\"\n";
        print MAIL "Content-Transfer-Encoding: quoted-printable\n\n";
    }
     if ($in{'type'} eq "multipart" || $in{'type'} eq "html") {
          print MAIL "$html_message\n\n";
            if ($in{'remove_notice'} eq "1") {
                   print MAIL "<BR><BR>";
                   print MAIL "---------------------------------------
+------------------------------<br>";
                   print MAIL "HTML removaql notice";
                   print MAIL "<a href=\"$in{'subscribeUrl'}?$unsubscr
+ibe&$in{'list'}&member\">$in{'subscribeUrl'}?$unsubscribe&$in{'list'}
+&member</a><br>";
                   print MAIL "---------------------------------------
+------------------------------<br><br>";
            }
    }
    close MAIL;

    if (int($count/100)*100 == $count) {
    $time_now = time() + $in{'time_diff'}*3600;
    open(LOG, ">$in{'list_dir'}/$in{'list'}/log_sent.txt");
    if ($lock){flock(LOG, $lock);}  
    $status = $count - $in{'leftrange'} + 1;
    print LOG "$time_start" . "::" . "$totalEmails" . "::" . "$status"
+ . "::" . "$time_now";
    close(LOG);
    }
}
}

    $time_now = time() + $in{'time_diff'}*3600;
    open(LOG, ">$in{'list_dir'}/$in{'list'}/log_sent.txt");
    if ($lock){flock(LOG, $lock);}
    print LOG "$time_start" . "::" . "$totalEmails" . "::" . "$count" 
+. "::" . "$time_now" . "::end";
    close(LOG);

open (MAIL, "|$in{'mailprog'} -t");
    print MAIL "From: $in{'adminMail'}\n";
    print MAIL "To: $in{'adminMail'}\n";
    print MAIL "Subject: Congratulations!\n\n";
    print MAIL "Congratulations!\nThe mailing was successfully sent to
+ $totalEmails people by $ENV{'REMOTE_ADDR'}.\nMailing started at $tim
+e_start and ended at $time_now.\nHere is what was sent:\n\n-----\n\n"
+;
    print MAIL "Type - $in{'type'}\n\n";
    print MAIL "Subject: $in{'subject'}\n\n$in{'message'}\n\n-----";
    close (MAIL);

exit;

[download]

Note -
All variables are passed through the form.

Questions -
1. Does including the archiving routine within the script slow it down?
2. What factors lower the number of emails which can be sent before time-out: message size, script size...
3. Any suggestions?

I would like to thank you all for your help and patience.

Adrien

In reply to Speeding up a mailing list script by Anonymous Monk

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post, it's "PerlMonks-approved HTML":


  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.