[11420] in Perl-Users-Digest
Perl-Users Digest, Issue: 5021 Volume: 8
daemon@ATHENA.MIT.EDU (Perl-Users Digest)
Mon Mar 1 13:07:37 1999
Date: Mon, 1 Mar 99 10:03:12 -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 Mon, 1 Mar 1999 Volume: 8 Number: 5021
Today's topics:
Re: Printing Shortcut Properties <gellyfish@btinternet.com>
Re: Question about converting newlines to <br> tags (Ronald J Kimball)
Re: regex poll results (Abigail)
Re: Regex to parse m/d/yy into yyyy-mm-dd (Larry Rosler)
Re: regexp (Mark P.)
Security & Style when piping commands <jbossert@dazel.com>
Re: Security & Style when piping commands <rick.delaney@home.com>
Re: sendmail doesn't work (Abigail)
Re: sendmail doesn't work <roger_mcilmoyle@woodbridgegroup.com>
Re: Statistics for comp.lang.perl.misc <uri@home.sysarch.com>
Re: The dumbest newbie question ever..? <coyote38@pacbell.net>
Re: The dumbest newbie question ever..THANKS EVERYBODY <mapman@frii.com>
Tied hashes and locking <cederstrom@removethis.kolumbus.fi>
Re: Tk binding and callbacks <bwarnock@gtemail.net>
upload <gilles.guillemette2@sympatico.ca>
Re: WWW:Search <gellyfish@btinternet.com>
Special: Digest Administrivia (Last modified: 12 Dec 98 (Perl-Users-Digest Admin)
----------------------------------------------------------------------
Date: 28 Feb 1999 04:26:08 -0000
From: Jonathan Stowe <gellyfish@btinternet.com>
Subject: Re: Printing Shortcut Properties
Message-Id: <7bagh0$4bn$1@gellyfish.btinternet.com>
In comp.lang.perl.misc Alex Campbell <alex.campbell@erols.com> wrote:
> I work with a group that has literally hundreds of Shortcuts and many of
> them have improperly named such as Latest Training in several different
> folders. Is there a utility or Perl program to print their properties as
> well as their folder location. My work e-mail is campbell_alex@bah.com.
>
There is of course a Perl module Win32::Shortcut that allows you to manage
shortcuts.
/J\
--
Jonathan Stowe <jns@btinternet.com>
Some of your questions answered:
<URL:http://www.btinternet.com/~gellyfish/resources/wwwfaq.htm>
Hastings: <URL:http://www.newhoo.com/Regional/UK/England/East_Sussex/Hastings>
------------------------------
Date: Sun, 28 Feb 1999 23:46:15 -0500
From: rjk@linguist.dartmouth.edu (Ronald J Kimball)
Subject: Re: Question about converting newlines to <br> tags
Message-Id: <1dnymq6.38oumo1lu6as4N@bay2-340.quincy.ziplink.net>
George <fred222@mauimail.com> wrote:
> $mod_joke_text =~ s/\n/<br>/g;
>
> But this does something odd! It puts <br> tags where I want 'em, but it
> seems to leave the newlines in too. Does anyone know what sort of error
> I've made? If needs be, I can post bigger parts of the script.
You're probably getting \r\n back from the form submission. \r\n is the
standard line-ending for inter-system communication.
So this should work instead:
$mod_joke_text =~ s/\r\n/<br>/g;
But you might want to check for any sort of line ending:
$mod_joke_text =~ s/\r\n?|\n/<br>/g;
BTW, if you use CGI.pm, I think it converts line-endings to \n for you.
--
_ / ' _ / - aka - rjk@linguist.dartmouth.edu
( /)//)//)(//)/( Ronald J Kimball chipmunk@m-net.arbornet.org
/ http://www.ziplink.net/~rjk/
"It's funny 'cause it's true ... and vice versa."
------------------------------
Date: 28 Feb 1999 04:47:23 GMT
From: abigail@fnx.com (Abigail)
Subject: Re: regex poll results
Message-Id: <7bahor$rn5$2@client2.news.psi.net>
Paul J. Schinder (schinder@leprss.gsfc.nasa.gov) wrote on MMVI September
MCMXCIII in <URL:news:7b91sc$1he$1@callisto.clark.net>:
\\ In <7b8n2u$k1n$1@client2.news.psi.net> abigail@fnx.com (Abigail) writes:
\\
\\ >Uri Guttman (uri@home.sysarch.com) wrote on MMVI September MCMXCIII in
\\ ><URL:news:x7d82wgs8h.fsf@home.sysarch.com>:
\\ >##
\\ >## 5.005_03 2
\\
\\
\\ >Over 5% of the responders uses a non-existing version of Perl?
\\
\\ It exists:
\\
\\ linux% perl -V
\\ Summary of my perl5 (5.0 patchlevel 5 subversion 3) configuration:
\\ Platform:
\\ osname=linux, osvers=2.1.127, archname=ppc-linux
\\ [snip]
\\ Characteristics of this binary (from libperl):
\\ Locally applied patches:
\\ MAINT_TRIAL_5 - 5.005_03 maintenance trial 5
^^^^^^^
Abigail
--
perl -wle\$_=\<\<EOT\;y/\\\\n/\ /\;print\; -eJust -eanother -ePerl -eHacker -eEOT
------------------------------
Date: Sun, 28 Feb 1999 21:00:38 -0800
From: lr@hpl.hp.com (Larry Rosler)
Subject: Re: Regex to parse m/d/yy into yyyy-mm-dd
Message-Id: <MPG.1143bed33439eee39896b7@nntp.hpl.hp.com>
In article <36DA0A2B.C6E30DFF@wrkhors.com>, on Sun, 28 Feb 1999 21:31:55
-0600 lembark@wrkhors.com says...
...
> simply add 1900 to the year number if it's less
> than 100 to get a 4-digit year and sprintf the result, e.g.,
>
> my ( $m, $d, $y ) = split /\D/, $date;
> $y += 1900 if $y < 100;
> sprintf "%4d-%02d-%02d", $y, $m, $d;
This solution fails miserably in exactly ten months from now, when the
date will be 1/1/00 in practically everybody's notation.
You know, the so-called Y2K bug didn't happen *only* because programmers
wanted to save storage. Two-digit year notation is ingrained into our
culture.
--
Larry Rosler
Hewlett-Packard Company
http://www.hpl.hp.com/personal/Larry_Rosler/
lr@hpl.hp.com
------------------------------
Date: Mon, 01 Mar 1999 00:00:03 GMT
From: mag@imchat.com (Mark P.)
Subject: Re: regexp
Message-Id: <36d9d38e.620074800@news.ionet.net>
Okay, I got the first part with the following, however, I am still not
able to get the last part of the url to go away. Oh well, I just guess
I'll make do with this.
$file = "$ENV{'HTTP_REFERER'}";
$file =~ s/.*[\\\/:]//i;
$file =~ s/.html/.txt/ig;
$file =~ s/.shtml/.txt/ig;
$file =~ s/.htm/.txt/ig;
Probably not as elegent a solution as most of you would
create, but it does work.<G>
------------------------------
Date: Mon, 01 Mar 1999 12:24:48 +0800
From: John Bossert <jbossert@dazel.com>
Subject: Security & Style when piping commands
Message-Id: <36DA168F.F4C6BC5@dazel.com>
I'm looking for suggestions on doing the following with security and
style:
$cmd = "$mycommand $myarguments @filelist"
open (CMD, "$cmd|") or die "command failed $!";
while (<CMD>) { print $_; }
close CMD;
This will eventually get run under setuid, so I'm testing with perl -T.
Perl, however, complains about "Insecure dependency in piped open while
running with -T switch..."
I've read perlsec, and have explicitly set my PATH (and the other
obvious things) but I'm stumped here.
I trust (famous last words...) $mycommand and $myarguments, as well as
@filelist (even though it's been passed from the command line. What's
the best way to either avoid perl's security concerns or (graciously)
evade them?
Thanks!
--
====================================================================
John Bossert email: jbossert@dazel.com
Systems Engineer voice: 425.462.2060
Dazel Corporation fax: 425.462.2064
800 Bellevue Way NE, Suite 400 pager: 800.SKY.PAGE pin 1454252
Bellevue, WA 98004 URL: http://www.dazel.com
------------------------------
Date: Mon, 01 Mar 1999 04:55:12 GMT
From: Rick Delaney <rick.delaney@home.com>
Subject: Re: Security & Style when piping commands
Message-Id: <36DA1F91.78349038@home.com>
[posted & mailed]
John Bossert wrote:
>
> I'm looking for suggestions on doing the following with security and
> style:
>
> $cmd = "$mycommand $myarguments @filelist"
> open (CMD, "$cmd|") or die "command failed $!";
> while (<CMD>) { print $_; }
> close CMD;
>
> This will eventually get run under setuid, so I'm testing with perl
> -T. Perl, however, complains about "Insecure dependency in piped open
> while running with -T switch..."
>
> I've read perlsec, and have explicitly set my PATH (and the other
> obvious things) but I'm stumped here.
Did you do the obvious thing and untaint input?
>
> I trust (famous last words...) $mycommand and $myarguments, as well as
> @filelist (even though it's been passed from the command line.
Why would you trust that? If it's being passed from the command line
then you must untaint it because perl certainly will not trust it.
> What's the best way to either avoid perl's security concerns or
> (graciously) evade them?
Clean up all input with a regular expression as suggested in perlsec.
Something like:
for (@filelist) {
if (/([\w-.]+)/) {
$_ = $1;
}
else { die "Please rename '$_' to something more conventional\n" }
}
--
Rick Delaney
rick.delaney@home.com
------------------------------
Date: 28 Feb 1999 05:15:10 GMT
From: abigail@fnx.com (Abigail)
Subject: Re: sendmail doesn't work
Message-Id: <7bajcu$rn5$7@client2.news.psi.net>
Philip Class (philip.class@popcorn-studio.ch) wrote on MMVI September
MCMXCIII in <URL:news:7b9elf$e1h$1@bw107zhb.bluewin.ch>:
!! I'm running a Web on a NT-Server.
!! The admin has installed a email-handling Perl Prg, that uses a sendmail
!! Program located at
!! /usr/bin/sendmail . His email-handling cgi-Program is located in a virtual
!! Dir called /global-cgi/mailprogram.pl.
!! But as soon as I copy the mailprogram.pl into a cgi-bin Directory of my own
!! Domain, it doesn't work anymore.
!! The Script doesn't display an error message, but NO EMAIL are sent out.
!!
!! What's wrong ?
It must the error in line 17.
!! My cgi-bin Directory own all permissions for executing Scripts etc.
!! 1) How can I find out if the Sendmail-location is really understood be the
!! Program ?
!! ( using something like .... open(MAIL,"|$mailprogram") || die "display
!! Error Message"; ... never displays an Error, even
!! if the $mailprogram name is surely wrong )
That's because opening the pipe succeeds. If you would try to close the
handle, and die() when that fails, you'll die.
!! 2) What's the difference between running the exactly same script in the
!! administrators /global-cgi Directory and letting it run in my own cgi-bin ?
Now, how are we supposed to tell that? You don't give use the system
configuration, nor the code. So, my guess is solar flares.
Abigail
--
sub _'_{$_'_=~s/$a/$_/}map{$$_=$Z++}Y,a..z,A..X;*{($_::_=sprintf+q=%X==>"$A$Y".
"$b$r$T$u")=~s~0~O~g;map+_::_,U=>T=>L=>$Z;$_::_}=*_;sub _{print+/.*::(.*)/s}
*_'_=*{chr($b*$e)};*__=*{chr(1<<$e)};
_::_(r(e(k(c(a(H(__(l(r(e(P(__(r(e(h(t(o(n(a(__(t(us(J())))))))))))))))))))))))
------------------------------
Date: Sun, 28 Feb 1999 23:09:57 -0600
From: "Roger McIlmoyle" <roger_mcilmoyle@woodbridgegroup.com>
Subject: Re: sendmail doesn't work
Message-Id: <36da11e6.0@nemo.idirect.com>
Abigail wrote in message <7bajcu$rn5$7@client2.news.psi.net>...
>Philip Class (philip.class@popcorn-studio.ch) wrote on MMVI September
>MCMXCIII in <URL:news:7b9elf$e1h$1@bw107zhb.bluewin.ch>:
>!! I'm running a Web on a NT-Server.
>!! The admin has installed a email-handling Perl Prg, that uses a sendmail
>!! Program located at
>!! /usr/bin/sendmail . His email-handling cgi-Program is located in a
virtual
>!! Dir called /global-cgi/mailprogram.pl.
>!! But as soon as I copy the mailprogram.pl into a cgi-bin Directory of my
own
>!! Domain, it doesn't work anymore.
>!! The Script doesn't display an error message, but NO EMAIL are sent out.
>!!
>!! What's wrong ?
Clearly the problem is /usr/bin/sendmail is the standard location for
sendmail on a unix platform. My bet is you don't actually have sendmail
installed on you NT Web server. I don't believe sendmail even comes with
NT-Server, so it would have to be a unix look-alike if it existed at all.
I would get a smtp package instead.
------------------------------
Date: 01 Mar 1999 12:18:41 -0500
From: Uri Guttman <uri@home.sysarch.com>
Subject: Re: Statistics for comp.lang.perl.misc
Message-Id: <x7zp5xdt72.fsf@home.sysarch.com>
>>>>> "JF" == Jonathan Feinberg <jdf@pobox.com> writes:
JF> Greg Bacon <gbacon@cs.uah.edu> writes:
>> Top 10 Threads by OCR (minimum of five posts)
>> ==============================================
>>
>> (kb) (kb)
>> OCR orig / body Posts Subject
>> ----- -------------- ----- -------
>>
>> 0.945 ( 11.1/ 11.7) 5 Statistics for comp.lang.perl.misc
JF> Hey, no fair!
speaking of not fair, i have been on most of these lists from time to
time and under multiple addresses so my real sums were higher than what
was listed. greg, how about some smarts in the program to count posts by
my real name instead of my login. i post from both home and work so it
seems like i am in two places without being anywhere at all.
uri
--
Uri Guttman ----------------- SYStems ARCHitecture and Software Engineering
Perl Hacker for Hire ---------------------- Perl, Internet, UNIX Consulting
uri@sysarch.com ------------------------------------ http://www.sysarch.com
The Best Search Engine on the Net ------------- http://www.northernlight.com
------------------------------
Date: Sat, 27 Feb 1999 20:43:45 -0800
From: "coyote38" <coyote38@pacbell.net>
Subject: Re: The dumbest newbie question ever..?
Message-Id: <EQ3C2.4734$8N5.45683@typhoon-sf.pbi.net>
OK, I know there are 9 other replies to your message, but I am
working on a Windows NT 4 machine right now and I modified the
line to be
perl -e "print \"Hello, World\n\";"
It does work because I tried it out at the command prompt. I have
Active Perl 5.09 installed on my machine.
http://www.activestate.com/ActivePerl/default.htm
Now, I simply
1) 'escaped' the double-quotes in the string with backslashes.
2) converted the single quotes to double since I believe the
interpreter is looking for a double quoted string. If you try
perl -e '$test = 1;'
you get the same error, meaning perl -e is looking for a double-
quoted string. That being the case, you have to 'escape' the
function of the 2 internal double quotes with backslashes.
Finally,
The O'Reilly books are really the finest books on Perl (or almost
any other computer language, for that matter).
coyote38@pacbell.net
Mike Eley wrote in message <36D96738.90D83E69@frii.com>...
>ok here it is
>i just started trying to use perl yesterday
>bought the book 'Perl 5 Complete'
>page 45 says to type in this:
>
>perl -e 'print "Hello, World\n";'
>
>the error message i get back is:
>
>Can't find string terminator " ' " anywhere before EOF at -e line 1.
>
>Should this actually work?
>Did I buy a lame book?
>Why am I trying to do this anyway?
>How did I get myself into this mess?
>
>Thanks people,
>mike
>
------------------------------
Date: Sun, 28 Feb 1999 21:54:14 -0700
From: Mike Eley <mapman@frii.com>
Subject: Re: The dumbest newbie question ever..THANKS EVERYBODY
Message-Id: <36DA1D76.F988C146@frii.com>
WOW
this has got to be the most helpful newsgroup ever
my faith has been restored
i think i can in fact learn the Perl thing
THANKS AGAIN EVERYONE
------------------------------
Date: Sun, 28 Feb 1999 15:26:37 +0200
From: "Juho Cederstrvm" <cederstrom@removethis.kolumbus.fi>
Subject: Tied hashes and locking
Message-Id: <7bbogc$rub$3@news.kolumbus.fi>
Do I have to lock a file when I'm using tie or dbmopen ? In other words, do
those functions have automatic locking or something like that ?
--
# this is a perl script which will display my email address
$_="acbecddeerfsgthriojmkaltmknoolpuqmrbsutsudvowtxfyi";
s/(.)(.)/$2/eg;s/at/@/;s/dot/./;print $_;
------------------------------
Date: Sun, 28 Feb 1999 05:09:32 GMT
From: "Bryan C. Warnock" <bwarnock@gtemail.net>
Subject: Re: Tk binding and callbacks
Message-Id: <gc4C2.1244$_J5.559@news.rdc1.md.home.com>
Cross-posted for wider distribution, reposted with additional information.
Hopefully there are
some gurus here who don't regularly follow the Tk group.
I'm looking for an explanation of an (un?)documented (un?)feature related to
Tk bindings and callbacks.
First, the specifics:
Perl 5.005, Tk 800.011 on an SGI Origin 2000 (IP-27) running IRIX 6.4, an
SGI Challenge XL (IP-25) running IRIX 6.2, and a Sun SPARCStation 20
(sparc4m) running Solaris 2.6.
Also on Perl 5.004_02, Tk 402.002 on a Cyrix MediaGX running Windows 98.
> Original problem was on Perl 5.005_02, Tk 800.012 on a DEC Alpha (?)
running
unknown OS. (Yeah, a lot of help that is, huh?)
#!/your/perl/path/here -w
use Tk;
my $main=new MainWindow;
my $w1=$main->Entry(-width=>15)->pack(-side=>"left");
# Leave this space for the bindings....
MainLoop();
sub foo
{
print scalar @_, "\n";
foreach $value (@_)
{
print "$value\n";
}
}
# End of code
Obviously, a very stripped down version, but enough to demonstrate the
problems, hopefully.
First, add this line to space set aside for bindings.
$w1->bind("<Return>" => [\&foo, "Hello", "Goodbye"]);
Running the script and pressing Return in the box gives me something
like this:
3
Tk::Entry=HASH(address)
Hello
Goodbye
A total of three args - the implicit widget reference, and the two arguments
I specified.
Now add this (before or after, it didn't seem to matter).
$w1->bind("<Tab>" => [\&foo, "Pressing Tab"]);
A subsequent run gives me this output (pressing Tab first, once again, it
doesn't seem to matter):
2
Tk::Entry=HASH(address)
Pressing Tab
3
Tk::Entry=HASH(address)
Hello
Goodbye
Changing the Tab bind to this...
$w1->bind("<Tab>" => sub { print scalar @_, "\n"; foreach $value (@_)
print "$value\n"; } });
...and running it again gives me this:
1
Tk::Entry=HASH(address)
3
Tk::Entry=HASH(address)
Hello
Goodbye
However, changing the Tab bind to this...
$w1->bind("<Tab>" => \&foo);
...gives me this output:
1
Tk::Entry=HASH(address)
2
Hello
Goodbye
What happened to the implicit widget reference as the first argument?
I got this consistently when mixing bindings of an anonymous array or sub
with a straight reference to a sub.
------------------------------
Date: Sun, 28 Feb 1999 11:17:23 -0500
From: Gilles Guillemette <gilles.guillemette2@sympatico.ca>
Subject: upload
Message-Id: <36D96C13.47E80C3@sympatico.ca>
Il s'agit d'un message multivolet au format MIME.
--------------7AE1BDAFD87F87285AC2CC8F
Content-Type: text/plain; charset=us-ascii
Content-Transfer-Encoding: 7bit
I am looking for help!!
For small upload like 15k I have no problem, but when is about 50k and over
my system hang and I receive the message , '' The connection with server was
reset ''
It is a size problem in the script ??
gilles.guillemette2@sympatico.ca
thank for your help.
--------------7AE1BDAFD87F87285AC2CC8F
Content-Type: text/plain; charset=iso-8859-1; name="OnLupload.cgi"
Content-Transfer-Encoding: quoted-printable
Content-Disposition: inline; filename="OnLupload.cgi"
################################################
# upload.cgi.cgi
# NetSys inc.
# Version 1.0, 98-10-22
#
# Scripts for uploading files belongs to a customer
# =
#
main();
exit();
#################################################
# Subroutine =
# Name : main
# Description : main subroutine
# Input :
# Output :
#
sub main
{
init();
upload_file();
exit();
} # End of program
#################################################
# Subroutine =
# Name : init
# Description : Initialize parameters needed for this program
# Input :
# Output :
#
sub init
{
use CGI;
$q =3D new CGI;
use Win32;
# Setup
$source_path =3D 'I:';
$ini_path =3D "d:/inetpub/wwwroot/cytronics/data";
$NTDomainName =3D Win32::DomainName;
$user =3D Win32::LoginName;
read_ini();
$SAVE_DIRECTORY =3D "$source_path$DefaultFolder1";
$SUCCESS_LOCATION =3D "";
=
} # end of init
#################################################
# Subroutine =
# Name : read_ini
# Description : Read INI file to load user profile
# Input :
# Output :
#
sub read_ini
{
open (user, "$ini_path/$user.ini");
if (<user>) {
seek(user,0,0);
while (eof() <=3D> 1) {
$input =3D <user>;
$egual =3D index($input,"=3D") + 1;
$pos_value =3D $egual + 2;
$record_length =3D length($input) -1;
$parameter =3D substr($input,0,$egual - 2);
$value_length =3D $record_length - length($parameter) - 3;
$value =3D substr($input,$egual+1,$value_length);
=
# Load Parameter from User INI file
if ($parameter eq "DefaultFolder1") {
$value =3D~ /\/[a-z0-9A-Z_-]+/;
$DefaultFolder1 =3D $&;
}
if ($parameter eq "LastUpload") {
$LastUpload =3D $value;
}
if ($parameter eq "UploadSizeLimit") {
$UploadSizeLimit =3D $value;
}
if ($parameter eq "Language") {
$Language =3D uc($value);
}
}
close(user);
if ($DefaultFolder1 eq "") {
$error =3D 6;
print_error($error);
}
if ($UploadSizeLimit eq "") {
$UploadSizeLimit =3D 0 ;
}
}
else {
$error =3D 2;
print_error($error);
}
} # end of read_ini
#################################################
# Subroutine =
# Name : upload_file
# Description : Upload file to user folder
# Input :
# Output :
#
sub upload_file
{
$| =3D 1;
chop $SAVE_DIRECTORY if ($SAVE_DIRECTORY =3D~ /\/$/);
if ( (!(-e $SAVE_DIRECTORY)) || (!(-W $SAVE_DIRECTORY)) || (!(-d $SAVE_D=
IRECTORY)) ) {
if (!(-e $SAVE_DIRECTORY)) {
$error =3D 8;
&print_error($error);
}
if (!(-W $SAVE_DIRECTORY)) {
$error =3D 9;
&print_error($error);
}
}
foreach $key (sort {$a <=3D> $b} $q->param()) {
next if ($key =3D~ /^\s*$/);
next if ($q->param($key) =3D~ /^\s*$/);
next if ($key !~ /^file-to-upload-(\d+)$/);
$Number =3D $1;
if ($q->param($key) =3D~ /([^\/\\]+)$/) {
$Filename =3D $1;
$Filename =3D~ s/^\.+//;
$File_Handle =3D $q->param($key);
}
else {
$FILENAME_IN_QUESTION =3D $q->param($key);
$error =3D 12;
print_error($error);
}
if (!open(OUTFILE, ">$SAVE_DIRECTORY\/$Filename")) {
$error =3D 10;
print_error($error);
}
else {
binmode (OUTFILE);
}
undef $BytesRead;
undef $Buffer;
while ($Bytes =3D read($File_Handle,$Buffer,1024)) {
$BytesRead +=3D $Bytes;
print OUTFILE $Buffer;
}
push(@Files_Written, "$SAVE_DIRECTORY\/$Filename");
$TOTAL_BYTES +=3D $BytesRead;
$Confirmation{$File_Handle} =3D $BytesRead;
close($File_Handle);
close(OUTFILE);
chmod (0666, "$SAVE_DIRECTORY\/$Filename");
}
$FILES_UPLOADED =3D scalar(keys(%Confirmation));
if ($TOTAL_BYTES > $UploadSizeLimit && $UploadSizeLimit > 0) {
foreach $File (@Files_Written) {
unlink $File;
}
$error =3D 11;
print_error($error);
}
if ($Filename ne "") {
if ($SUCCESS_LOCATION !~ /^\s*$/) {
print $q->redirect($SUCCESS_LOCATION);
}
else {
print_header();
foreach $key (keys (%Confirmation)) {
$size =3D $Confirmation{$key} / 1024;
if ($Language eq "F") {
print '<form method=3D"get" action=3D"/upload_f.htm">';
print "<H1>Transfert termin=E9</H1>";
print "<hr><P>";
printf ("$key - %10.1f kb</p>",$size);
print '<input type=3D"submit" value=3D"Retour" name=3D"Retour"></for=
m>';
}
else {
print '<form method=3D"get" action=3D"/upload_e.htm">';
print "<H1>Upload completed</H1>";
print "<hr><P>";
printf ("$key - %10.1f kb</p>",$size);
print '<input type=3D"submit" value=3D"Return" name=3D"Return"></for=
m>';
} =
$LastUpload =3D "$key" ; =
}
print "</body></html>";
write_file($LastUpload);
}
}
else {
print_missing_file();
}
} # end upload_file =
#################################################
# Subroutine =
# Name : write_file
# Description : Write defaul upload file
# Input :
# Output :
#
sub write_file =
{
open (user, "$ini_path/$user.ini");
open (output, ">$ini_path/$user.tmp");
while (eof(user) <=3D> 1) {
$data =3D <user>;
$egual =3D index($data,"=3D") + 1;
$parameter =3D substr($data,0,$egual - 2);
if ($parameter ne "LastUpload") {
print output ($data);
}
}
print output ("LastUpload =3D $LastUpload\n");
close(user); =
close(output);
unlink ("$ini_path/$user.ini");
rename ("$ini_path/$user.tmp" , "$ini_path/$user.ini");
} # end write_file
#################################################
# Subroutine =
# Name : print_missing_file
# Description : Print missing option message
# Input : =
# Output :
#
sub print_missing_file
{
print_header();
=
if ($Language eq "F") {
print '<form method=3D"get" action=3D"/upload_f.htm">';
print "<h0>Erreur - Nom et chemin du fichier manquant,</p> S.V.P. entre=
r le chemin et nom du fichier.</p></h0>";
print '<input type=3D"submit" value=3D"Retour" name=3D"Retour"></form>'=
;
}
else {
print '<form method=3D"get" action=3D"/upload_e.htm">';
print "<h0>Error - File and path not enter,</p> please enter path and f=
ile name.</p></h0>"; =
print '<input type=3D"submit" value=3D"Return" name=3D"Return"></form>'=
;
}
print "</body></html>"; =
exit();
} # end print_missing_file
#################################################
# Subroutine =
# Name : print_header
# Description : Print header for format HTML
# Input :
# Output :
#
sub print_header
{
print $q->header (-nph=3D>1,
-type=3D>'text/html',
-expires=3D>'now');
print $q->start_html (-title=3D>'Cytronics',
-author=3D>'NetSys inc.',
-target=3D>'main',
-bgcolor=3D>'#800000',
-text=3D>'#FFFFFF',
-link=3D>'#FFFFFF',
-vlink=3D>'#FFFFFF',
-alink=3D>'#00FFFF');
} # End of print_header
#################################################
# Subroutine =
# Name : print_error
# Description : Print error code to user
# Input : error code
# Output :
#
sub print_error
{
print_header();
print "ERROR CODE =3D $error\n";
print "<br>\n";
print "<br>\n";
print "Please call CYTRONICS support group\n";
print "</body></html>"; =
exit();
} # end of print_error
--------------7AE1BDAFD87F87285AC2CC8F--
------------------------------
Date: 28 Feb 1999 15:17:04 -0000
From: Jonathan Stowe <gellyfish@btinternet.com>
Subject: Re: WWW:Search
Message-Id: <7bbmlg$618$1@gellyfish.btinternet.com>
On Wed, 24 Feb 1999 09:56:38 +0000 (GMT) D.K. FLETCHER wrote:
> I,ve Have WWW:Search installed on UNIX, Does anyone Know
> How I can put this in a web page, at the moment it is
> working from command line.
>
> I a bit of a novice to perl programming so try not to be too
> technical
>
After a fifty second perusal of the WWW::Search manpage I reckon you could
do some thing like this (untested):
use WWW:Search;
use CGI qw(:standard);
my $query = param('query');
print header,start_html("Search results for $query");
my($search) = new WWW::Search('AltaVista');
$search->native_query(WWW::Search::escape_query($query));
my($result);
print "<UL>\n";
while ($result = $search->next_result()) {
print "<LI>\n",$result->url, "</LI>\n";
};
print "</UL>\n",end_html;
You would refer to it like http://localhost/cgi-bin/search.pl?query=whatever
And that should be about it - not ver sophisticated of course but there
you go - I'm sure you could improve upon it.
Anyhow you made me install WWW::Search which might be a good thing.
/J\
--
Jonathan Stowe <jns@btinternet.com>
Some of your questions answered:
<URL:http://www.btinternet.com/~gellyfish/resources/wwwfaq.htm>
Hastings: <URL:http://www.newhoo.com/Regional/UK/England/East_Sussex/Hastings>
------------------------------
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 5021
**************************************
