[8042] in Perl-Users-Digest
Perl-Users Digest, Issue: 1667 Volume: 8
daemon@ATHENA.MIT.EDU (Perl-Users Digest)
Sun Jan 18 18:06:43 1998
Date: Sun, 18 Jan 98 15:00:24 -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, 18 Jan 1998 Volume: 8 Number: 1667
Today's topics:
Re: can anybody help me please? (Martin Vorlaender)
Re: can anybody help me please? (Andrew M. Langmead)
Re: can anybody help me please? (Clay Irving)
Re: Create file <rjk@coos.dartmouth.edu>
Database driver module problems <smoothie@spiritone.com>
Exporter Question ("Verma Kakarlapudi")
Re: How do I allow input to be retrieved from multiple <joseph@5sigma.com>
How on earth....?!?! <James@cydaps.nospam.co.uk>
Re: How to do random pornography in Perl. <david@telekinesys.no.co.spam.uk>
Re: How to sorting lists alphabetically? (Nathan V. Patwardhan)
Re: inverse cosine? <camerond@mail.uca.edu>
Looking for simple FTP server <darrylc@eznet.com>
Re: module to calculate dates? <rjk@coos.dartmouth.edu>
Re: Newbie question <rjk@coos.dartmouth.edu>
Re: no output <ak90@cornell.edu>
REGEXP: Does it need optimization? (Rick Freeman)
Re: Socket ? <joseph@5sigma.com>
Re: Sockets and Perl and Deadlock <joseph@5sigma.com>
Re: source into binary code <rjk@coos.dartmouth.edu>
Why does'nt this sub work <jim39@interworldnet.net>
Digest Administrivia (Last modified: 8 Mar 97) (Perl-Users-Digest Admin)
----------------------------------------------------------------------
Date: Sun, 18 Jan 1998 19:46:34 +0100
From: martin@RADIOGAGA.HARZ.DE (Martin Vorlaender)
Subject: Re: can anybody help me please?
Message-Id: <34c24e0a.524144494f47414741@radiogaga.harz.de>
Jahnel Klaus (jahnel@xarch.tu-graz.ac.at) wrote:
: i ve a file with datas:
[...]
: I want to read the data in (one line is a data set)
: and then put it out again but sortedon the 3rd entry
[...]
: How can i perform this (but please no linls to perlfaq i have read it no
: luck)
Then read it again. Perlfaq4 has the answers: Look for a section titled
"How do I sort an array by (anything)?"
The how-do-I-read-a-file-into-an-array problem is left as an exercise
to the reader.
cu,
Martin
--
| Martin Vorlaender | VMS & WNT programmer
Ceterum censeo | work: mv@pdv-systeme.de
Redmondem delendam esse. | http://www.pdv-systeme.de/users/martinv/
| home: martin@radiogaga.harz.de
------------------------------
Date: Sun, 18 Jan 1998 20:38:22 GMT
From: aml@world.std.com (Andrew M. Langmead)
Subject: Re: can anybody help me please?
Message-Id: <EMzyny.HFp@world.std.com>
Jahnel Klaus <jahnel@xarch.tu-graz.ac.at> writes:
>I want to read the data in (one line is a data set)
>and then put it out again but sortedon the 3rd entry
>like this:
>698 klaus 0000
>487 klaus 0855
>596 klaus 1205
>108 klaus 1725
>232 klaus 2305
>258 klaus 2305
>How can i perform this (but please no linls to perlfaq i have read it no
>luck)
You must have missed this entry:
How do I sort an array by (anything)?
Supply a comparison function to sort() (described in the
sort entry in the perlfunc manpage):
@list = sort { $a <=> $b } @list;
The default sort function is cmp, string comparison, which
would sort (1, 2, 10) into (1, 10, 2). <=>, used above, is
the numerical comparison operator.
If you have a complicated function needed to pull out the
part you want to sort on, then don't do it inside the sort
function. Pull it out first, because the sort BLOCK can be
called many times for the same element. Here's an example
of how to pull out the first word after the first number on
each item, and then sort those words case-insensitively.
@idx = ();
for (@data) {
($item) = /\d+\s*(\S+)/;
push @idx, uc($item);
}
@sorted = @data[ sort { $idx[$a] cmp $idx[$b] } 0 .. $#idx ];
Which could also be written this way, using a trick that's
come to be known as the Schwartzian Transform:
@sorted = map { $_->[0] }
sort { $a->[1] cmp $b->[1] }
map { [ $_, uc((/\d+\s*(\S+)/ )[0] ] } @data;
If you need to sort on several fields, the following
paradigm is useful.
@sorted = sort { field1($a) <=> field1($b) ||
field2($a) cmp field2($b) ||
field3($a) cmp field3($b)
} @data;
This can be conveniently combined with precalculation of
keys as given above.
See http://www.perl.com/CPAN/doc/FMTEYEWTK/sort.html for
more about this approach.
See also the question below on sorting hashes.
For your data, the answer would be something like this:
#!/usr/bin/perl -w
use strict;
my (@sortfield, @data);
while(<>) {
push @sortfield, (split ' ')[2]; # extract third field
push @data,$_; # save whole record
}
print @data[ sort {$sortfield[$a] <=> $sortfield[$b]} 0 .. $#data ];
--
Andrew Langmead
------------------------------
Date: 18 Jan 1998 17:44:50 -0500
From: clay@panix.com (Clay Irving)
Subject: Re: can anybody help me please?
Message-Id: <69u0l2$jde@panix.com>
In <34C2168B.9AE840BA@xarch.tu-graz.ac.at> Jahnel Klaus <jahnel@xarch.tu-graz.ac.at> writes:
>i ve a file with datas:
>232 klaus 2305
>258 klaus 2215
>596 klaus 2305
>108 klaus 1725
>698 klaus 0000
>487 klaus 0855
>I want to read the data in (one line is a data set)
>and then put it out again but sortedon the 3rd entry
>like this:
>698 klaus 0000
>487 klaus 0855
>596 klaus 1205
>108 klaus 1725
>232 klaus 2305
>258 klaus 2305
>How can i perform this (but please no linls to perlfaq i have read it no
>luck)
Here's one way:
#!/usr/local/bin/perl5.00403 -w
while (<DATA>) {
chomp;
($f1,$f2,$f3) = split / /;
push @foo, "$f3|$f2|$f1";
}
@sorted_foo = sort { uc($a) cmp uc($b) } @foo;
foreach(@sorted_foo) {
($f3,$f2,$f1) = split /\|/;
print "$f1 $f2 $f3\n";
}
__DATA__
232 klaus 2305
258 klaus 2215
596 klaus 2305
108 klaus 1725
698 klaus 0000
487 klaus 0855
The program prints:
698 klaus 0000
487 klaus 0855
108 klaus 1725
258 klaus 2215
232 klaus 2305
596 klaus 2305
--
Clay Irving <clay@panix.com> I think, therefore I am. I think?
http://www.panix.com/~clay/
------------------------------
Date: Sun, 18 Jan 1998 17:36:08 -0500
From: Chipmunk <rjk@coos.dartmouth.edu>
Subject: Re: Create file
Message-Id: <34C283D8.3E82C946@coos.dartmouth.edu>
Tom Phoenix wrote:
>
> Even when your script is "just an example" (and perhaps especially in that
> case!) you should _always_ check the return value after opening a file.
> Thanks!
>From 'Saving State with CGI.pm', by Lincoln Stein
The Perl Journal, Vol 1, Iss 2
Page 20:
[I reformatted the comments so the code would fit in an 80 column line)
sub fetch_old_state {
# Open the existing file if any, and read the current state.
my $session_key = shift;
# We use the CGI object here, because it's straightfoward to do so.
open(SAVEDSTATE, "$STATE_DIR/$session_key");
my $state = new CGI(SAVEDSTATE);
# We don't check for success of the open, because if there is
# no file yet, the new CGI(FILEHANDLE) call will return an empty
# parameter list, which is exactly what we want.
close SAVEDSTATE;
return $state
}
Chipmunk
------------------------------
Date: 18 Jan 1998 20:17:13 GMT
From: Dave Neuer <smoothie@spiritone.com>
To: debian-user@lists.debian.org, plug@Northwest.com
Subject: Database driver module problems
Message-Id: <34C26662.8B02C23A@spiritone.com>
I am having problems getting the DBI drivers for mSQL working on my
Debian Linux 1.3.1 system. I am using mSQL 2.0.3, DBI 0.91, and
Msql-modules-1.1814.
I have installed mSQL and the DBI module successfully (I think). Now I
am trying to install the Msql driver module. I call "perl Makefile.PL"
and "make" successfully, but "make test" fails. Below is the output of
make test with TEST_VERBOSE turned on:
make[1]: Entering directory `/tmp/Msql-modules-1.1814/DBD-mSQL'
make[1]: Entering directory `/tmp/Msql-modules-1.1814/MsqlPerl'
make[1]: Leaving directory `/tmp/Msql-modules-1.1814/MsqlPerl'
PERL_DL_NONLAZY=1 /bin/perl -I./blib/arch -I./blib/lib
-I/usr/lib/perl5/i386-lin
ux/5.00307 -I/usr/lib/perl5 -e 'use Test::Harness qw(&runtests
$verbose);
$verbose=1; runtests @ARGV;' t/*.t
t/00base............Bare word found where operator expected at
/usr/local/lib/site_perl/DBI.pm line 477, near "$fh neat_list"
(Missing operator before neat_list?)
... snip <the first test, t/00base, runs ok> ....
BTW; the line being referred to in the warning about DBI.pm (line 477)
is:
"print $fh neat_list($ref,$maxlen,$fsep);"
As neat_list is a subroutine call, I assume this isn't a problem; at any
rate, the Perl debugger says that DBI.pm's syntax is fine. All of the
tests print this warning, so I have removed it from their output below.
The second test generates the following output:
t/10dsnlist.........
Cannot connect: Unknown database "test"
Either your server is not up and running or you have no
permissions for acessing the DSN DBI:mSQL:test.
This test requires a running server and write permissions.
Please make sure your server is running and you have
permissions, then retry.
1..2
not ok 1
dubious
Test returned status 10 (wstat 2560)
These tests all return the same error as above:
t/20createdrop, t/30insertfetch, t/40bindparam, t/40listfields,
t/40nulls, t/40numrows
t/50chopblanks
Then the next test prints this:
t/40blobs..........
1..0
skipping test on this platform
Then there are a few tests (t/50commit, t/ak-dbd) that print this:
t/50commit..........
Can't call method "func" without a package or object reference at
t/mSQL.dbtest line 99.
1..16
not ok 1
dubious
Finally, several tests print a message like this:
t/akmisc............Msql's message: Unknown database "test" at
t/akmisc.t line 1 21.
Cannot select database 'test': Unknown database "test".
Please make sure that a database "test" exists
and that you have permission to read and write on it.
1..345
ok 1
not ok 2
Things that I have checked: YES, THE SERVER IS RUNNING. I can see it
listed with the command "ps -ax," and I am able to create a database
using the msqladmin utility. As far as write permission goes, because I
don't have an ACL file yet (since I don't really have any databases
created except as tests) mSQL prints the message that permission is
global read/write, so it seems like that shouldn't be an issue. The
thing I'm more uncertain about is where mSQL is supposed to find these
databases called "test" in the first place, and I'm not sure how to even
determine this.
If anyone can help with this problem, I'd really appreciate it.
P.S. -- To those on the Debian list who would like to respond to this,
I'm not on the list to to a problem with my ISP's handling of the huge
amounts of mail it generated, so please respond via email; Thanks.
------------------------------
Date: Sun, 18 Jan 1998 16:11:22 -0500
From: vkakarla@adelphia.net ("Verma Kakarlapudi")
Subject: Exporter Question
Message-Id: <000c01bd2455a1495640a1123018@default.pha.adelphia.net>
I am moving old Perl4 code to Perl5 and have been struggling
to understand the significance of Exporter function.
Please HELP!!
Here is my Argument:
a) One can access subs and module level variables(local) from
any other module by including the name of the module and
coding &module_name::sub_name and $module_name::var_name
without using Exporter function.
b) Using Exporter function, one has to still include the module in the
calling module and access the sub or varaiable with the same above
notation(::, can't avoid) even after exporting the sub, and variable to
arrays @EXPORT or @EXPORT_OK
WHY.. WHY..?
---Verma Kakarlapudi
------------------------------
Date: Sun, 18 Jan 1998 14:12:11 -0700
From: "Joseph N. Hall" <joseph@5sigma.com>
Subject: Re: How do I allow input to be retrieved from multiple lines?
Message-Id: <34C26FE3.537F2FD9@5sigma.com>
Nice catch.
-joseph
Russ Allbery wrote:
>
> Joseph N Hall <joseph@5sigma.com> writes:
>
> > print "type . on a line by itself to end\n";
> > $all .= $in while (($in = <>) ne ".\n");
> > print "you typed:\n", $all;
>
> Careful. You *always* want to stop reading on end of file;;
------------------------------
Date: Sun, 18 Jan 1998 22:17:38 +0000
From: James <James@cydaps.nospam.co.uk>
Subject: How on earth....?!?!
Message-Id: <mzzvnAAC+nw0Ewe5@cydaps.co.uk>
Hi
I have been asked by my boss to create a web site that has a Cool Notfiy
system like the Classified adverts section on www.hotmail.com. We use
Access 97 to create our database of jobs, and this is exported as a pipe
delemited text file and ftp'd to the web server (SunOS Unix with Perl 5
and Sendmail). We had a basis search script that seemed to work okay,
but now my boss wants to be able to let clients register on our site
stating their skills, the title of the job they are looking for, the
area they are looking in and the type of job (ie contract etc) and then
if there are any matches an email is sent out listing the jobs that
match the users information.
Does anyone know how www.classified2000.com setup their Cool Notify and
how we could do something similar. Often their are around 20,000 jobs
per month so it needs to be robust. Can anyone help?
Thank you very much indeed for your help
James
Please remove .nospam if replying by email!
------------------------------
Date: Sun, 18 Jan 1998 22:03:02 +0000
From: David Greaves <david@telekinesys.no.co.spam.uk>
Subject: Re: How to do random pornography in Perl.
Message-Id: <34C27C16.D23685FC@telekinesys.no.co.spam.uk>
Is this the *real thing* or is it just pseudo-random?
Fred Tunalu wrote:
> Need random pornography in Perl?
>
> My newsletter, "The Tiny Lobster" shows you how.
>
> http://www.jbum.com/jbum/tl/
>
> --
> --
> Fred Tunalu
> Institute of Druidic Technology
> http://www.geocities.com/Athens/Acropolis/5997/
--
David Greaves Enabling
Technical Director, Telekinesys SW Productivity W
david@telekinesys.co.uk via W
http://www.telekinesys.co.uk/ the W E B
------------------------------
Date: 18 Jan 1998 19:40:58 GMT
From: nvp@shore.net (Nathan V. Patwardhan)
Subject: Re: How to sorting lists alphabetically?
Message-Id: <69tlsa$s0k@fridge.shore.net>
Michael Georgiadis (michael.georgiadis@btinternet.com) wrote:
: the name of the company in the first line may be Zephyr and the second may
: be Acme. i want to be able to write some code which will read in one line at
: a time and then sort the list alphabetically and output to <STDOUT>
Okay. I answered the last three questions about sorting, and don't
feel like copying and pasting from perlfaq4 again. Please refer to
the section of perlfaq4 about sorting / Schwartzian transform.
: also, is it possible to write some code to search for a particular word
: within the list?
Yes. You'll also find this in the Perl FAQs.
--
Nathan V. Patwardhan
please don't send spam to president@whitehouse.gov
------------------------------
Date: Sun, 18 Jan 1998 14:26:20 -0600
From: Cameron Dorey <camerond@mail.uca.edu>
Subject: Re: inverse cosine?
Message-Id: <34C2656B.6151A66D@mail.uca.edu>
Mike Stok wrote:
>
> In article <0ojsG0200YUd02MOM0@andrew.cmu.edu>,
> Michael D Sohn <msda+@andrew.cmu.edu> wrote:
>
> >Is there a command or an easy way of getting the inverse cosine?
>
> You can, if you're using a recent perl, use the acos routine from the
> POSIX module e.g.
>
> use POSIX qw/acos/;
>
> $rads = acos $n;
>
> Otherwise it's back to basics which I have forgotten :-(
Or, on a W32 box (GS port), anyway, use Math::Trig
Cameron Dorey
camerond@mail.uca.edu
------------------------------
Date: Sun, 18 Jan 1998 20:01:28 GMT
From: Darryl Caldwell <darrylc@eznet.com>
Subject: Looking for simple FTP server
Message-Id: <EMzwyH.Kwq@linex6.linex.com>
Hi:
I am looking for examples of simple ftp servers written in Perl. Has
anyone written such and animal? Please email response as well as
post to this group. TIA
Happy birthday, Perl.
Darryl Caldwell Oikiasuchou School
___________________________________________________
The Practice Hall: http://www.eznet.com/bravo/ph/ph.html
Myth & Martial Culture
------------------------------
Date: Sun, 18 Jan 1998 17:45:11 -0500
From: Chipmunk <rjk@coos.dartmouth.edu>
To: Bob Trieger <corky@ultranet.com>
Subject: Re: module to calculate dates?
Message-Id: <34C285F7.DB93F18E@coos.dartmouth.edu>
[posted and mailed]
Bob Trieger wrote:
>
> Dean Burdick wrote:
> >
> > In article <34BFF7A0.2BFE@ultranet.com>, corky@ultranet.com says...
> > >
> > >Is there a perl module/library out there that calculates dates?
>
> > Check out the 'datemanip' module on CPAN.
>
> I left out one tiny fact. I am doing this on an NT server and can't get
> datemanip or datecalc to install correctly.
In other words, your question is not "Is there a perl module that
calculates dates?" but "How do I correctly install this perl module?"
Chipmunk
------------------------------
Date: Sun, 18 Jan 1998 17:18:21 -0500
From: Chipmunk <rjk@coos.dartmouth.edu>
To: Eyal <eyalb@bvr.co.il>
Subject: Re: Newbie question
Message-Id: <34C27FAD.319FA461@coos.dartmouth.edu>
[posted and mailed]
Eyal wrote:
>
> I have some pure virtual functions in my C++ header file.
> i want to use perl to find their name.
> e.g if have this:
> virtual void coordButtonClicked(Widget, XtPointer, XtPointer) = 0;
> I want as an output :
> void coordButtonClicked
perl -ne 'print "$1\n" if /^\s*virtual\s+([^\(\n]+)/' filename
That will print out everything after ' virtual' and before '(' or
newline.
Chipmunk
------------------------------
Date: 18 Jan 1998 14:51:13 -0500
From: Aleksey Kliger <ak90@cornell.edu>
Subject: Re: no output
Message-Id: <86soqltvbi.fsf@ak90.resnet.cornell.edu>
stoffer@netcetera.dk (Gustav Kristoffer Ek) writes:
> In a cgi-scipt I need to run other programs, but if I use something like:
>
> system ("$program");
>
> I got unwanted output and it isn't posible to use:
how about:
$collected_output = `$program`;
or just
`$program`;
HTH.
--
#!/usr/bin/perl -- ak90@cornell.edu, http://akxc.ml.org/~aleksey <*>
require5;$_=qq!.(ERXPNu#YERc;ERUGBAn^GFHw)&ERTVYx*LRFXRYn\n!;$$[$#$=
$[]^=s!$/!\$!s;tr!A-Z;#.a-z&^)*(!n-za-m\040\x20.N-ZA-M\x20\040(\040)
!;s!(.)\$(.*)$!\$$2$1!xwhile!s!^\$!!;print$_.${\($$[$[/$]]?$/:q**)};
------------------------------
Date: Sun, 18 Jan 1998 22:13:38 GMT
From: rick@marinweb.com (Rick Freeman)
Subject: REGEXP: Does it need optimization?
Message-Id: <34c57b20.12120348@nntp2.ba.best.com>
Hi,
I'm pretty new to this and was wondering if anhone has any suggestions
here. A search script I modified now uses the following regexp to
exclude portions of an HTML page from searches:
s#(^.*)(</head>.*<!--content-->)(.*)(<!--/content-->.*$)#\1 \3#i
I have the following concerns:
1. Should I be using the non-greedy modifier on any of the *
quantifiers? (Would that make it run faster?)
2. Is the performance hit from using /i very significant?
3. /o wouldn't be useful here... would it?
And yes, some day I *do* plan to read "Mastering Regular Expressions."
TIA for that suggestion. :-)
Regards,
Rick Freeman
M a r i n W e b
Marin's Home on the World Wide Web
http://www.marinweb.com/
98 Main Street #453
Tiburon CA 94920
415-458-3201
------------------------------
Date: Sun, 18 Jan 1998 14:07:26 -0700
From: "Joseph N. Hall" <joseph@5sigma.com>
Subject: Re: Socket ?
Message-Id: <34C26EC6.BED20198@5sigma.com>
AF_xx and PF_xx are equivalent, so far as I know. UNP, Stevens, p.267.
-joseph
http://www.effectiveperl.com
Lou Poppler wrote:
>
> This seems to work fine on my BSDI 2.1 box, with perl 5.001.
> The only suggestion I see is that maybe you should not be using PF_INET
> in the socket() call. The docs say that that parameter is an AF_xxx
> parameter, not a PF_xxx parameter. (However, in my BSDI 2.1 anyway,
> PF_INET is the same as AF_INET).
------------------------------
Date: Sun, 18 Jan 1998 14:17:36 -0700
From: "Joseph N. Hall" <joseph@5sigma.com>
Subject: Re: Sockets and Perl and Deadlock
Message-Id: <34C27128.C17217DE@5sigma.com>
The example on my web site is very similar to what you're asking for.
Avoiding deadlock is easy so long as you understand the buffering
behavior at both ends. It's easiest to understand it when you
write both the client and server yourself. :-) Not a bad idea
since buffering behavior of commands tends to vary from one Unix
to another, and also depending on whether programs are reading from
ttys or sockets or ...
-joseph
http://www.effectiveperl.com
(see the table of contents, Item 55)
john -r s wrote:
>
> Can anyone help me understand how to prevent deadlock in a simple
> client-server app using perl? I have used examples from the FAQ's and
> from all over the WEB but I have yet to find a single example that will
>
> allow a one time 2 way conversation between the client and server..
------------------------------
Date: Sun, 18 Jan 1998 17:24:37 -0500
From: Chipmunk <rjk@coos.dartmouth.edu>
Subject: Re: source into binary code
Message-Id: <34C28125.B5EA5A62@coos.dartmouth.edu>
Abigail wrote:
>
> Dan Boorstein (danboo@negia.net) wrote on 1601 September 1993 in
> <URL: news:34C1AB37.2F7675C0@negia.net>:
> ++ Abigail wrote:
> ++ >
> ++ > Rubbish. If they want to "steal" your code, and there is an easier
> ++ > alternative available, they won't use your code at all.
> ++
> ++ am i reading this correctly? if they want to steal my code and there
> ++ is an easier alternative which they take then my security has been
> ++ successful, hasn't it? they have been thwarted.
>
> Right. So, you are sitting there with your precious code, and
> noone buys/uses it. There are easier ways then encrypting to
> archieve that.
Wrong. No one *steals* it. That does not mean no one uses it.
If, as you wrote, someone wants to steal his code, and they
don't use it because it's too hard for them to steal, then
his security has been successful.
If, on the other hand, someone just wants to use his code,
they can.
Chipmunk
------------------------------
Date: Sun, 18 Jan 1998 15:27:28 -0700
From: Builders Connection <jim39@interworldnet.net>
Subject: Why does'nt this sub work
Message-Id: <34C281D0.2584@interworldnet.net>
the sub stordata in this program won't open and write to the file.
but the whole program works except for that, got any Idea's.
#!/usr/bin/perl
# AddLink v.1.2 (beta) for Unix
# Written by: Dave Palmer <dave@upstatepress.com>
# AddLink allows users to add their link to one of your pages
# This version is for Unix machines. A Windows version is available
# as well at: http://www.upstatepress.com/dave/perl.html
################################################################
# Define some variables first
# This is the file that has the links on it (nice grammer)
$linkfile = "../addlink/usrlinks.html";
#This the file to store the data
$stordata = "../addlink/builders.txt";
# This is the URL of the addlink.cgi
$addlink =
"http://www.builders-connection.com/cgi-bin/web3014b/addlink.cgi";
# This should be the URL of the addlink.html
$newlink = "http://www.builders-connection.com/linkform.shtml";
# Would you like to be notified by e-mail if some one posts a link?
# Set this to "yes" or "no"
$notify = "yes";
# This is the path to the mail program.
$mailprog = '/usr/sbin/sendmail';
# This should be your e-mail address
$my_email = 'jim@builders-connection.com';
# This should be your name
$my_name = 'James Barber';
# This is the URL to the usrlinks.html file
$usrlink = "http://www.builders-connection.com/addlink/usrlinks.html";
# This should point to where you keep your cgi libraries
# $libaray (this was but I ommited it (if libarary and this scripted in
the same directory)
# this should be the address of your home page(add on for redirection)
$home = "http://www.builders-connection.com/linkreply.htm";
################################################################
require "cgi-lib.pl";
# Get the form input
&ReadParse(*FORM);
# Translate the associative array references
$url = $FORM{'url'};
$sitename = $FORM{'sitename'};
$catagory = $FORM{'catagory'};
$descript = $FORM{'descript'};
$type = $FORM{'type'};
$address1 = $FORM{'address1'};
$city = $FORM{'city'};
$state = $FORM{'state'};
$name = $FORM{'name'};
$country = $FORM{'country'};
$zip_code = $FORM{'zip_code'};
$phone = $FORM{'phone'};
$phone2 = $FORM{'phone2'};
$e_mail = $FORM{'e_mail'};
if ($notify eq "yes") {
&sendmail;
}
# Lets do some error checking. I hate when people screw with us!
if ($url eq 'http://') { &missing_url; }
&missing_url unless $url;
&missing_title unless $sitename;
&missing_email_address unless $e_mail;
# Now, lets get rid of any HTML tags some one may have tried to enter
$sitename =~ s/<([^>]|\n)*>//g;
$descript =~ s/<([^>]|\n)*>//g;
$type =~ s/<([^>]|\n)*>//g;
$address1 =~ s/<([^>]|\n)*>//g;
$city =~ s/<([^>]|\n)*>//g;
$state =~ s/<([^>]|\n)*>//g;
$zip_code =~ s/<([^>]|\n)*>//g;
$phone =~ s/<([^>]|\n)*>//g;
$phone2 =~ s/<([^>]|\n)*>//g;
$country =~ s/<([^>]|\n)*>//g;
$name =~ s/<([^>]|\n)*>//g;
#suck the linkpage and add the new link
open(FILE, "$linkfile") || die "I can't open $linkpage\n";
@lines = <FILE>;
close(FILE);
$sizelines = @lines;
# Now, re-open the links file, and add the new link
open(FILE, ">$linkfile") || die "I can't open: $linkfile\n";
for ($a = 0; $a <= $sizelines; $a++) {
$_ = $lines[$a];
if (/<!--$catagory-->/) {
print FILE $_;
print FILE "<a href=\"$url\">$sitename</a></font><br>\n";
print FILE "$type<br>\n";
print FILE "$address1<br>\n";
print FILE "$city, $state, $zip_code, $country<br>\n";
print FILE "Phone:$phone * Fax: $phone2<br>\n";
print FILE "$descript<br>\n";
print FILE "<a href=\"mailto:$e_mail\">$e_mail</a><br><br>\n";
print FILE "$e_mail<br><br>\n";
} else {
print FILE $_;
}
}
close(FILE);
#Changed redirection with this line back to home page
print "Location: $home\n\n";
#omitted this line want to hide page from others
#new print "Location: $usrlink\n\n";
######################
# Sub routines #
######################
# First off, lets print the header
print "Content-type: text/html\n\n";
sub missing_url {
print "Content-type: text/html\n\n";
print "<html><head><title>Missing URL</title></head>\n";
print "<body>\n";
print "<font size=+4>You Forgot the URL!</font><br>\n";
print "You forgot to enter the URL, or the URL you entered<br>\n";
print "was not a valid URL. Please enter it below<br>\n";
print "<form action=\"$addlink\" method=GET>\n";
print "<input type=hidden name=\"sitename\" value=\"$sitename\">\n";
print "<input type=hidde name=\"descript\" value=\"$descript\">\n";
print "<input type=hidden name=\"type\" value=\"$type\">\n";
print "<input type=hidden name=\"address1\" value=\"$address1\">\n";
print "<input type=hidden name=\"city\" value=\"$city\">\n";
print "<input type=hidden name=\"country\" value=\"$country\">\n";
print "<input type=hidden name=\"state\" value=\"$state\">\n";
print "<input type=hidden name=\"zip_code\" value=\"$zip_code\">\n";
print "<input type=hidden name=\"phone\" value=\"$phone\">\n";
print "<input type=hidden name=\"phone2\" value=\"$phone2\">\n";
print "<input type=hidden name=\"e_mail\" value=\"$e_mail\">\n";
print "URL:<input type=text name=\"url\" size=50>\n";
print "<input type=submit name=\"submit\" value=\"submit\">\n";
print "<input type=reset name=\"reset\"
value=\"reset\"><br><hr><br>\n";
print "<a href=\"$newlink\">Back to New Link page</a>\n";
print "</form></body></html>\n";
exit;
}
sub missing_title {
print "Content-type: text/html\n\n";
print "<html><head><title>Missing Title</title></head>\n";
print "<body>\n";
print "<font size=+4>You Forgot the Title!</font><br>\n";
print "You forgot to enter the title for your site!<br>\n";
print "Please enter it below<br><hr noshade size=1
width=\"75%\"><br>\n";
print "<form action=\"$addlink\" method=GET>\n";
print "<input type=hidden name=\"descript\" value=\"$descript\">\n";
print "<input type=hidden name=\"type\" value=\"$type\">\n";
print "<input type=hidden name=\"address1\" value=\"$address1\">\n";
print "<input type=hidden name=\"country\" value=\"$country\">\n";
print "<input type=hidden name=\"city\" value=\"$city\">\n";
print "<input type=hidden name=\"state\" value=\"$state\">\n";
print "<input type=hidden name=\"name\" value=\"$name\">\n";
print "<input type=hidden name=\"zip_code\" value=\"$zip_code\">\n";
print "<input type=hidden name=\"phone\" value=\"$phone\">\n";
print "<input type=hidden name=\"phone2\" value=\"$phone2\">\n";
print "<input type=hidden name=\"e_mail\" value=\"$e_mail\">\n";
print "<input type=hidden name=\"catagory\" value=\"$catagory\">\n";
print "<input type=hidden name=\"url\" value=\"$url\">\n";
print "Name of site:<input type=text name=\"sitename\" size=40><br>\n";
print "<input type=submit name=\"submit\" value=\"submit\">\n";
print "<input type=reset name=\"reset\" value=\"reset\"><br><hr size=1
noshade><br>\n";
print "</form>\n";
print "<a href=\"$newlink\">Back to Add Links page</a>\n";
print "</body></html>\n";
exit;
}
sub missing_email_address {
print "Content-type: text/html\n\n";
print "<html><head><title>Missing Email Address</title></head>\n";
print "<body>\n";
print "<font size=+4>You Forgot Your Email Address!</font><br>\n";
print "You forgot to enter Your Email Address!<br>\n";
print "Please enter it below<br><hr noshade size=1
width=\"75%\"><br>\n";
print "<form action=\"$addlink\" method=GET>\n";
print "<input type=hidden name=\"descript\" value=\"$descript\">\n";
print "<input type=hidden name=\"type\" value=\"$type\">\n";
print "<input type=hidden name=\"address1\" value=\"$address1\">\n";
print "<input type=hidden name=\"country\" value=\"$country\">\n";
print "<input type=hidden name=\"city\" value=\"$city\">\n";
print "<input type=hidden name=\"state\" value=\"$state\">\n";
print "<input type=hidden name=\"name\" value=\"$name\">\n";
print "<input type=hidden name=\"zip_code\" value=\"$zip_code\">\n";
print "<input type=hidden name=\"phone\" value=\"$phone\">\n";
print "<input type=hidden name=\"phone2\" value=\"$phone2\">\n";
print "<input type=hidden name=\"catagory\" value=\"$catagory\">\n";
print "<input type=hidden name=\"url\" value=\"$url\">\n";
print "<input type=hidden name=\"sitename\" value=\"$sitename\">\n";
print "Your Email Address<input type=text name=\"e_mail\"
size=40><BR>\n";
print "<input type=submit name=\"submit\" value=\"submit\">\n";
print "<input type=reset name=\"reset\" value=\"reset\"><br><hr size=1
noshade><br>\n";
print "</form>\n";
print "<a href=\"$newlink\">Back to Add Links page</a>\n";
print "</body></html>\n";
exit;
}
sub stordata{
for (
$sitename,$type,$name,$address1,$city,$state,$zip_code,
$phone,$phone2,$e_mail
) {
tr/\r,//d;
}
open(FILE, ">> $stordata")|| die ("I can't open: Database\n");
print FILE
"$sitename,$type,$name,$address1,$city,$state,$zip_code,$country,$phone,$phone2,$e_mail
\n"; #Print a message
close(FILE);
}
sub sendmail {
open(MAIL, "| $mailprog -t") || die "I can't open $mailprog\n";
print MAIL "To: $my_name <$my_email>\n";
print MAIL "From: <$e_mail>\n";
print MAIL "Subject: Status of your link request\n";
print MAIL "The following URL was added to your add link page\n";
print MAIL "title: $sitename URL: $url\n";
print MAIL "country: $country\n";
print MAIL "Description: $descript\n";
close(MAIL);
}
--
=================================================
Hope you like your e-mail!
This is from Jim's wonderful box of replies!
Remember to write back: <Jim39@interworldnet.net>
=================================================
Or visit my site at:
<http://www.builders-connection.com>
------------------------------
Date: 8 Mar 97 21:33:47 GMT (Last modified)
From: Perl-Request@ruby.oce.orst.edu (Perl-Users-Digest Admin)
Subject: Digest Administrivia (Last modified: 8 Mar 97)
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.
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 1667
**************************************
