Beefy Boxes and Bandwidth Generously Provided by pair Networks
more useful options
 
PerlMonks  

Re: Re: Sending HTML email and a slightly related 500 error

by FoncÚ (Scribe)
on May 16, 2003 at 14:43 UTC ( #258660=note: print w/replies, xml ) Need Help??


in reply to Re: Sending HTML email and a slightly related 500 error
in thread Sending HTML email and a slightly related 500 error

Taking ideas from both of you, I rewrote the code and came up with the following, which does not work, but I assume is pretty close to doing so. Here's the programme in its entirety:
#!/usr/bin/perl ####################################### # Custom Modified Form Mailer # Based on fmail.pl # All due credit hereby granted to original authors/editors # Created 7/8/02 Last Modified 5/14/03 # Version 3.22 ####################################### use MIME::Lite; MIME::Lite->send('sendmail', "/bin/sendmail"); ###################### # A date for those with no /bin/date # @junk = localtime(time); $date = (Jan,Feb,Mar,Apr,May,Jun,Jul,Aug,Sep,Oct,Nov,Dec)[$junk[4]]; $junk[5] += 1900; $date .= "-" . $junk[3] . "-" . $junk[5]; $date .= " " . $junk[2] . ":" . $junk[1] . " EST"; $datafile = '/etc/hosts'; ###################### ######################## # A subroutine to die gracefully under html ######################## sub safe_die { print "Content-type: text/plain\n\n"; print @_,"\n"; exit(0); } read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'}); $finddomain = $ENV{'HTTP_REFERER'}; if ($finddomain eq "") { &safe_die("This script requires data via an HTML form. It can +not run independently."); } $finddomain = lc($finddomain); $finddomain =~ s/^http:\/\///; $finddomain =~ s/^www\.//; ($finddomain, $junk) = split(/\//, $finddomain, 2); &check_exists($finddomain); # Split the name-value pairs @pairs = split(/&/, $buffer); foreach $pair (@pairs) { ($name, $value) = split(/=/, $pair); # Un-Webify plus signs and %-encoding $value =~ tr/+/ /; $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg; $name =~ tr/+/ /; $name =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg; $FORM{$name} = $value; } ###### Dealing with the recipient and user's real name ###### $salesman = $FORM{user}; @sman[1] = "*** name of user ***"; @sman[2] = "*** name of user ***"; @addy[1] = 'mail@company.com'; @addy[2] = 'testmail@company.com'; #@addy[2] = 'realothermail@company.com'; $rn = $sman[$salesman]; $uname = $addy[$salesman]; ######## Send mail to the Salesman ######## $msg = MIME::Lite->new ( To =>'$uname', Cc =>'ccrecip@company.com', Subject =>$FORM{'subject'}, Type =>'multipart/mixed' ); $msg->attach(Type => 'text/html', Data => qq~ <html> <body> <table> <tr> <td width=500> <h3>Daily Salesman's Report</h3><br><br> Salesman: $rn<br><br> <table border=0> <tr> <td> Bakery:<br><br> Location: </td><td> <input name="bakery" value="$FORM{bakery}"><br><br> <input name="location" value="$FORM{location}"> </td> <td width=30> </td> <td> Date:<br><br> 1st Visit?: </td> <td> <input name="date" size=8 value="$FORM{date}"><br><br> <input name="visit" value="$FORM{visit}"> </td> </tr> <tr> <td>Contacts:</td> <td></td> <td></td> </tr> <tr> <td align=right> 1.<br> 2.<br> 3.<br> </td> <td> <input name="contact_1" value="$FORM{contact_1}"><br> <input name="contact_2" value="$FORM{contact_2}"><br> <input name="contact_3" value="$FORM{contact_3}"> </td> <td width=30> </td> <td colspan=2> In Office Use (Route to):<br> &nbsp;&nbsp;&nbsp;Sales <input type="radio" name="route_to" value="sa +les"> &nbsp;&nbsp;Acct <input type="radio" name="route_to" value="accountin +g"><br> &nbsp;&nbsp;&nbsp;Eng&nbsp;&nbsp;&nbsp;<input type="radio" name="route +_to" value="engineering"> &nbsp;&nbsp;Mfg&nbsp;&nbsp;<input type="radio" name="route_to" value= +"manufacturing"> </td> </tr> </table> Topics discussed:<br> <textarea wrap=physical name="topics_discussed" rows=8 cols=80 value=" +$FORM{topics_discussed}"></textarea> <br><br> Action Taken:<br> <textarea wrap=physical name="action_taken" rows=8 cols=80 value="$FOR +M{action_taken}"></textarea> <br><br> Action Needed:<br> <textarea wrap=physical name="action_needed" rows=8 cols=80 value="$FO +RM{action_needed}"></textarea> <br><br> Follow Up Needed:<br> <textarea wrap=physical name="follow_up" rows=8 cols=80 value="$FORM{f +olow_up}"></textarea> <br><br> Other:<br> <textarea wrap=physical name="first_visit_info" rows=8 cols=80 value=" +$FORM{first_visit_info}"></textarea> <hr> </td> </tr> </table> </body> </html> ~); $msg->send; ######## SUB for checking if domain exists ######## sub check_exists { $chkdomain = shift; $found = 0; open(DB, "<$datafile") || &safe_die("Cannot open data file"); while ($lin = <DB>) { chop($lin); ($rest,$tmpdomain) = split(/\s/, $lin, 3); $tmpdomain=~s/\s+//g; if ($tmpdomain eq $chkdomain) { $found = 1; last; } if ($chkdomain eq "https:") { $found = 1; last; } next; } close(DB); if ($found == 0) { &safe_die("$chkdomain Domain does not exist on this server"); } }
Any ideas as to what's wrong? It passes a script checker as far as syntax and such.

FoncÚ

Replies are listed 'Best First'.
Re: Re: Re: Sending HTML email and a slightly related 500 error
by Jenda (Abbot) on May 16, 2003 at 15:32 UTC
    Define "doesn't work". That phrase is the most unhelpful thing you can ever say about a piece of code. What does it do that you didn't expect, or what doesn't it do that you expected?
        -- Jeff 'japhy' Pinyan <japhy@pobox.com>

    I've noticed you are parsing the CGI query/posted data yourself. You definitely should not. Sorry to say almost the same I said before again but ... please use a module. CGI, CGI::Lite, maybe even CGI::Deurl, but please do not use your own code for this.

    Jenda
    Always code as if the guy who ends up maintaining your code will be a violent psychopath who knows where you live.
       -- Rick Osborne

    Edit by castaway: Closed small tag in signature

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: note [id://258660]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others having an uproarious good time at the Monastery: (2)
As of 2023-04-02 09:33 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found

    Notices?