[24470] in Perl-Users-Digest
Perl-Users Digest, Issue: 6653 Volume: 10
daemon@ATHENA.MIT.EDU (Perl-Users Digest)
Fri Jun 4 14:05:59 2004
Date: Fri, 4 Jun 2004 11:05:06 -0700 (PDT)
From: Perl-Users Digest <Perl-Users-Request@ruby.OCE.ORST.EDU>
To: Perl-Users@ruby.OCE.ORST.EDU (Perl-Users Digest)
Perl-Users Digest Fri, 4 Jun 2004 Volume: 10 Number: 6653
Today's topics:
Can one set perlvars on command line? <jkrugman345@yahbitoo.com>
Re: Cute bit of Perl to Assign $1,$2 to named variables <gnari@simnet.is>
Re: Delete a line out of a flat file database <usenet@morrow.me.uk>
Re: Delete a line out of a flat file database <nobull@mail.com>
Re: LWP::UserAgent problem - 500 error <noreply@gunnar.cc>
Re: perl style and returning from function? <usenet@morrow.me.uk>
Re: perl style and returning from function? <notvalid@email.com>
Re: Please help newbie with sendmail problem ! <nobull@mail.com>
Re: Regexp: Lazy match workaround? <nobull@mail.com>
Re: Regexp: Lazy match workaround? <nobull@mail.com>
Re: Regexp: Lazy match workaround? <nobull@mail.com>
Re: Regexp: Lazy match workaround? <usenet@morrow.me.uk>
Re: Why is this upload script not working (Mark Constant)
Re: Why is this upload script not working <usenet@morrow.me.uk>
Re: Why is this upload script not working <noreply@gunnar.cc>
Re: Why is this upload script not working <usenet@morrow.me.uk>
Re: Why is this upload script not working <noreply@gunnar.cc>
Re: Why is this upload script not working <noreply@gunnar.cc>
Digest Administrivia (Last modified: 6 Apr 01) (Perl-Users-Digest Admin)
----------------------------------------------------------------------
Date: Fri, 4 Jun 2004 17:54:48 +0000 (UTC)
From: J Krugman <jkrugman345@yahbitoo.com>
Subject: Can one set perlvars on command line?
Message-Id: <c9qd18$jcs$1@reader2.panix.com>
Is there any trick to set a Perl variable (or any global variable,
for that matter) on the command line, as in, for example:
% perl {{{set $| to 1}}} somescript.pl --opt --flag arg
so that myscript.pl started out with $| having value 1?
TIA,
jill
--
To s&e^n]d me m~a}i]l r%e*m?o\v[e bit from my a|d)d:r{e:s]s.
------------------------------
Date: Fri, 4 Jun 2004 17:39:15 -0000
From: "gnari" <gnari@simnet.is>
Subject: Re: Cute bit of Perl to Assign $1,$2 to named variables
Message-Id: <c9qc0m$29u$1@news.simnet.is>
"Uri Guttman" <uri@stemsystems.com> wrote in message
news:x77junpgtk.fsf@mail.sysarch.com...
> >>>>> "z" == zzapper <david@tvis.co.uk> writes:
>
> z> my ($first,$second)=/([a-z]+).*?([0-9]+)/i;
>
> z> Note the absense of a ~
to 'zzapper':
this is a special case of the construct
my @arr= $variable =~ /regexp/;
which is parsed as
my @arr= ($variable =~ /regexpcontaining(catching)group(s)/);
the match in list context returns a list of the cought groups
($1,$2...)
the special case consists of the fact that $_ is the default
variable used when a binding operator (=~ or !~) is not used.
this in combination with the construct
my ($a,$b,$c)=@arr;
to assign a list/array to a list gives you this 'cute' idiom
>
> and the direct assignment of grabbed strings is well known and
> documented and i wouldn't call it cute. it just something you haven't
> seen before.
I remember that I found this one of the many 'cute' things in perl
when I was starting to use the language (some time ago, now).
So do not let these reactions upset you, zzapper. Be not shy
about enjoying these 'discoveries' as you realise them,
just remember that many regulars here are likely to have
seen them before. :-)
gnari
------------------------------
Date: Fri, 4 Jun 2004 15:16:50 +0000 (UTC)
From: Ben Morrow <usenet@morrow.me.uk>
Subject: Re: Delete a line out of a flat file database
Message-Id: <c9q3p1$9cb$1@wisteria.csv.warwick.ac.uk>
Quoth constants@mix-net.net (Mark Constant):
> I have pre-made code that deletes a line from a flat file database. I
> am trying to pass an argument through a link to give the name of the
> line to delete.
>
> Here is my database.txt
> image020.jpg | 6/4/2004 | 10:19:59 | | rena
>
> Here is how I use the link
> delete.cgi?filedelete=$filename
>
> Now here is what prints out
> image020.jpg
> File image020.jpg not found!
>
> It is obvious that it is grabbing the argument because it prints out
> image020.jpg. The thing I don't understand is why it is not matching
> with the image020.jpg in the database.txt.
>
> Here is my code
> #!c:/perl/bin/perl
>
> use strict;
> use warnings;
> use CGI;
> use CGI::Carp qw(fatalsToBrowser);
> my $q = new CGI;
> print $q->header, $q->start_html('Delete File');
>
> my $action = new CGI;
> my @temp=split(/=/,$ENV{'QUERY_STRING'});
DON'T EVER DO THIS AGAIN. Use CGI.
> my $filedelete = $temp[1];
my $filedelete = $action->param('filedelete');
> my $file = 'C:/Program Files/Apache
> Group/Apache2/htdocs/quickbooks/database.txt';
> my $found = undef;
my $found;
> my (@ary);
my @ary;
> my $line;
>
> open( OLD, $file ) or die "Couldn't open old file $file: $! \n";
Don't put "\n" on the end of die messages.
Use lexical filehandles.
Specify the mode to open the file in, for safety.
open my $OLD, '<', $file
or die "can't open $file: $!";
> print $temp[1];
> foreach $line (@ary) {
for my $line (@ary) {
Create variables in the smallest possible scope.
> chomp($line);
> (my $filename, my $filedate, my $filetime, my $notes, my $user) =
my ($filename, $filedate, $filetime, $notes, $user) =
But anyway, why do you need more than
my ($filename) =
?
> split(/\|/,$line);
You are splitting on /\|/. This will leave whitespace all round your
filename. Try
... = split /\s* \| \s*/x, $line;
> push( @ary, $line ) unless ( $filedelete eq $filename );
> $found = 1 if ( $filedelete eq $filename );
None of those parens are necessary.
> }
>
> close OLD or die "Couldn't close old file $file: $! \n";
>
> unless ($found) {
> print $action->h2("File $filedelete not found!");
> exit;
No. This will not correctly end the HTML.
> }
>
> open( NEW, ">$file" ) or die "Couldn't open new file $file: $!\n";
> foreach (@ary) {
> print NEW $_, "\n"
> }
>
> close NEW or "Couldn't close new file $file: $! \n";;
>
> exit;
Nor will this.
if ($found) {
open my $NEW, '>', $file or die "couldn't create $file: $!";
print $NEW "$_\n" for @ary;
}
else {
print $action->h2("File $filedelete not found!");
}
> print $q->end_html;
You *must* use locking in a situation like this, or you will end up with
a corrupted database. Something like:
use Fcntl qw/:flock/;
{
open my $OLD, '<', ...;
flock $OLD, LOCK_SH or die "can't acquire read lock: $!";
# read stuff
}
# $OLD closes here, lock is released
if ($found) {
open my $NEW, '>', ...;
flock $NEW, LOCK_EX or die "can't acquire write lock: $!";
# write stuff
}
# ditto for $NEW
Alternatively, you could open the file '+<' and then lock it LOCK_EX,
and truncate it rather than closing/reopening.
Ben
--
It will be seen that the Erwhonians are a meek and long-suffering people,
easily led by the nose, and quick to offer up common sense at the shrine of
logic, when a philosopher convinces them that their institutions are not based
on the strictest morality. [Samuel Butler, paraphrased] ben@morrow.me.uk
------------------------------
Date: 04 Jun 2004 17:22:46 +0100
From: Brian McCauley <nobull@mail.com>
Subject: Re: Delete a line out of a flat file database
Message-Id: <u9oenze1ih.fsf@wcl-l.bham.ac.uk>
constants@mix-net.net (Mark Constant) writes:
> Subject: Delete a line out of a flat file database
See FAQ: "How do I [ ... ]delete a line in a file [...]?"
> I have pre-made code that deletes a line from a flat file database.
What do you mean by "pre-made"? You mean someone else gave you this
code. Give it back to them.
> Here is my code
> #!c:/perl/bin/perl
>
> use strict;
> use warnings;
> use CGI;
> use CGI::Carp qw(fatalsToBrowser);
Good start.
> my $q = new CGI;
> print $q->header, $q->start_html('Delete File');
>
> my $action = new CGI;
What? Two CGI objects? Why?
> my @temp=split(/=/,$ENV{'QUERY_STRING'});
If you are using CGI why access $ENV{'QUERY_STRING'} directly?
> my $filedelete = $temp[1];
Ever heard of a list slice? There's no need for @temp.
> my $file = 'C:/Program Files/Apache
> Group/Apache2/htdocs/quickbooks/database.txt';
> my $found = undef;
No need to explicitly initialise to undef.
> my (@ary);
> my $line;
You are suffering from premature declaration. Variables should
usually be declared where they are first used.
>
> open( OLD, $file ) or die "Couldn't open old file $file: $! \n";
> print $temp[1];
> foreach $line (@ary) {
Here is where you should have declared $line.
@ary is always empty here so this loop will never do anything.
I think you meant to say:
while (my $line = <OLD>) {
> chomp($line);
> (my $filename, my $filedate, my $filetime, my $notes, my $user) =
> split(/\|/,$line);
my can take a list of aguments so the above is more simply written:
my ($filename, $filedate, $filetime, $notes, $user) =
split(/\|/,$line);
> push( @ary, $line ) unless ( $filedelete eq $filename );
> $found = 1 if ( $filedelete eq $filename );
Having and if and an unless with the same constion makes me think
you'd be better off with a if-else.
> }
>
> close OLD or die "Couldn't close old file $file: $! \n";
>
> unless ($found) {
> print $action->h2("File $filedelete not found!");
> exit;
You forgot the end_html.
> }
>
> open( NEW, ">$file" ) or die "Couldn't open new file $file: $!\n";
> foreach (@ary) {
> print NEW $_, "\n"
> }
You have not considered that the server may be handling two requests
at the same time. You need some kind of file locking.
> close NEW or "Couldn't close new file $file: $! \n";;
You forgot the die;
>
> exit;
This is spurious.
> print $q->end_html;
--
\\ ( )
. _\\__[oo
.__/ \\ /\@
. l___\\
# ll l\\
###LL LL\\
------------------------------
Date: Fri, 04 Jun 2004 17:24:18 +0200
From: Gunnar Hjalmarsson <noreply@gunnar.cc>
Subject: Re: LWP::UserAgent problem - 500 error
Message-Id: <2ibj0aFk70mmU1@uni-berlin.de>
RP wrote:
> Matt Garrish wrote:
>> Your host has either configured their server not to allow any
>> outbound requests, or as I said in my previous post, they have a
>> proxy you should be going through. No one here can help you with
>> that, though. If you have a problem running your script once you
>> have the details of how to connect out, you can always try back
>> then.
>
> Is it normal for a web host to be configured that way?
No, at least not if you are paying for the web space. I think it's not
unusual on 'free' hosts.
> I've been considering switching hosts anyway, and this might be the
> last straw.
Ask them to help you connect out. If they don't - change hosting provider.
--
Gunnar Hjalmarsson
Email: http://www.gunnar.cc/cgi-bin/contact.pl
------------------------------
Date: Fri, 4 Jun 2004 15:23:40 +0000 (UTC)
From: Ben Morrow <usenet@morrow.me.uk>
Subject: Re: perl style and returning from function?
Message-Id: <c9q45s$9cb$2@wisteria.csv.warwick.ac.uk>
Quoth Uri Guttman <uri@stemsystems.com>:
> >>>>> "BM" == Ben Morrow <usenet@morrow.me.uk> writes:
>
> BM> Quoth wherrera@lynxview.com (Bill):
> >> What do you think is better:
> >>
> >> ...
> >> return ($rc and $rc == 1) ? 1 : 0;
> >> }
> >>
> >> or
> >>
> >> $rc and $rc == 1 and return 1;
> >> return 0;
> >> }
>
> BM> return $rc == 1 ? 1 : 0;
>
> why not just return $rc == 1? the OP didn't specify what the false value
> must be.
Yes he did. He specified 0. (IMO that is a bad specification, but... :)
> BM> Perl is not C. A value of undef will quite happily be != 0.
>
> but it will trigger an uninitialized warning.
True. I tend to turn those off, so I tend to forget about them... undef
is too useful to be warned about :).
> but the OP wasn't testing for undef.
No... I was puzzled as to what he thought he *was* testing for, though.
The idiom reminded me of
if (p && *p == 'a') {
in C, and I wondered if that was what the OP had in mind.
> BM> A better answer altogether might be
>
> BM> $rc == 1 and return 1;
> BM> return;
>
> i prefer:
>
> return 1 if $rc == 1 ;
> return ;
>
> then the returns line up prettily :)
Yes. I would also be inclined to use
$rc == 1 ? return 1
: return;
but that's just because I'm addicted to ?:, and would really like to
have 'then/else' as a low-precedence version:
$rc == 1 then return 1
else return;
:)
Ben
--
Joy and Woe are woven fine,
A Clothing for the Soul divine William Blake
Under every grief and pine 'Auguries of Innocence'
Runs a joy with silken twine. ben@morrow.me.uk
------------------------------
Date: Fri, 04 Jun 2004 17:56:00 GMT
From: Ala Qumsieh <notvalid@email.com>
Subject: Re: perl style and returning from function?
Message-Id: <QI2wc.79704$rD1.25837@newssvr25.news.prodigy.com>
Uri Guttman wrote:
>>>>>>"BM" == Ben Morrow <usenet@morrow.me.uk> writes:
> BM> return $rc == 1 ? 1 : 0;
>
> why not just return $rc == 1? the OP didn't specify what the false value
> must be.
In this case,
return $rc;
should suffice.
--Ala
------------------------------
Date: 04 Jun 2004 17:23:45 +0100
From: Brian McCauley <nobull@mail.com>
Subject: Re: Please help newbie with sendmail problem !
Message-Id: <u9llj3e1gu.fsf@wcl-l.bham.ac.uk>
jake@ariel.co.uk (Jake Gourd) writes:
> Subject: Please help newbie with sendmail problem !
"Please help" and "problem" in subject lines are a pointless waste of
space. Good subject lines are very important. Wasting space in them
is seen as bad manners. Everyone wants their posts to be read - in
some newsgroups this leads to an emphasis arms-race. For this reason
any unwaranted emphasis in subject lines (such as your "!") is also
considered rudness.
The word "newbie" in subject lines will usually be read as "person too
lazy to read the FAQ" because experience has shown us that 95% of
posts with newbie in the subject are repeating FAQs.
Do not get upset me for telling you all this. I'm only trying to help
by telling you how your actions are likely to be percieved.
I should also point out that you are indeed repeating a FAQ. Do not
get upset me for telling you this either. It would be quite
irrational for you to get upset at me because of something _you_ have
done.
> open(SENDMAIL, "/usr/sbin/sendmail") or die "Cannot open $sendmail:
> $!";
Here you are opening the file /usr/sbin/sendmail for reading. For
details of the Perl open() function see "perldoc -f open".
I would guess that what you actually wanted to do is run
/usr/sbin/sendmail (with appropriate switches) as a subprocess and
pipe stuff to it.
> print SENDMAIL "test@test.com";
> print SENDMAIL "test subject";
> print SENDMAIL "jake@goodprint.co.uk";
> print SENDMAIL "Content-type: text/plain\n\n";
That is not a well formed mail message header. The To header should
start "To:", the subject header "Subject:" and so on. Every header
should end with a newline.
The @ character is meta in double quotes and needs to be escaped.
As MJD famously put it: You can't just make shit up and expect the
computer to know what you mean, retardo!
For an example of correct usage of sendmail please see FAQ "How do I
send mail?". However as many others have pointed out, notwithstanding
the FAQ, you maybe better off not using sendmail directly.
--
\\ ( )
. _\\__[oo
.__/ \\ /\@
. l___\\
# ll l\\
###LL LL\\
------------------------------
Date: 04 Jun 2004 17:33:20 +0100
From: Brian McCauley <nobull@mail.com>
Subject: Re: Regexp: Lazy match workaround?
Message-Id: <u9hdtre10v.fsf@wcl-l.bham.ac.uk>
anno4000@lublin.zrz.tu-berlin.de (Anno Siegel) writes:
> R. Rajesh Jeba Anbiah <ng4rrjanbiah@rediffmail.com> wrote in comp.lang.perl.misc:
> > Brian McCauley <nobull@mail.com> wrote in message
> > news:<u94qpsg9dc.fsf@wcl-l.bham.ac.uk>...
>
> I couldn't understand why a single
> > pattern didn't catch up all __add (). In the string __add () appears
> > two times, but my pattern didn't catch it.
> > /(\w+) = new (.*?)\(\).*?(__add \((.*?)\).+?)+.*?\}/is
> > ^^^^^^^^^^^^^^^^^^^^
>
> That's because the same pair of capturing parentheses matches both
> occurrences of "__add ()". In effect only the second match is captured.
> In isolation this may be clearer:
>
> $_ = 'xxAxxB';
> no warnings 'uninitialized';
> print "match: \$1: |$1|, \$2: |$2|\n" if /(xx.)+/;
> print "match: \$1: |$1|, \$2: |$2|\n" if /(xx.)(xx.)/;
Whilst what you say it is important and relevant it's not actually
right in this pariticular case.
In this paricular case it captures only the first.
This is because in regex the leftmost greedy/non-greedy repeats take
precedence.
Consider
' A C !' =~ /(A.*?)+.*!/;
Here the repeated group matches only 'A'. It does not match the 'C'
because the non-greedyness of the '*?' is more important than the
greedyness of the '+'. Since it is possible to find a match such that
the '.*?' matched '' then that is the best match.
--
\\ ( )
. _\\__[oo
.__/ \\ /\@
. l___\\
# ll l\\
###LL LL\\
------------------------------
Date: 04 Jun 2004 17:38:23 +0100
From: Brian McCauley <nobull@mail.com>
Subject: Re: Regexp: Lazy match workaround?
Message-Id: <u9d64fe0sg.fsf@wcl-l.bham.ac.uk>
ng4rrjanbiah@rediffmail.com (R. Rajesh Jeba Anbiah) writes:
> Brian McCauley <nobull@mail.com> wrote in message news:<u94qpsg9dc.fsf@wcl-l.bham.ac.uk>...
> > while ($str =~ /(\w+) = new (.*?)\(\)(.*?)\}/isg ) {
> > my @match = ($1,$2);
> > push @match, $3 =~ /__add \((.*?)\)/ig;
> > print join ', ', map "'$_'", @match;
> > print "\n";
> > }
>
> > I'm sure one could do it all in a single m// using (?{}) but that would
> > make for hard to read/maintain code.
>
> Yes, that is what I was trying.
I very much doubt that you were using (?{}) since it does not appear
in any of your code. (?{}) it is a very advanced feature allowing you
to insert bits of Perl code that are to be executed during the regex
matching operation.
I also very much doubt that you were trying to make hard to
read/maintain code. :-)
--
\\ ( )
. _\\__[oo
.__/ \\ /\@
. l___\\
# ll l\\
###LL LL\\
------------------------------
Date: 04 Jun 2004 17:47:42 +0100
From: Brian McCauley <nobull@mail.com>
Subject: Re: Regexp: Lazy match workaround?
Message-Id: <u98yf3e0cx.fsf@wcl-l.bham.ac.uk>
Brian McCauley <nobull@mail.com> writes:
> Consider
>
> ' A C !' =~ /(A.*?)+.*!/;
>
> Here the repeated group matches only 'A'. It does not match the 'C'
> because the non-greedyness of the '*?' is more important than the
> greedyness of the '+'.
I meant, of course, consider
' A C !' =~ /(\w.*?)+.*!/;
Obviously /A/ won't match 'C' ever!
--
\\ ( )
. _\\__[oo
.__/ \\ /\@
. l___\\
# ll l\\
###LL LL\\
------------------------------
Date: Fri, 4 Jun 2004 16:56:10 +0000 (UTC)
From: Ben Morrow <usenet@morrow.me.uk>
Subject: Re: Regexp: Lazy match workaround?
Message-Id: <c9q9ja$cuo$2@wisteria.csv.warwick.ac.uk>
Quoth Brian McCauley <nobull@mail.com>:
> ng4rrjanbiah@rediffmail.com (R. Rajesh Jeba Anbiah) writes:
>
> > Brian McCauley <nobull@mail.com> wrote in message news:<u94qpsg9dc.fsf@wcl-l.bham.ac.uk>...
>
> > > while ($str =~ /(\w+) = new (.*?)\(\)(.*?)\}/isg ) {
> > > my @match = ($1,$2);
> > > push @match, $3 =~ /__add \((.*?)\)/ig;
> > > print join ', ', map "'$_'", @match;
> > > print "\n";
> > > }
> >
> > > I'm sure one could do it all in a single m// using (?{}) but that would
> > > make for hard to read/maintain code.
> >
> > Yes, that is what I was trying.
>
> I very much doubt that you were using (?{}) since it does not appear
> in any of your code. (?{}) it is a very advanced feature allowing you
> to insert bits of Perl code that are to be executed during the regex
> matching operation.
...and (obviously) isn't supported by PCRE.
Ben
--
Like all men in Babylon I have been a proconsul; like all, a slave ... During
one lunar year, I have been declared invisible; I shrieked and was not heard,
I stole my bread and was not decapitated.
~ ben@morrow.me.uk ~ Jorge Luis Borges, 'The Babylon Lottery'
------------------------------
Date: 4 Jun 2004 08:20:07 -0700
From: constants@mix-net.net (Mark Constant)
Subject: Re: Why is this upload script not working
Message-Id: <ce43fdea.0406040720.76301a28@posting.google.com>
Gunnar Hjalmarsson <noreply@gunnar.cc> wrote in message news:<2i9lv9Fkuk0jU1@uni-berlin.de>...
> Ben Morrow wrote:
> > Quoth constants@mix-net.net (Mark Constant):
> >>
> >> my $fh = $q->upload('upfile');
> >> $q->uploadInfo($fh)->{'Content-Disposition'} =~
> >> /filename="([\w\-\. ]+)"/;
> >> my $name = ($1 or $starttime);
> >
> > my $UPLOAD = $q->upload('upfile');
> > my $upload = $q->param('upfile');
>
> It didn't occur to me that you can use both the upload() and param()
> function in the same upload routine. (That's why I had grabbed the
> name through uploadInfo(). Think the docs could be clearer...)
>
> Anyway I tried it, and it seems to work.
Thank you to everybody that helped. Especially Gunnar and Ben Morrow.
I just wanted to know since each time they are uploading the same
quickbooks file with the same name how can I append the date and time
to the file. I have tried the join function and when I just print
filename the name comes out as 6/4/200411:10:17Ride.doc which is what
I want but when I replace $name in the open line with $filename it
says "Use of uninitialized value in concatenation (.) or string at".
#!c:/perl/bin/perl
use strict;
use warnings;
use CGI;
my $username= $ENV{'REMOTE_USER'};
my $database = 'c:/progra~1/apache~1/apache2/htdocs/quickbooks/database.txt';
my $dir = 'c:/progra~1/apache~1/apache2/htdocs/quickbooks';
my $starttime = time;
(my $sec, my $min, my $hr, my $day, my $mon, my $year, my $wday, my
$yday, my $isdst) = localtime(time);
my $fixmonth = $mon + 1;
my $longyear = $year + 1900;
my $date = "$fixmonth/$day/$longyear";
my $time = "$hr:$min:$sec";
my $q = new CGI;
my $fh = $q->upload('upfile');
$q->uploadInfo($fh)->{'Content-Disposition'} =~ /filename=".*?([-\w.
]+)"/;
my $name = $1 or die "Couldn't grab filename $!";
my $finalname = join($time, $date, $name);
my $notes;
open OUTF, ">>$database" or die $1;
flock(OUTF, 2);
seek(OUTF, 0, 2);
print OUTF "$name | $date | $time | $notes | $username\n";
close(OUTF);
open FILE, "> $dir/$name" or die $!;
binmode FILE;
print FILE $_ while <$fh>;
close FILE;
print $q->header, $q->start_html('Uploading File');
print $q->h1('Upload Results');
print "$finalname was uploaded by $username.<br>";
print "It took ", time - $starttime, " seconds.\n";
print "It is now safe to go <a href='index.cgi'>back</a>.\n";
$q->end_html;
------------------------------
Date: Fri, 4 Jun 2004 15:40:13 +0000 (UTC)
From: Ben Morrow <usenet@morrow.me.uk>
Subject: Re: Why is this upload script not working
Message-Id: <c9q54t$aco$1@wisteria.csv.warwick.ac.uk>
Quoth constants@mix-net.net (Mark Constant):
>
> Thank you to everybody that helped. Especially Gunnar and Ben Morrow.
> I just wanted to know since each time they are uploading the same
> quickbooks file with the same name how can I append the date and time
> to the file. I have tried the join function and when I just print
> filename the name comes out as 6/4/200411:10:17Ride.doc which is what
> I want but when I replace $name in the open line with $filename it
> says "Use of uninitialized value in concatenation (.) or string at".
This is because you don't define a variable '$filename' anywhere...
> #!c:/perl/bin/perl
> use strict;
> use warnings;
> use CGI;
> my $username= $ENV{'REMOTE_USER'};
This is highly unreliable: unless you know that in your case clients
will set it correctly, it is much better to have another field on the
form for the username.
> my $database = 'c:/progra~1/apache~1/apache2/htdocs/quickbooks/database.txt';
> my $dir = 'c:/progra~1/apache~1/apache2/htdocs/quickbooks';
my $database = "$dir/database.txt";
, please... you're bound to forget to update one of the two when it
changes.
> my $starttime = time;
> (my $sec, my $min, my $hr, my $day, my $mon, my $year, my $wday, my
> $yday, my $isdst) = localtime(time);
> my $fixmonth = $mon + 1;
> my $longyear = $year + 1900;
> my $date = "$fixmonth/$day/$longyear";
> my $time = "$hr:$min:$sec";
No, don't do this.
use POSIX qw/strftime/;
my $datetime = strftime "%m/%d/%Y%H:%M:%S" => localtime;
Or whatever format you actually want: your chosen format is a pretty bad
one. Firstly it contains slashes, which is Not Good for filenames;
secondly, it would be much better to have a format which sorts
correctly[1]. Something like:
my $datetime = strftime "%Y-%m-%d-%H:%M:%S" => localtime;
is pretty standard.
[1] (thirdly, the m/d/y format is so unbelievably brane-damaged I don't
know why anyone uses it...)
> my $q = new CGI;
> my $fh = $q->upload('upfile');
> $q->uploadInfo($fh)->{'Content-Disposition'} =~ /filename=".*?([-\w.
> ]+)"/;
> my $name = $1 or die "Couldn't grab filename $!";
DON'T USE $1 UNLESS YOU KNOW THE MATCH SUCCEEDED.
Have you even read my last post, which shows you how to do this properly?
> my $finalname = join($time, $date, $name);
Read perldoc -f join. The first argument to join is the string to join
the others together with. You can't just guess at what a function does
and expect to get it right.
> my $notes;
>
> open OUTF, ">>$database" or die $1;
'die $1'? I think not.
> flock(OUTF, 2);
> seek(OUTF, 0, 2);
NO NO NO. Use the constants in Fcntl.pm.
use Fcntl qw/:flock :seek/;
flock OUTF, LOCK_EX or die "can't acquire write lock on $database: $!";
seek OUTF, 0, SEEK_END or die "can't seek to the end of $database: $!";
You don't need to seek anyway as you opened the file in append mode.
Ben
--
I must not fear. Fear is the mind-killer. I will face my fear and
I will let it pass through me. When the fear is gone there will be
nothing. Only I will remain.
ben@morrow.me.uk Frank Herbert, 'Dune'
------------------------------
Date: Fri, 04 Jun 2004 18:33:12 +0200
From: Gunnar Hjalmarsson <noreply@gunnar.cc>
Subject: Re: Why is this upload script not working
Message-Id: <2ibn1hFl4pv9U1@uni-berlin.de>
Ben Morrow wrote:
> Quoth constants@mix-net.net (Mark Constant):
>
> [1] (thirdly, the m/d/y format is so unbelievably brane-damaged I
> don't know why anyone uses it...)
Agreed. :)
>> my $q = new CGI;
>> my $fh = $q->upload('upfile');
>> $q->uploadInfo($fh)->{'Content-Disposition'} =~
>> /filename=".*?([-\w. ]+)"/;
>> my $name = $1 or die "Couldn't grab filename $!";
>
> DON'T USE $1 UNLESS YOU KNOW THE MATCH SUCCEEDED.
Why are you shouting? ;-) Since I'm guilty of that detail, I must say
that I don't understand the objection, Ben. If the match fails, $1
will be undef and the program will die, so what's the problem?
>> flock(OUTF, 2);
>> seek(OUTF, 0, 2);
>
> NO NO NO. Use the constants in Fcntl.pm.
>
> use Fcntl qw/:flock :seek/;
>
> flock OUTF, LOCK_EX
> or die "can't acquire write lock on $database: $!";
> seek OUTF, 0, SEEK_END
> or die "can't seek to the end of $database: $!";
>
> You don't need to seek anyway as you opened the file in append
> mode.
Considering that, is there any need to flock?
--
Gunnar Hjalmarsson
Email: http://www.gunnar.cc/cgi-bin/contact.pl
------------------------------
Date: Fri, 4 Jun 2004 16:54:29 +0000 (UTC)
From: Ben Morrow <usenet@morrow.me.uk>
Subject: Re: Why is this upload script not working
Message-Id: <c9q9g5$cuo$1@wisteria.csv.warwick.ac.uk>
Quoth Gunnar Hjalmarsson <noreply@gunnar.cc>:
> Ben Morrow wrote:
> >
> > DON'T USE $1 UNLESS YOU KNOW THE MATCH SUCCEEDED.
>
> Why are you shouting? ;-) Since I'm guilty of that detail, I must say
> that I don't understand the objection, Ben. If the match fails, $1
> will be undef and the program will die, so what's the problem?
No. If the match fails $1 will be whatever it happened to be set to by
the last match that succeeded. In this *particular* case, there isn't
one, so it's undef, but that is definitely a bug waiting to happen.
> > You don't need to seek anyway as you opened the file in append
> > mode.
>
> Considering that, is there any need to flock?
Yes. Append mode guarantees that each write(2) goes onto the end of the
file; you have no guarantee here that you might not make several
write(2)s which interleave with another process's.
Ben
--
Like all men in Babylon I have been a proconsul; like all, a slave ... During
one lunar year, I have been declared invisible; I shrieked and was not heard,
I stole my bread and was not decapitated.
~ ben@morrow.me.uk ~ Jorge Luis Borges, 'The Babylon Lottery'
------------------------------
Date: Fri, 04 Jun 2004 18:57:37 +0200
From: Gunnar Hjalmarsson <noreply@gunnar.cc>
Subject: Re: Why is this upload script not working
Message-Id: <2ibofaFlcberU1@uni-berlin.de>
Ben Morrow wrote:
> Quoth Gunnar Hjalmarsson <noreply@gunnar.cc>:
>> Ben Morrow wrote:
>>> DON'T USE $1 UNLESS YOU KNOW THE MATCH SUCCEEDED.
>>
>> Why are you shouting? ;-) Since I'm guilty of that detail, I must
>> say that I don't understand the objection, Ben. If the match
>> fails, $1 will be undef and the program will die, so what's the
>> problem?
>
> No. If the match fails $1 will be whatever it happened to be set to
> by the last match that succeeded. In this *particular* case, there
> isn't one, so it's undef, but that is definitely a bug waiting to
> happen.
You are right, of course. Thanks! (Damned, embarrassing mistake..)
--
Gunnar Hjalmarsson
Email: http://www.gunnar.cc/cgi-bin/contact.pl
------------------------------
Date: Fri, 04 Jun 2004 19:24:13 +0200
From: Gunnar Hjalmarsson <noreply@gunnar.cc>
Subject: Re: Why is this upload script not working
Message-Id: <2ibq15Fl20kgU1@uni-berlin.de>
Ben Morrow wrote:
> Quoth constants@mix-net.net (Mark Constant):
>>
>> $q->uploadInfo($fh)->{'Content-Disposition'} =~
>> /filename=".*?([-\w. ]+)"/;
>> my $name = $1 or die "Couldn't grab filename $!";
>
> DON'T USE $1 UNLESS YOU KNOW THE MATCH SUCCEEDED.
To the OP: Ben made me (finally) realize my mistake as regards that
piece of code.
> Have you even read my last post, which shows you how to do this
> properly?
Not saying that this is better, but a very simple fix out from the
latest script version might be:
$q->uploadInfo($fh)->{'Content-Disposition'} =~
/filename=".*?([-\w. ]+)"/ or die "Couldn't grab filename $!";
my $name = $1;
or maybe:
$q->param('upfile') =~ /([-\w. ]+)$/
or die "Couldn't grab filename $!";
my $name = $1;
With any of those changes, the script will die if the match fails even
if $1 had previously been set in some other match.
--
Gunnar Hjalmarsson
Email: http://www.gunnar.cc/cgi-bin/contact.pl
------------------------------
Date: 6 Apr 2001 21:33:47 GMT (Last modified)
From: Perl-Users-Request@ruby.oce.orst.edu (Perl-Users-Digest Admin)
Subject: Digest Administrivia (Last modified: 6 Apr 01)
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: due to the current flood of worm email banging on ruby, the smtp
server on ruby has been shut off until further notice.
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 V10 Issue 6653
***************************************
