[10938] in Perl-Users-Digest
Perl-Users Digest, Issue: 4539 Volume: 8
daemon@ATHENA.MIT.EDU (Perl-Users Digest)
Sun Jan 3 19:07:23 1999
Date: Sun, 3 Jan 99 16:00:15 -0800
From: Perl-Users Digest <Perl-Users-Request@ruby.OCE.ORST.EDU>
To: Perl-Users@ruby.OCE.ORST.EDU (Perl-Users Digest)
Perl-Users Digest Sun, 3 Jan 1999 Volume: 8 Number: 4539
Today's topics:
ActiveState Perl/w32 & mSql-w32 module ? papick.taboada@ibm.net
Re: binary conversion (Tad McClellan)
Re: Freelance Perl writer needed ! l_lapu@yahoo.com
Help XS'ing a C function which malloc's its arguments. (Michael G Schwern)
Re: Is interpolation/parsing in s/// possible? <tchrist@mox.perl.com>
Re: Is interpolation/parsing in s/// possible? (Tad McClellan)
Re: LWP Tutorial hup@my-dejanews.com
Re: new to PERL..need help <eugene@verticalnet.com>
Re: New to perl (Darryl Beallie)
perl for win32 & visio <jont@uk.uu.net.nospam>
Rookie CGI problem (Miguel Fernandez)
Re: Rookie CGI problem mike@mjm.co.uk
Re: Rookie CGI problem (Miguel Fernandez)
Security & Permissions: Why can't Perl read files from <design@raincloud-studios.com>
Re: simple regular expression. <off-duty@entheosengineering.com>
Special: Digest Administrivia (Last modified: 12 Dec 98 (Perl-Users-Digest Admin)
----------------------------------------------------------------------
Date: Sun, 03 Jan 1999 22:56:00 -0800
From: papick.taboada@ibm.net
Subject: ActiveState Perl/w32 & mSql-w32 module ?
Message-Id: <36906600.CBB558FB@ibm.net>
Hallo!
Ich habe keinen win32 mSql.pm Modul bei ActiveState gefunden.
Hat das einen bestimmten Grund?
Da ich keinen C Kompiler auf meinem Rechner habe, kann ich
mir die Module nicht selber kompilieren. Ich habe aber auch
gelesen, das es nicht so einfach ginge...
Also, gibt es irgendwo funktionierende mSql Module fuer die
aktuelle Version von ActivePerl?
brgds
Papick
------------------------------
Date: Sun, 3 Jan 1999 17:28:53 -0600
From: tadmc@metronet.com (Tad McClellan)
Subject: Re: binary conversion
Message-Id: <lfuo67.uno.ln@magna.metronet.com>
todda (thirdwaver@inxpress.net) wrote:
: I am very new to perl and made a simple addition calculator.
: I have found printf function which can convert the $result to hex %x, octal
: %o and decimal is %d.
: ex: printf "The result in hex is %x\n", $result;
: I would like to create a decimal to binary converter is there a built in
: function of some sort to do this?
I don't know of any builtin, but this is Perl, so most things
are easily done in a few lines of code ;-)
(though I expect another followup will do it in much less...)
--------------
sub num2binary {
my($num) = @_;
my $binary = $num ? '' : '0'; # in case $num is zero
while ($num) {
$binary .= $num & 1 ? 1 : 0; # do the LSB
$num >>= 1; # on to the next bit
}
return scalar reverse $binary;
}
--------------
--
Tad McClellan SGML Consulting
tadmc@metronet.com Perl programming
Fort Worth, Texas
------------------------------
Date: Sun, 03 Jan 1999 21:34:50 GMT
From: l_lapu@yahoo.com
Subject: Re: Freelance Perl writer needed !
Message-Id: <76onpq$dc5$1@nnrp1.dejanews.com>
Ken,
Please contact l_lapu@yahoo.com for assistance.
-----------== Posted via Deja News, The Discussion Network ==----------
http://www.dejanews.com/ Search, Read, Discuss, or Start Your Own
------------------------------
Date: Sun, 03 Jan 1999 16:40:50 -0500
From: schwern@pobox.com (Michael G Schwern)
Subject: Help XS'ing a C function which malloc's its arguments.
Message-Id: <schwern-0301991640500001@news.erols.com>
Say I have a C function like:
int function(char *input, char **output) {
/* calculate size based on input */
/* allocate memory for output */
if ((*output = (char *)malloc(size)) == NULL)
return 0; /* malloc failure */
/* put stuff in output, based on input */
/* return success */
return 1;
}
Never mind the details, the fact that it does its own malloc() of an output
parameter is the important part. I wish to put an XS wrapper around this.
I tried the following XS prototype for it...
int
function(input, output)
char *input
char * &output = NO_INIT
OUTPUT:
output
Calling the function from perl as:
function($input, $output) || warn "function failed";
print $output;
This worked, but it has a memory leak, since perl is not aware that function()
allocates the memory for $output.
My question is:
How can I make perl aware that $output has had its memory allocated for it
and handle it appropriately?
I have looked at the char ** examples in perlxs, perlxstut, the
XScookbooks and here on clpm, but there are two differences with my
problem:
1) I am dealing with a pointer to a pointer to a string, not with an
array of character pointers.
2) The variable in question is not being returned by the function, it is
one of its arguments.
If I was returning the char **, (well, I'd return a char *) I would simply
do something like:
char *
function(input, flag)
char *input
int *flag
CODE:
char *tmp_output;
tmp_output = function(input, flag);
RETVAL = sv_2mortal(newSVpv(*tmp_output));
free(tmp_output);
OUTPUT:
RETVAL
(Something like that, anyway)
If I attempt a similar technique with int function(char *, char **)...
int
function(input, output)
char *input
char * &output
CODE:
SV *safe_output;
RETVAL = function(input, output);
safe_output = sv_2mortal(newSVpv(*output));
free(output);
/* How do I let XS know that safe_output should be on the
* argument stack in place of output?
*/
OUTPUT:
RETVAL
Any help or discussion is greatly appreciated.
BTW The actual code for this problem I'm having can be gotten from:
http://www.toldyouso.com/~stupid/Text-Metaphone-1.90.tar.gz
--
Michael G Schwern schwern@pobox.com
------------------------------
Date: 3 Jan 1999 22:29:49 GMT
From: Tom Christiansen <tchrist@mox.perl.com>
Subject: Re: Is interpolation/parsing in s/// possible?
Message-Id: <76or0t$1lh$1@csnews.cs.colorado.edu>
[courtesy cc of this posting sent to cited author via email]
In comp.lang.perl.misc, Jonathan Stowe <gellyfish@btinternet.com> writes:
:Using the eval() with the /e modifier seems (to me anyhow)
:to be the only way of doing this.
Using /ee seems more straightforward. But this is a strange
bunch of requirements, methinks.
--tom
--
I forgot what it was like to be a tester...
If you have a conscience, it's not easy
-- Dean Roehrich, soon after coming back from Marketing
------------------------------
Date: Sun, 3 Jan 1999 16:59:25 -0600
From: tadmc@metronet.com (Tad McClellan)
Subject: Re: Is interpolation/parsing in s/// possible?
Message-Id: <doso67.uno.ln@magna.metronet.com>
Mark Badolato (bady@primenet.com) wrote:
: Previously, tadmc@metronet.com (Tad McClellan) wrote:
: >Mark Badolato (bady@primenet.com) wrote:
: >: This may be a dumb question, but its 5:30am and I've pulled an all-nighter =)
: >
: >
: >: $name = "MARK";
: >: $regex = '\u\L$1';
: >: $name =~ s/(.*)/$regex/;
: >
: >
: > That is a very misleading choice of name for your variable.
: >
: > $regex does not contain a Regular Expression!
: >
: > It contains a replacement string.
[ snip stuff about \1 vs $1, Daniel already explained that part ]
: Which is used when? (sorry, im still just getting the hang regex stuff)
The \1 vs $1 was just one example to point out the big fundamental
problem that I think you are having.
The big problem is that you seem to think that the second part
of a s/// is a regular expression. It is not.
To get the hang of regex stuff:
1) perldoc perlre
2) perldoc perlop
3) read "Mastering Regular Expressions" published by O'Reilly
4) rest for several days
5) lather, rinse, repeat ;-)
Part 2) above would lead to this:
=item s/PATTERN/REPLACEMENT/egimosx
wherein it seems evident that the first part and second part
are significantly different.
Coming to grips with the difference will help with future regexen.
Good luck!
--
Tad McClellan SGML Consulting
tadmc@metronet.com Perl programming
Fort Worth, Texas
------------------------------
Date: Sun, 03 Jan 1999 23:01:24 GMT
From: hup@my-dejanews.com
Subject: Re: LWP Tutorial
Message-Id: <76oss4$hl5$1@nnrp1.dejanews.com>
Hi,
How about LWPng? I just don't be able to find any complete sample code to
learn ..
Thank a lot.
> You might try looking at the LWP homepage at
> <URL:http://www.sn.no/libwww-perl/> for starters - there are a number of
> useful links there.
>
> However the lwpcook.pod document that comes with the LWP distribution is
> a fairly good first tutorial on the subject. If you have not got this file
> then you can download the source from CPAN, unpack it and examine the file
> using perldoc.
>
-----------== Posted via Deja News, The Discussion Network ==----------
http://www.dejanews.com/ Search, Read, Discuss, or Start Your Own
------------------------------
Date: Sun, 03 Jan 1999 17:07:19 -0500
From: Eugene Sotirescu <eugene@verticalnet.com>
To: William Selbig <selbig@worldnet.att.net>
Subject: Re: new to PERL..need help
Message-Id: <368FEA17.886CE49F@verticalnet.com>
You need CGI enabled on your ISP's server to run CGI programs. Moreover, you
need Perl installed to run Perl CGI scripts (you can install your own Perl if
your ISP is so lame that they don't have it installed for everybody).
Check with your ISP, though: they might already have something that does what
you need. If they don't, they don't want your business (and you don't want
them).
William Selbig wrote:
> I'm trying to install a simple form on my web site so people can send info
> to me without going through email (even though that's how the script sends
> it to me).
>
> I use ATT Worldnet as an ISP. They don't have a cgi-bin. Can I still use a
> PERL script?
>
> Also, I copied the script from another source. I don't have PERL on my
> machine and I don't know if ATT does either. Do you need it to run the
> script?
>
> reply to: selbig@worldnet.att.net
------------------------------
Date: Sun, 03 Jan 1999 21:20:40 GMT
From: dbeallie@cyberus.ca (Darryl Beallie)
Subject: Re: New to perl
Message-Id: <368fdeca.195067281@news.cyberus.ca>
Thanks everybody for your comments. Very much appreciated! (and happy
new year too)
------------------------------
Date: Sun, 3 Jan 1999 21:07:57 -0000
From: "Jonathan Tracey" <jont@uk.uu.net.nospam>
Subject: perl for win32 & visio
Message-Id: <76omd3$3r6$1@plug.news.pipex.net>
Hi
Has anyone ever tried using perl and win32::OLE to create automatated visio
diagrams :-) Yes I know it sounds a whole world of hurt but I can make excel
do some nice things with perl but have never even written a macro in visio
so any hints would be nice :-)
Cheers
Jon
------------------------------
Date: Sun, 03 Jan 1999 13:36:44 -0800
From: mig@pwave.com (Miguel Fernandez)
Subject: Rookie CGI problem
Message-Id: <mig-0301991336440001@sji-ca5-44.ix.netcom.com>
I keep getting the message:
CGIwrap Error: System Error: execv() failed
Error: No such file or directory (2)
whenever I try to execute a MailForm.pl script. I've checked the paths to
the perl interpreter and to the sendmail program, and they're right. Can
anybody help me out with this one? Free tshirts to the first person that
helps me solve this.
Thanks
--
Miguel
mig@pwave.com
Pacific Wave Boardshop
Santa Cruz
pacificwave@pwave.com
http://www.pwave.com/
------------------------------
Date: Sun, 03 Jan 1999 22:23:06 GMT
From: mike@mjm.co.uk
Subject: Re: Rookie CGI problem
Message-Id: <368fedac.25249804@nntp.netcom.net.uk>
Could you post the script here so that we can see where the errors may
be generated from..
Mike
On Sun, 03 Jan 1999 13:36:44 -0800, mig@pwave.com (Miguel Fernandez)
wrote:
>I keep getting the message:
>
> CGIwrap Error: System Error: execv() failed
>
> Error: No such file or directory (2)
>
>whenever I try to execute a MailForm.pl script. I've checked the paths to
>the perl interpreter and to the sendmail program, and they're right. Can
>anybody help me out with this one? Free tshirts to the first person that
>helps me solve this.
>
>Thanks
>
>--
>Miguel
>mig@pwave.com
>
>Pacific Wave Boardshop
>Santa Cruz
>pacificwave@pwave.com
>http://www.pwave.com/
Mike
MjM Computer Publishing
http://www.mjm.co.uk
------------------------------
Date: Sun, 03 Jan 1999 15:08:40 -0800
From: mig@pwave.com (Miguel Fernandez)
Subject: Re: Rookie CGI problem
Message-Id: <mig-0301991508400001@sji-ca8-90.ix.netcom.com>
In article <368fedac.25249804@nntp.netcom.net.uk>, mike@mjm.co.uk wrote:
> Could you post the script here so that we can see where the errors may
> be generated from..
>
> Mike
Here it is...
#!/usr/local/bin/perl
##############################################################################
# FormMail Version 1.6 #
# Copyright 1995-1997 Matt Wright mattw@worldwidemart.com #
# Created 06/09/95 Last Modified 05/02/97 #
# Matt's Script Archive, Inc.: http://www.worldwidemart.com/scripts/ #
##############################################################################
# COPYRIGHT NOTICE #
# Copyright 1995-1997 Matthew M. Wright All Rights Reserved. #
# #
# FormMail may be used and modified free of charge by anyone so long as this #
# copyright notice and the comments above remain intact. By using this #
# code you agree to indemnify Matthew M. Wright from any liability that #
# might arise from its use. #
# #
# Selling the code for this program without prior written consent is #
# expressly forbidden. In other words, please ask first before you try and #
# make money off of my program. #
# #
# Obtain permission before redistributing this software over the Internet or #
# in any other medium. In all cases copyright and header must remain intact #
##############################################################################
# Define Variables #
# Detailed Information Found In README File. #
# $mailprog defines the location of your sendmail program on your unix #
# system. #
$mailprog = '/usr/lib/sendmail';
# @referers allows forms to be located only on servers which are defined #
# in this field. This security fix from the last version which allowed #
# anyone on any server to use your FormMail script on their web site. #
@referers = ('pwave.com', 209.110.38.196);
# Done #
##############################################################################
# Check Referring URL
&check_url;
# Retrieve Date
&get_date;
# Parse Form Contents
&parse_form;
# Check Required Fields
&check_required;
# Return HTML Page or Redirect User
&return_html;
# Send E-Mail
&send_mail;
sub check_url {
# Localize the check_referer flag which determines if user is valid. #
local($check_referer) = 0;
# If a referring URL was specified, for each valid referer, make sure #
# that a valid referring URL was passed to FormMail. #
if ($ENV{'HTTP_REFERER'}) {
foreach $referer (@referers) {
if ($ENV{'HTTP_REFERER'} =~ m|https?://([^/]*)$referer|i) {
$check_referer = 1;
last;
}
}
}
else {
$check_referer = 1;
}
# If the HTTP_REFERER was invalid, send back an error. #
if ($check_referer != 1) { &error('bad_referer') }
}
sub get_date {
# Define arrays for the day of the week and month of the year. #
@days = ('Sunday','Monday','Tuesday','Wednesday',
'Thursday','Friday','Saturday');
@months = ('January','February','March','April','May','June','July',
'August','September','October','November','December');
# Get the current time and format the hour, minutes and seconds. Add #
# 1900 to the year to get the full 4 digit year. #
($sec,$min,$hour,$mday,$mon,$year,$wday) = (localtime(time))[0,1,2,3,4,5,6];
$time = sprintf("%02d:%02d:%02d",$hour,$min,$sec);
$year += 1900;
# Format the date. #
$date = "$days[$wday], $months[$mon] $mday, $year at $time";
}
sub parse_form {
# Define the configuration associative array. #
%Config = ('recipient','', 'subject','',
'email','', 'realname','',
'redirect','', 'bgcolor','',
'background','', 'link_color','',
'vlink_color','', 'text_color','',
'alink_color','', 'title','',
'sort','', 'print_config','',
'required','', 'env_report','',
'return_link_title','', 'return_link_url','',
'print_blank_fields','', 'missing_fields_redirect','');
# Determine the form's REQUEST_METHOD (GET or POST) and split the form #
# fields up into their name-value pairs. If the REQUEST_METHOD was #
# not GET or POST, send an error. #
if ($ENV{'REQUEST_METHOD'} eq 'GET') {
# Split the name-value pairs
@pairs = split(/&/, $ENV{'QUERY_STRING'});
}
elsif ($ENV{'REQUEST_METHOD'} eq 'POST') {
# Get the input
read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
# Split the name-value pairs
@pairs = split(/&/, $buffer);
}
else {
&error('request_method');
}
# For each name-value pair: #
foreach $pair (@pairs) {
# Split the pair up into individual variables. #
local($name, $value) = split(/=/, $pair);
# Decode the form encoding on the name and value variables. #
$name =~ tr/+/ /;
$name =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
$value =~ tr/+/ /;
$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
# If they try to include server side includes, erase them, so they
# aren't a security risk if the html gets returned. Another
# security hole plugged up.
$value =~ s/<!--(.|\n)*-->//g;
# If the field name has been specified in the %Config array, it will #
# return a 1 for defined($Config{$name}}) and we should associate #
# this value with the appropriate configuration variable. If this #
# is not a configuration form field, put it into the associative #
# array %Form, appending the value with a ', ' if there is already a #
# value present. We also save the order of the form fields in the #
# @Field_Order array so we can use this order for the generic sort. #
if (defined($Config{$name})) {
$Config{$name} = $value;
}
else {
if ($Form{$name} && $value) {
$Form{$name} = "$Form{$name}, $value";
}
elsif ($value) {
push(@Field_Order,$name);
$Form{$name} = $value;
}
}
}
# The next six lines remove any extra spaces or new lines from the #
# configuration variables, which may have been caused if your editor #
# wraps lines after a certain length or if you used spaces between field #
# names or environment variables. #
$Config{'required'} =~ s/(\s+|\n)?,(\s+|\n)?/,/g;
$Config{'required'} =~ s/(\s+)?\n+(\s+)?//g;
$Config{'env_report'} =~ s/(\s+|\n)?,(\s+|\n)?/,/g;
$Config{'env_report'} =~ s/(\s+)?\n+(\s+)?//g;
$Config{'print_config'} =~ s/(\s+|\n)?,(\s+|\n)?/,/g;
$Config{'print_config'} =~ s/(\s+)?\n+(\s+)?//g;
# Split the configuration variables into individual field names. #
@Required = split(/,/,$Config{'required'});
@Env_Report = split(/,/,$Config{'env_report'});
@Print_Config = split(/,/,$Config{'print_config'});
}
sub check_required {
# Localize the variables used in this subroutine. #
local($require, @error);
if (!$Config{'recipient'}) {
if (!defined(%Form)) { &error('bad_referer') }
else { &error('no_recipient') }
}
# For each require field defined in the form: #
foreach $require (@Required) {
# If the required field is the email field, the syntax of the email #
# address if checked to make sure it passes a valid syntax. #
if ($require eq 'email' && !&check_email($Config{$require})) {
push(@error,$require);
}
# Otherwise, if the required field is a configuration field and it #
# has no value or has been filled in with a space, send an error. #
elsif (defined($Config{$require})) {
if (!$Config{$require}) {
push(@error,$require);
}
}
# If it is a regular form field which has not been filled in or #
# filled in with a space, flag it as an error field. #
elsif (!$Form{$require}) {
push(@error,$require);
}
}
# If any error fields have been found, send error message to the user. #
if (@error) { &error('missing_fields', @error) }
}
sub return_html {
# Local variables used in this subroutine initialized. #
local($key,$sort_order,$sorted_field);
# If redirect option is used, print the redirectional location header. #
if ($Config{'redirect'}) {
print "Location: $Config{'redirect'}\n\n";
}
# Otherwise, begin printing the response page. #
else {
# Print HTTP header and opening HTML tags. #
print "Content-type: text/html\n\n";
print "<html>\n <head>\n";
# Print out title of page #
if ($Config{'title'}) { print " <title>$Config{'title'}</title>\n" }
else { print " <title>Thank You</title>\n" }
print " </head>\n <body";
# Get Body Tag Attributes #
&body_attributes;
# Close Body Tag #
print ">\n <center>\n";
# Print custom or generic title. #
if ($Config{'title'}) { print " <h1>$Config{'title'}</h1>\n" }
else { print " <h1>Thank You For Filling Out This Form</h1>\n" }
print "</center>\n";
print "Below is what you submitted to $Config{'recipient'} on ";
print "$date<p><hr size=1 width=75\%><p>\n";
# Sort alphabetically if specified: #
if ($Config{'sort'} eq 'alphabetic') {
foreach $field (sort keys %Form) {
# If the field has a value or the print blank fields option #
# is turned on, print out the form field and value. #
if ($Config{'print_blank_fields'} || $Form{$field}) {
print "<b>$field:</b> $Form{$field}<p>\n";
}
}
}
# If a sort order is specified, sort the form fields based on that. #
elsif ($Config{'sort'} =~ /^order:.*,.*/) {
# Set the temporary $sort_order variable to the sorting order, #
# remove extraneous line breaks and spaces, remove the order: #
# directive and split the sort fields into an array. #
$sort_order = $Config{'sort'};
$sort_order =~ s/(\s+|\n)?,(\s+|\n)?/,/g;
$sort_order =~ s/(\s+)?\n+(\s+)?//g;
$sort_order =~ s/order://;
@sorted_fields = split(/,/, $sort_order);
# For each sorted field, if it has a value or the print blank #
# fields option is turned on print the form field and value. #
foreach $sorted_field (@sorted_fields) {
if ($Config{'print_blank_fields'} || $Form{$sorted_field}) {
print "<b>$sorted_field:</b> $Form{$sorted_field}<p>\n";
}
}
}
# Otherwise, default to the order in which the fields were sent. #
else {
# For each form field, if it has a value or the print blank #
# fields option is turned on print the form field and value. #
foreach $field (@Field_Order) {
if ($Config{'print_blank_fields'} || $Form{$field}) {
print "<b>$field:</b> $Form{$field}<p>\n";
}
}
}
print "<p><hr size=1 width=75%><p>\n";
# Check for a Return Link and print one if found. #
if ($Config{'return_link_url'} && $Config{'return_link_title'}) {
print "<ul>\n";
print "<li><a
href=\"$Config{'return_link_url'}\">$Config{'return_link_title'}</a>\n";
print "</ul>\n";
}
# Print the page footer. #
print <<"(END HTML FOOTER)";
<hr size=1 width=75%><p>
<center><font size=-1><a
href="http://www.worldwidemart.com/scripts/formmail.shtml">FormMail</a>
V1.6 © 1995 -1997 Matt Wright<br>
A Free Product of <a href="http://www.worldwidemart.com/scripts/">Matt's
Script Archive, Inc.</a></font></center>
</body>
</html>
(END HTML FOOTER)
}
}
sub send_mail {
# Localize variables used in this subroutine. #
local($print_config,$key,$sort_order,$sorted_field,$env_report);
# Open The Mail Program
open(MAIL,"|$mailprog -t");
print MAIL "To: $Config{'recipient'}\n";
print MAIL "From: $Config{'email'} ($Config{'realname'})\n";
# Check for Message Subject
if ($Config{'subject'}) { print MAIL "Subject: $Config{'subject'}\n\n" }
else { print MAIL "Subject: WWW Form Submission\n\n" }
print MAIL "Below is the result of your feedback form. It was
submitted by\n";
print MAIL "$Config{'realname'} ($Config{'email'}) on $date\n";
print MAIL "-" x 75 . "\n\n";
if (@Print_Config) {
foreach $print_config (@Print_Config) {
if ($Config{$print_config}) {
print MAIL "$print_config: $Config{$print_config}\n\n";
}
}
}
# Sort alphabetically if specified: #
if ($Config{'sort'} eq 'alphabetic') {
foreach $field (sort keys %Form) {
# If the field has a value or the print blank fields option #
# is turned on, print out the form field and value. #
if ($Config{'print_blank_fields'} || $Form{$field} ||
$Form{$field} eq '0') {
print MAIL "$field: $Form{$field}\n\n";
}
}
}
# If a sort order is specified, sort the form fields based on that. #
elsif ($Config{'sort'} =~ /^order:.*,.*/) {
# Remove extraneous line breaks and spaces, remove the order: #
# directive and split the sort fields into an array. #
$Config{'sort'} =~ s/(\s+|\n)?,(\s+|\n)?/,/g;
$Config{'sort'} =~ s/(\s+)?\n+(\s+)?//g;
$Config{'sort'} =~ s/order://;
@sorted_fields = split(/,/, $Config{'sort'});
# For each sorted field, if it has a value or the print blank #
# fields option is turned on print the form field and value. #
foreach $sorted_field (@sorted_fields) {
if ($Config{'print_blank_fields'} || $Form{$sorted_field} ||
$Form{$sorted_field} eq '0') {
print MAIL "$sorted_field: $Form{$sorted_field}\n\n";
}
}
}
# Otherwise, default to the order in which the fields were sent. #
else {
# For each form field, if it has a value or the print blank #
# fields option is turned on print the form field and value. #
foreach $field (@Field_Order) {
if ($Config{'print_blank_fields'} || $Form{$field} ||
$Form{$field} eq '0') {
print MAIL "$field: $Form{$field}\n\n";
}
}
}
print MAIL "-" x 75 . "\n\n";
# Send any specified Environment Variables to recipient. #
foreach $env_report (@Env_Report) {
if ($ENV{$env_report}) {
print MAIL "$env_report: $ENV{$env_report}\n";
}
}
close (MAIL);
}
sub check_email {
# Initialize local email variable with input to subroutine. #
$email = $_[0];
# If the e-mail address contains: #
if ($email =~ /(@.*@)|(\.\.)|(@\.)|(\.@)|(^\.)/ ||
# the e-mail address contains an invalid syntax. Or, if the #
# syntax does not match the following regular expression pattern #
# it fails basic syntax verification. #
$email !~
/^.+\@(\[?)[a-zA-Z0-9\-\.]+\.([a-zA-Z]{2,3}|[0-9]{1,3})(\]?)$/) {
# Basic syntax requires: one or more characters before the @ sign, #
# followed by an optional '[', then any number of letters, numbers, #
# dashes or periods (valid domain/IP characters) ending in a period #
# and then 2 or 3 letters (for domain suffixes) or 1 to 3 numbers #
# (for IP addresses). An ending bracket is also allowed as it is #
# valid syntax to have an email address like: user@[255.255.255.0] #
# Return a false value, since the e-mail address did not pass valid #
# syntax. #
return 0;
}
else {
# Return a true value, e-mail verification passed. #
return 1;
}
}
sub body_attributes {
# Check for Background Color
if ($Config{'bgcolor'}) { print " bgcolor=\"$Config{'bgcolor'}\"" }
# Check for Background Image
if ($Config{'background'}) { print " background=\"$Config{'background'}\"" }
# Check for Link Color
if ($Config{'link_color'}) { print " link=\"$Config{'link_color'}\"" }
# Check for Visited Link Color
if ($Config{'vlink_color'}) { print " vlink=\"$Config{'vlink_color'}\"" }
# Check for Active Link Color
if ($Config{'alink_color'}) { print " alink=\"$Config{'alink_color'}\"" }
# Check for Body Text Color
if ($Config{'text_color'}) { print " text=\"$Config{'text_color'}\"" }
}
sub error {
# Localize variables and assign subroutine input. #
local($error,@error_fields) = @_;
local($host,$missing_field,$missing_field_list);
if ($error eq 'bad_referer') {
if ($ENV{'HTTP_REFERER'} =~ m|^https?://([\w\.]+)|i) {
$host = $1;
print <<"(END ERROR HTML)";
Content-type: text/html
<html>
<head>
<title>Bad Referrer - Access Denied</title>
</head>
<body bgcolor=#FFFFFF text=#000000>
<center>
<table border=0 width=600 bgcolor=#9C9C9C>
<tr><th><font size=+2>Bad Referrer - Access Denied</font></th></tr>
</table>
<table border=0 width=600 bgcolor=#CFCFCF>
<tr><td>The form attempting to use
<a href="http://www.worldwidemart.com/scripts/formmail.shtml">FormMail</a>
resides at <tt>$ENV{'HTTP_REFERER'}</tt>, which is not allowed to access
this cgi script.<p>
If you are attempting to configure FormMail to run with this form, you need
to add the following to \@referers, explained in detail in the README
file.<p>
Add <tt>'$host'</tt> to your <tt><b>\@referers</b></tt> array.<hr size=1>
<center><font size=-1>
<a
href="http://www.worldwidemart.com/scripts/formmail.shtml">FormMail</a>
V1.6 © 1995 - 1997 Matt Wright<br>
A Free Product of <a
href="http://www.worldwidemart.com/scripts/">Matt's Script Archive,
Inc.</a>
</font></center>
</td></tr>
</table>
</center>
</body>
</html>
(END ERROR HTML)
}
else {
print <<"(END ERROR HTML)";
Content-type: text/html
<html>
<head>
<title>FormMail v1.6</title>
</head>
<body bgcolor=#FFFFFF text=#000000>
<center>
<table border=0 width=600 bgcolor=#9C9C9C>
<tr><th><font size=+2>FormMail</font></th></tr>
</table>
<table border=0 width=600 bgcolor=#CFCFCF>
<tr><th><tt><font size=+1>Copyright 1995 - 1997 Matt Wright<br>
Version 1.6 - Released May 02, 1997<br>
A Free Product of <a
href="http://www.worldwidemart.com/scripts/">Matt's Script Archive,
Inc.</a></font></tt></th></tr>
</table>
</center>
</body>
</html>
(END ERROR HTML)
}
}
elsif ($error eq 'request_method') {
print <<"(END ERROR HTML)";
Content-type: text/html
<html>
<head>
<title>Error: Request Method</title>
</head>
<body bgcolor=#FFFFFF text=#000000>
<center>
<table border=0 width=600 bgcolor=#9C9C9C>
<tr><th><font size=+2>Error: Request Method</font></th></tr>
</table>
<table border=0 width=600 bgcolor=#CFCFCF>
<tr><td>The Request Method of the Form you submitted did not match
either <tt>GET</tt> or <tt>POST</tt>. Please check the form and make
sure the
<tt>method=</tt> statement is in upper case and matches <tt>GET</tt>
or <tt>POST</tt>.<p>
<center><font size=-1>
<a
href="http://www.worldwidemart.com/scripts/formmail.shtml">FormMail</a>
V1.6 © 1995 - 1997 Matt Wright<br>
A Free Product of <a
href="http://www.worldwidemart.com/scripts/">Matt's Script Archive,
Inc.</a>
</font></center>
</td></tr>
</table>
</center>
</body>
</html>
(END ERROR HTML)
}
elsif ($error eq 'no_recipient') {
print <<"(END ERROR HTML)";
Content-type: text/html
<html>
<head>
<title>Error: No Recipient</title>
</head>
<body bgcolor=#FFFFFF text=#000000>
<center>
<table border=0 width=600 bgcolor=#9C9C9C>
<tr><th><font size=+2>Error: No Recipient</font></th></tr>
</table>
<table border=0 width=600 bgcolor=#CFCFCF>
<tr><td>No Recipient was specified in the data sent to FormMail. Please
make sure you have filled in the 'recipient' form field with an e-mail
address. More information on filling in recipient form fields can be
found in the README file.<hr size=1>
<center><font size=-1>
<a
href="http://www.worldwidemart.com/scripts/formmail.shtml">FormMail</a>
V1.6 © 1995 - 1997 Matt Wright<br>
A Free Product of <a
href="http://www.worldwidemart.com/scripts/">Matt's Script Archive,
Inc.</a>
</font></center>
</td></tr>
</table>
</center>
</body>
</html>
(END ERROR HTML)
}
elsif ($error eq 'missing_fields') {
if ($Config{'missing_fields_redirect'}) {
print "Location: $Config{'missing_fields_redirect'}\n\n";
}
else {
foreach $missing_field (@error_fields) {
$missing_field_list .= " <li>$missing_field\n";
}
print <<"(END ERROR HTML)";
Content-type: text/html
<html>
<head>
<title>Error: Blank Fields</title>
</head>
<center>
<table border=0 width=600 bgcolor=#9C9C9C>
<tr><th><font size=+2>Error: Blank Fields</font></th></tr>
</table>
<table border=0 width=600 bgcolor=#CFCFCF>
<tr><td>The following fields were left blank in your submission form:<p>
<ul>
$missing_field_list
</ul><br>
These fields must be filled in before you can successfully submit the
form.<p>
Please use your browser's back button to return to the form and try
again.<hr size=1>
<center><font size=-1>
<a
href="http://www.worldwidemart.com/scripts/formmail.shtml">FormMail</a>
V1.6 © 1995 - 1997 Matt Wright<br>
A Free Product of <a
href="http://www.worldwidemart.com/scripts/">Matt's Script Archive,
Inc.</a>
</font></center>
</td></tr>
</table>
</center>
</body>
</html>
(END ERROR HTML)
}
}
exit;
}
--
Miguel
mig@pwave.com
Pacific Wave Boardshop
Santa Cruz
pacificwave@pwave.com
http://www.pwave.com/
------------------------------
Date: 3 Jan 1999 23:57:49 GMT
From: "Charles R. Thompson" <design@raincloud-studios.com>
Subject: Security & Permissions: Why can't Perl read files from the owner level?
Message-Id: <76p05t$13h@bgtnsc01.worldnet.att.net>
So how in the heck does someone protect a directory from outside access when
Perl seems to require at least a 755 before it will read a file in it?
I'm able to read my libraries when they are rw-r--r-- .. I am assuming this
is because I am using require. However, if I have a users.db(rw-r--r--) file
in a subdirectory under cgi-bin which I OPEN , CgiDie complains it cannot
open the file. Change the permissions so the whole world can peek at it and
it works fine.
My script is a mod of one I downloaded where require was used, then the file
parsed and printed to the browser. This seems like excessive overhead when I
feel my Perl script should be able to read the file directly.
I guess my *real* question is how can Perl read a file I *want* set to
rw-r-r?
Am I incredibly dense today?
CT
------------------------------
Date: Sun, 03 Jan 1999 17:21:51 -0600
From: Rich Grise <off-duty@entheosengineering.com>
To: Rahul K <rahulk@iname.com>
Subject: Re: simple regular expression.
Message-Id: <368FFB8F.939FC5B@entheosengineering.com>
Rahul K wrote:
>
> Hi,
> I am a newbie.
> I have a string stored in $in{"fField".
> I need to convert the string (please notice the dot at the end)
>
> <http://www.foo.com/abc.html>.
> into
> <a href="http://www.foo.com/abc.html">http://www.foo.com/abc.html</a>.
>
> and
>
> <http://www.foo.com/abc.html>
> into
> <a href="http://www.foo.com/abc.html">http://www.foo.com/abc.html</a>
>
> here is my script:
>
> $in{"fField"} =~ s/(http:\/\/\S+)(.*)/ <a href=$1
> target=\"_blank\">$1<\/a> $2/g;
>
> the problem with this is that after I run the script, I get the
> following (notice that the dot is *inside*)
>
> <a href="http://www.foo.com/abc.html.">http://www.foo.com/abc.html.</a>
>
Yeah, you're matching on "non-whitespace", so what I've come up with is:
#!/usr/bin/perl -w
my ($the_line, $the_url, $the_dot, $the_rest);
#$the_line = $in{"fField"};
print "--> ";
$the_line = <STDIN>;
if ($the_line =~ m|(http://\S+)(.*)|) {
$the_url = $1;
$the_rest = $2;
if ($the_url =~ s/(.*)(\.)$/$1/) {
$the_dot = $2;
}
print "<a href=\"$the_url\" target=\"_blank\">",
"$the_url</a>$the_dot $the_rest<br>\n";
}
And when I run it at the prompt, I get:
$ spliturl
--> http://blahblah.com/whatever. WHatever!
<a href="http://blahblah.com/whatever"
target="_blank">http://blahblah.com/whatever</a>. WHatever!<br>
^ note dot.
> thanks,
>
> -rahul
My Pleasure!
--
Rich Grise
off-duty@entheosengineering.com
(No need to futz with my e-mail: I have a "delete" button!)
------------------------------
Date: 12 Dec 98 21:33:47 GMT (Last modified)
From: Perl-Request@ruby.oce.orst.edu (Perl-Users-Digest Admin)
Subject: Special: Digest Administrivia (Last modified: 12 Dec 98)
Message-Id: <null>
Administrivia:
Well, after 6 months, here's the answer to the quiz: what do we do about
comp.lang.perl.moderated. Answer: nothing.
]From: Russ Allbery <rra@stanford.edu>
]Date: 21 Sep 1998 19:53:43 -0700
]Subject: comp.lang.perl.moderated available via e-mail
]
]It is possible to subscribe to comp.lang.perl.moderated as a mailing list.
]To do so, send mail to majordomo@eyrie.org with "subscribe clpm" in the
]body. Majordomo will then send you instructions on how to confirm your
]subscription. This is provided as a general service for those people who
]cannot receive the newsgroup for whatever reason or who just prefer to
]receive messages via e-mail.
The Perl-Users Digest is a retransmission of the USENET newsgroup
comp.lang.perl.misc. For subscription or unsubscription requests, send
the single line:
subscribe perl-users
or:
unsubscribe perl-users
to almanac@ruby.oce.orst.edu.
To submit articles to comp.lang.perl.misc (and this Digest), send your
article to perl-users@ruby.oce.orst.edu.
To submit articles to comp.lang.perl.announce, send your article to
clpa@perl.com.
To request back copies (available for a week or so), send your request
to almanac@ruby.oce.orst.edu with the command "send perl-users x.y",
where x is the volume number and y is the issue number.
The Meta-FAQ, an article containing information about the FAQ, is
available by requesting "send perl-users meta-faq". The real FAQ, as it
appeared last in the newsgroup, can be retrieved with the request "send
perl-users FAQ". Due to their sizes, neither the Meta-FAQ nor the FAQ
are included in the digest.
The "mini-FAQ", which is an updated version of the Meta-FAQ, is
available by requesting "send perl-users mini-faq". It appears twice
weekly in the group, but is not distributed in the digest.
For other requests pertaining to the digest, send mail to
perl-users-request@ruby.oce.orst.edu. Do not waste your time or mine
sending perl questions to the -request address, I don't have time to
answer them even if I did know the answer.
------------------------------
End of Perl-Users Digest V8 Issue 4539
**************************************
