[16300] in Perl-Users-Digest
Perl-Users Digest, Issue: 3712 Volume: 9
daemon@ATHENA.MIT.EDU (Perl-Users Digest)
Tue Jul 18 09:43:02 2000
Date: Tue, 18 Jul 2000 06:42:42 -0700 (PDT)
From: Perl-Users Digest <Perl-Users-Request@ruby.OCE.ORST.EDU>
To: Perl-Users@ruby.OCE.ORST.EDU (Perl-Users Digest)
Message-Id: <963927761-v9-i3712@ruby.oce.orst.edu>
Content-Type: text
Perl-Users Digest Tue, 18 Jul 2000 Volume: 9 Number: 3712
Today's topics:
Difficulties to install just a few simple script !!! (Michelle Dawkins)
Re: E-mail processor (Abigail)
Re: easy one for xperienced users.. hard for me... (Bob Walton)
Re: easy one for xperienced users.. hard for me... (jason iversen)
easy: forms and frames (n)
Re: easy: forms and frames (Abigail)
Emacs modules for Perl programming (Jari Aalto+mail.perl)
Emulating a HTML form (Guy)
escaping HTML [was: limits on GET] (jason)
Re: escaping HTML [was: limits on GET] (Prasanth A. Kumar)
Re: escaping HTML [was: limits on GET] (jason)
Re: Escaping strings. (Ilmari Karonen)
Digest Administrivia (Last modified: 16 Sep 99) (Perl-Users-Digest Admin)
----------------------------------------------------------------------
Date: 16 Jul 2000 22:20:02 GMT
From: surinder@my-deja.com.bbs@openbazaar.net (Michelle Dawkins)
Subject: Difficulties to install just a few simple script !!!
Message-Id: <3bQbh2$UqJ@openbazaar.net>
I just download a file name FormMail.pl from Matt Archives.
I tried to install it but the error message keep coming out.
My server is something like 206.31.72.205
I tried but got the same error .That i have not replaced the
variable referers with my IP address.Even though i did that many time
repeatedly ,error like "internal problem" keep popping up.
I have a cgi bin at 206.31.72.205/cgi-bin
but i don't know where is my #!/usr/bin/perl ?????
Can somebody reply to this article and replaced
my IP address exactly where it is needed ?
I have no background whatsoever in Computer.
Please help
#!/usr/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 = ('worldwidemart.com','206.31.72.203');
#
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;
}
Sent via Deja.com http://www.deja.com/
Before you buy.
------------------------------
Date: 17 Jul 2000 20:00:09 GMT
From: abigail@delanet.com.bbs@openbazaar.net (Abigail)
Subject: Re: E-mail processor
Message-Id: <3bRNa9$VW8@openbazaar.net>
Screndib (screndib@aol.com) wrote on MMDX September MCMXCIII in
<URL:news:20000715191301.18156.00000372@ng-mb1.aol.com>:
`' I need a way to analyze e-mail that is in this form:
`'
`' --------------------------------------------------
`' Fill in an 'x' in the box next to your choice.
`'
`' A[]
`' B[]
`' C[]
`' D[]
`' E[]
`'
`' Num: 2498
`' --------------------------------------------------
`'
`' It needs to record the marks in some way so they can be displayed and edited
`' another program. It must also be able to handle screwed up input. I've seen
`' mails like this before, so I would think that there would be the code out the
`' somewhere. Can someone point me in the right direction?
Somewhere, I would do:
/([A-E])\[x\]/ and $totals {$1} ++;
`' If there isn't something I can use, can someone give me some tips on how I
`' would start on this?
Your specification is extremely vague, and you provided not a singly byte
of your own code.
This isn't a "do my work for me" group.
But here's a tip anyway. Always use -w. Always use strict.
Abigail
--
srand 123456;$-=rand$_--=>@[[$-,$_]=@[[$_,$-]for(reverse+1..(@[=split
//=>"IGrACVGQ\x02GJCWVhP\x02PL\x02jNMP"));print+(map{$_^q^"^}@[),"\n"
------------------------------
Date: 11 Jul 2000 20:50:02 GMT
From: bwalton@rochester.rr.com.bbs@openbazaar.net (Bob Walton)
Subject: Re: easy one for xperienced users.. hard for me...
Message-Id: <3bMe2W$TTf@openbazaar.net>
jason iversen wrote:
>
> hi all,
>
> i have two files, A & B. all i want to do is merge the B with the A.
>
> they have the same structure, are text files and are laid out thusly:
>
> ...<bof>..
>
> command {
> help {
> "airbubble: help info"
> }
> name "airbubble"
> label "airbubble"
> default "airbubble"
>
> ... many more little structures contained by {}
> ... so fundamentally, this structure is named "airbubble" from the name
> clause..
>
> }
>
> .. more of these command{} structures ....
>
> ..<eof>.
>
> i just want all the command{} structures in file A to replace (or add if
> nonexistant) the same named command{} structures in file B.
>
> any tips or similar code anyone knows about that can help me with this
> task? i'd be eternally grateful...
...
> jason iversen
...
Jason, you have not included lots of information that is really
necessary in order to recommend a solution to your problem. Here is a
short list:
1. Are your data files small enough that they can be loaded into
memory? If not, the techniques will differ markedly from the techniques
available if they can comfortably be loaded into memory.
2. Are the data files already sorted by structure name? If so, a merge
technique could be used.
3. What is the maximum nesting depth of braces in your structures?
4. What is your final goal? File C in the same format with the
contents of file B updated by file A?
5. What is syntactically significant in your data? The indentation?
The quotes? The brackets? The whitespace? Lines? Are there blank
lines between "command"'s as hinted at by the blank first line of the
file?
If your files will fit into memory, then put the data from file B into a
hash using the name as the key and the command structure as the value.
Then, using that same hash, run through the same thing with the data in
file A. Any duplicate keys will be replaced with data from file A, and
any new ones will be added. Then run through the hash keys and print
the values to generate an output file. This does not require the files
to be sorted by name. This could be as simple as:
$/=''; #assumes "command"'s separated by null lines
while(<>){
unless(/\n\s*name\s*"([^"]+)"/){next}
$h{$1}=$_;
}
print "\n"; #maintain initial null line
for(keys %h){
print $h{$_};
}
called with:
perl progname.pl fileB fileA >fileC
--
Bob Walton
------------------------------
Date: 12 Jul 2000 00:20:02 GMT
From: jasoniversen@my-deja.com.bbs@openbazaar.net (jason iversen)
Subject: Re: easy one for xperienced users.. hard for me...
Message-Id: <3bMjP1$X8M@openbazaar.net>
hi again.
ok, so maybe my explanation wasnt wonderful, but you got it clearly.
this is getting closer... it nearly works, except for the last record.
if you execute this with
perlscript.pl fileB fileA > fileC
#!/usr/local/bin/perl -w
$/='command'; #assumes "command"'s separated by null lines
while(<>){
unless(/\n\s*name\s*"([^ ]+)"/){next}
$h{$1}=$_;
}
print "\ncommand"; #maintain initial null line
for(keys %h){
print $h{$_};
}
file A (between the ..'s)
..
command {
help {
"A"
}
name "2"
label "2a"
default "2a"
rman
}
command {
help {
"A"
}
name "4"
label "4"
default "4"
rman
}
..
file B
..
command {
help {
"A"
}
name "1"
label "1"
default "1"
rman
}
command {
help {
"A"
}
name "2"
label "2"
default "2"
rman
}
command {
help {
"A"
}
name "3"
label "3"
default "3"
rman
}
..
should yeild file C
..
command {
help {
"A"
}
name "1"
label "1"
default "1"
rman
}
command {
help {
"A"
}
name "2"
label "2a"
default "2a"
rman
}
command {
help {
"A"
}
name "3"
label "3"
default "3"
rman
}
command {
help {
"A"
}
name "4"
label "4"
default "4"
rman
}
..
but for some reason, the last record of file A is a bit messed - it
doesnt have the command line. if you know if why the last record is
being scribbled, please share! i'm going to keep whacking it, though.
thanks again,
--
jason iversen
Sent via Deja.com http://www.deja.com/
Before you buy.
------------------------------
Date: 16 Jul 2000 15:50:02 GMT
From: nospam@mistnet.com.bbs@openbazaar.net (n)
Subject: easy: forms and frames
Message-Id: <3bQRZQ$Vbf@openbazaar.net>
Anyone know how to pass data from a non forms, cgi generated page, to a page
which is part of a frameset?
------------------------------
Date: 17 Jul 2000 20:20:06 GMT
From: abigail@delanet.com.bbs@openbazaar.net (Abigail)
Subject: Re: easy: forms and frames
Message-Id: <3bROD6$X9o@openbazaar.net>
n (nospam@mistnet.com) wrote on MMDXI September MCMXCIII in
<URL:news:3971da5f@news.iprimus.com.au>:
[]
[] Anyone know how to pass data from a non forms, cgi generated page, to a page
[] which is part of a frameset?
The same way as you would do for a program written in COBOL.
Abigail
--
sub camel (^#87=i@J&&&#]u'^^s]#'#={123{#}7890t[0.9]9@+*`"'***}A&&&}n2o}00}t324i;
h[{e **###{r{+P={**{e^^^#'#i@{r'^=^{l+{#}H***i[0.9]&@a5`"':&^;&^,*&^$43##@@####;
c}^^^&&&k}&&&}#=e*****[]}'r####'`=437*{#};::'1[0.9]2@43`"'*#==[[.{{],,,1278@#@);
print+((($llama=prototype'camel')=~y|+{#}$=^*&[0-9]i@:;`"',.| |d)&&$llama."\n");
------------------------------
Date: 18 Jul 2000 11:51:40 GMT
From: <jari.aalto@poboxes.com> (Jari Aalto+mail.perl)
Subject: Emacs modules for Perl programming
Message-Id: <perl-faq/emacs-lisp-modules_963920926@rtfm.mit.edu>
Archive-name: perl-faq/emacs-lisp-modules
Posting-Frequency: 2 times a month
URL: http://home.eu.org/~jari/ema-keys.html
Maintainer: Jari Aalto <jari.aalto@poboxes.com>
Announcement: "What Emacs lisp modules can help with programming Perl"
Preface
Emacs is your friend if you have to do anything comcerning software
development: It offers plug-in modules, written in Emacs lisp
(elisp) language, that makes all your programmings wishes come
true. Please introduce yourself to Emacs and your programming era
will get a new light.
Where to find Emacs
XEmacs/Emacs, is available to various platforms:
o Unix:
If you don't have one, bust your sysadm.
http://www.gnu.org/software/emacs/emacs.html
http://www.xemacs.org/
Emacs resources at http://home.eu.org/~jari/emacs-elisp.html
o W9x/NT:
http://www.gnu.org/software/emacs/windows/ntemacs.html
Emacs Perl Modules
Cperl -- Perl programming mode
.ftp://ftp.math.ohio-state.edu/pub/users/ilya/perl
.<olson@mcs.anl.gov> Bob Olson (started 1991)
.<ilya@math.ohio-state.edu> Ilya Zakharevich
Major mode for editing perl files. Forget the default
`perl-mode' that comes with Emacs, this is much better. Comes
starndard in newest Emacs.
TinyPerl -- Perl related utilities
.http://home.eu.org/~jari/tiny-tools-beta.zip
.http://home.eu.org/~jari/emacs-tiny-tools.html
If you ever wonder how to deal with Perl POD pages or how to find
documentation from all perl manpages, this package is for you.
Couple of keystrokes and all the documentaion is in your hands.
o Instant function help: See documentation of `shift', `pop'...
o Show Perl manual pages in *pod* buffer
o Load source code into Emacs, like Devel::DProf.pm
o Grep through all Perl manpages (.pod)
o Follow POD manpage references to next pod page with TinyUrl
o Coloured pod pages with `font-lock'
o Separate `tiperl-pod-view-mode' for jumping topics and pages
forward and backward in *pod* buffer.
o TinyUrl is used to jump to URLs (other pod pages, man pages etc)
mentioned in POD pages. (It's a general URL minor mode)
TinyIgrep -- Perl Code browsing and easy grepping
[TinyIgrep is included in the tgz mentioned above]
To grep from all installed Perl modules, define database to
TinyIgrep. There is example in the tgz (ema-tigr.ini) that shows
how to set up datatbases for Perl5, Perl4 whatever you have
installed
TinyIgrep calls Igrep.el to run the find for you, You can adjust
recursive grep options, ignored case, add user grep options.
You can get `igrep.el' module from <kevinr@ihs.com>. Ask for copy.
Check also ftp://ftp.ihs.com/pub/kevinr/
TinyCompile -- Browsing grep results in Emacs *compile* buffer
TinyCompile is minor mode for *compile* buffer from where
you can collapse unwanted lines, shorten the file URLs
/asd/asd/asd/asd/ads/as/da/sd/as/as/asd/file1:NNN: MATCHED TEXT
/asd/asd/asd/asd/ads/as/da/sd/as/as/asd/file2:NNN: MATCHED TEXT
-->
cd /asd/asd/asd/asd/ads/as/da/sd/as/as/asd/
file1:NNN: MATCHED TEXT
file1:NNN: MATCHED TEXT
End
------------------------------
Date: 17 Jul 2000 09:40:05 GMT
From: guymal@hotmail.com.bbs@openbazaar.net (Guy)
Subject: Emulating a HTML form
Message-Id: <3bR7T5$VGK@openbazaar.net>
I'm trying to emulate a HTML POST form using a Perl script. (good for
automatic login to web services like Hotmail). I have hard coded the
original HTML form and succeeded logging in using it without problems.
Using Perl: I've succeeded opening a connection to the form action URL and
sent it the parameters it needs (name=blabla&pass=lala) but the login
doesn't work ( I get a HTML response that says something like: Object
Moved ).
I suspect it has something to do with POST/GET (The original HTML form uses
the POST method)
The code I used looks something like this:
use LWP::UserAgent;
$ua = LWP::UserAgent->new;
my $req = HTTP::Request->new(POST
=>'http://www.blabla.com/scripts/login_check.asp');
$req->content_type('application/x-www-form-urlencoded');
$req->content('name=lala&pass=lulu');
my $res = $ua->request($req);
print $res->as_string;
I would greatly appreciate any help you guys have.
Thanks,
Guy
------------------------------
Date: 18 Jul 2000 04:30:03 GMT
From: elephant@squirrelgroup.com.bbs@openbazaar.net (jason)
Subject: escaping HTML [was: limits on GET]
Message-Id: <3bRb1T$Vvk@openbazaar.net>
Prasanth A. Kumar wrote ..
>This brings up a related question... in the Perl CGI module, is there
>a function to do the encoding for href inside of anchor tags?
escape
it's not part of any of the export tags so you need to import it
explicitly
use CGI qw'escape';
works as you'd expect
--
jason -- elephant@squirrelgroup.com --
------------------------------
Date: 18 Jul 2000 04:40:04 GMT
From: kumar1@home.com.bbs@openbazaar.net (Prasanth A. Kumar)
Subject: Re: escaping HTML [was: limits on GET]
Message-Id: <3bRbE4$W4B@openbazaar.net>
elephant@squirrelgroup.com (jason) writes:
> Prasanth A. Kumar wrote ..
> >This brings up a related question... in the Perl CGI module, is there
> >a function to do the encoding for href inside of anchor tags?
>
> escape
>
> it's not part of any of the export tags so you need to import it
> explicitly
>
> use CGI qw'escape';
>
> works as you'd expect
>
> --
> jason -- elephant@squirrelgroup.com --
I don't think I saw that in the man pages. I there a standard way to
find about these kind of commands? Or do I just look at the source?
--
Prasanth Kumar
kumar1@home.com
------------------------------
Date: 18 Jul 2000 04:50:03 GMT
From: elephant@squirrelgroup.com.bbs@openbazaar.net (jason)
Subject: Re: escaping HTML [was: limits on GET]
Message-Id: <3bRbQR$X9_@openbazaar.net>
Prasanth A. Kumar wrote ..
>elephant@squirrelgroup.com (jason) writes:
>
>> Prasanth A. Kumar wrote ..
>> >This brings up a related question... in the Perl CGI module, is there
>> >a function to do the encoding for href inside of anchor tags?
>>
>> escape
>>
>> it's not part of any of the export tags so you need to import it
>> explicitly
>>
>> use CGI qw'escape';
>>
>> works as you'd expect
>
>I don't think I saw that in the man pages. I there a standard way to
>find about these kind of commands? Or do I just look at the source?
it's not documented .. and yes there's a standard way - however - the
standard way _is_ to look at the source ;)
(the non-standard way is to guess)
--
jason -- elephant@squirrelgroup.com --
------------------------------
Date: 17 Jul 2000 07:20:04 GMT
From: iltzu@sci.invalid.bbs@openbazaar.net (Ilmari Karonen)
Subject: Re: Escaping strings.
Message-Id: <3bR3k5$VK5@openbazaar.net>
In article <10d62c60.2407c0cf@usw-ex0102-016.remarq.com>, chuckw wrote:
>My question: How do I accept input with these characters (", ', `
>etc) without escaping them? Is there a way to render the string
>"inert" so that when it is evaluated in my SQL statement, the
>errant characters don't clog the works???
What's wrong with $dbh->quote()?
#!/usr/bin/perl -w
use strict;
use DBI;
# set appropriate values for $driver and $db!
my $dbh = DBI->connect("DBI:${driver}:${db}");
my $orig = q("foo 'bar' baz" foobar);
print "Original: $orig\n";
my $quoted = $dbh->quote($orig);
print "Quoted : $quoted\n";
my $insert = "INSERT INTO test (id, data) VALUES ('fnord', $quoted)";
print "Executing $insert\n";
$dbh->do($insert) or die "Insert statement failed";
my $select = "SELECT data FROM test WHERE id = 'fnord'";
print "Executing $select\n";
my $res = $dbh->selectcol_arrayref($select) or die "Select statement failed";
for my $result (@$res) {
print "Returned: $result\n"
}
$dbh->disconnect;
__END__
Original: "foo 'bar' baz" foobar
Quoted : '"foo \'bar\' baz" foobar'
Executing INSERT INTO test (id, data) VALUES ('fnord', '"foo \'bar\' baz" foobar')
Executing SELECT data FROM test WHERE id = 'fnord'
Returned: "foo 'bar' baz" foobar
--
Ilmari Karonen - http://www.sci.fi/~iltzu/
"The screwdriver *is* the portable method." -- Abigail
Please ignore Godzilla and its pseudonyms - do not feed the troll.
------------------------------
Date: 16 Sep 99 21:33:47 GMT (Last modified)
From: Perl-Users-Request@ruby.oce.orst.edu (Perl-Users-Digest Admin)
Subject: Digest Administrivia (Last modified: 16 Sep 99)
Message-Id: <null>
Administrivia:
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.
| NOTE: The mail to news gateway, and thus the ability to submit articles
| through this service to the newsgroup, has been removed. I do not have
| time to individually vet each article to make sure that someone isn't
| abusing the service, and I no longer have any desire to waste my time
| dealing with the campus admins when some fool complains to them about an
| article that has come through the gateway instead of complaining
| to the source.
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.
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 V9 Issue 3712
**************************************
