[19011] in Perl-Users-Digest
Perl-Users Digest, Issue: 1206 Volume: 10
daemon@ATHENA.MIT.EDU (Perl-Users Digest)
Wed Jun 27 18:07:56 2001
Date: Wed, 27 Jun 2001 15:05:08 -0700 (PDT)
From: Perl-Users Digest <Perl-Users-Request@ruby.OCE.ORST.EDU>
To: Perl-Users@ruby.OCE.ORST.EDU (Perl-Users Digest)
Message-Id: <993679508-v10-i1206@ruby.oce.orst.edu>
Content-Type: text
Perl-Users Digest Wed, 27 Jun 2001 Volume: 10 Number: 1206
Today's topics:
Communication error : Reason Bad file descriptor <nospam@notformail.com>
Re: Convert DD-MM-YYYY to age <bkesuma@REMOVE.CAPITALS.yahoo.com>
Re: Convert DD-MM-YYYY to age <mbudash@sonic.net>
Re: Convert DD-MM-YYYY to age <godzilla@stomp.stomp.tokyo>
Re: error making Archive::Zip (Gururaj Upadhye)
Re: error making Archive::Zip <bart.lateur@skynet.be>
Re: expression match help (Greg Bacon)
Re: expression match help (Jay Tilton)
Re: expression match help <godzilla@stomp.stomp.tokyo>
Re: expression match help <carlos@plant.student.utwente.nl>
Re: expression match help <hoa@nortelnetworks.com>
Re: expression match help <mbudash@sonic.net>
Re: expression match help <hoa@nortelnetworks.com>
Re: from linux to WinNT4 Ms Sql <jkekoni@cc.hut.fi>
Highlight characters in DOS. <hoa@americasm01.nt.com>
Highlight message in DOS <hoa@nortelnetworks.com>
Re: Interacting prompts with perl <nospam-abuse@ilyaz.org>
Re: newbie directory question <"goodrow"@opencity. com>
Re: Perl *is* strongly typed (was Re: Perl description) (Abigail)
Re: range operator in scalar context - how to make it t (Charles DeRykus)
Re: Search Patterns (Zur Aougav)
Selling Scripts <john@trumpetweb.co.uk>
Re: Selling Scripts <tsee@gmx.net>
Re: Six degrees of separation (Abigail)
testing <hoa@nortelnetworks.com>
Re: XML::DOM error when there is a "&" in the data <hoa@nortelnetworks.com>
Digest Administrivia (Last modified: 6 Apr 01) (Perl-Users-Digest Admin)
----------------------------------------------------------------------
Date: Wed, 27 Jun 2001 21:18:16 +0200
From: "DetUudslukkelige" <nospam@notformail.com>
Subject: Communication error : Reason Bad file descriptor
Message-Id: <9hdbbq$qdi$1@news.inet.tele.dk>
Dear group
Forgive me for asking again today, but this time the problem is very
specific:
When I use my FormMail script (via SMTP) I allways get the error:
Communication error : Reason Bad file descriptor
Below is the script. Anyone knows what I am doing wrong?
Thanks in advance.
-Mathias
#!/
# ^ The server uses mod_perl - no path nessesary
############################################################################
######
# Auto Forms
#
# Allow you to send emails with any info from web forms
#
# work via e-mail or via smtp
#
# FREEWARE
#
# By Alexey Habibulin --> http://www.mycgiscripts.com/
# All rights reserved `
#
# For installation of cgi scripts or any custom works email to
webmaster\@mycgiscripts.com
#
############################################################################
######
#
# Edit here =
#
# Set only ONE of either $mail_path which should go to a
# mail program like sendmail, or $smtp_server which will use
# a SMTP server. Do not set both at once!
# $mail_path='/usr/sbin/sendmail'; #example /use/lib/sendmail
$smtp_server='smtp.mail.dk'; #example smtp.mydomain.com
#Email address (Who will be receiving completed forms)
$toemail='Bent@mail2me.dk';
#Check access to script? If yes, please specify your domain as mydomain.com
$domain='mail2me.dk';
#Collect email addresses in file? if yes, specify unix/nt path to file where
emails will be stored
$store='/data/emailstore.db';
#Enable autoresponder?
$autoresponder=0;
#email message for responder
$aresp=qq~ Hello!
Thank you for form filling! I check it later and reply to you.
Best Regards,
Alex
~;
#Default subject
$subject='Form submitted!';
#Default redirect
$redirect="http://www.mycgiscripts.com";
#It all!
#See info about usage at readme.txt
############################################################################
####
$CRLF="\015\012";
eval { &main; };
if ($@) { error("Content-type: text/html\n\n <html>fatal error:
$@</html>"); }
sub main{
%in=&parse;
if ($smtp_server) {use Socket;$proto = (getprotobyname('tcp'))[2]; $port =
getservbyname('smtp', 'tcp'); $smtp_server =~ s/^\s+//g; $smtp_server =~
s/\s+$//g; $smtpaddr = ($smtp_server =~
/^(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})$/) ? pack('C4',$1,$2,$3,$4) :
(gethostbyname($smtp_server))[4]; if (!$smtpaddr) {die "SMTP host not
found!";exit;}}
#Check for requied fields as $email, subject, message
if ($in{'fromemail'} !~ /.+@.+\..+/) {error("Invalid email address");}
if (!$in{'subject'}) {$in{'subject'} = $subject;}
#Check access if need
if ($domain) {
if ($ENV{'HTTP_REFERER'} !~ /$domain/is) {
error("Access forbidden by administrator");
}
}
#Collect email address if need
if ($store) {
open (OUT, ">>$store") or error("Cannot write to file : $!");
print OUT "$in{'fromemail'}\n";
close OUT;
}
foreach $item (keys %in) {
$var="$item";
$val="$in{$item}";
if ($var =~ /\_val/is) {
if ($val eq "") {$var=~ s#\_val##is;$var=~ s#^(.*?)\_##is;error("$var
cannot be empty!");}
}
}
#Definition of variables
$fromemail=$in{'fromemail'}; #Sended email
$subject = $in{'subject'};
$url=$in{'redirect'}; # redirect if success
if (!$url) {$url=$redirect;}
$ccopy=$in{'cc'}; # carbon copy
$from=$in{'from'}; # From (name)
if ($ccopy) {
if ($ccopy !~ /.+@.+\..+/) {error("Invalid CC email
address");}
}
$efrom=$fromemail;
if ($from) {$efrom="$from <$fromemail>";}
delete $in{'cc'}; delete $in{'from'};
delete $in{'redirect'};
delete $in{'fromemail'};
#Generation of Message
$etext=qq~Hello!
This is results of submitted form by $ENV{'REMOTE_ADDR'}.
PS: Warning this is public available script demo. If any fraudulent script
usage - email to support\@mycgiscripts.com
Submitter Email : $efrom
Fields:
~;
foreach $key (sort keys %in) {
$etext.="$key = $in{$key}\n";
}
$etext.="\n\n";
#send email
if (!$smtp_server) {
open (SM, "|$mail_path -t") or error("Error sending mail! Reason : $!");
print SM "From: ", $efrom, "\n";
print SM "To: $toemail", "\n";
print SM "Cc: $ccopy\n", if ($ccopy);
print SM "X-Mailer: Email manager (http://www.mycgiscripts.com/)\n";
print SM "Subject: ", $subject, "\n\n";
print SM $etext;
close SM;
if ($autoresponder) {
open (SM, "|$mail_path -t") or error("Error sending mail! Reason : $!");
print SM "From: ", $toemail, "\n";
print SM "To: $efrom", "\n";
print SM "X-Mailer: Email manager (http://www.mycgiscripts.com/)\n";
print SM "Subject: ", $subject, "\n\n";
print SM $aresp;
close SM;
}
}else{
socket(SOCK, AF_INET, SOCK_STREAM, $proto) or error ("Socket operation
failed : Reason $!");
connect(SOCK, pack('Sna4x8', AF_INET, $port, $smtpaddr)) or error
("Connection failed : Reason $!");
$oldfh = select(SOCK);
$| = 1; select($oldfh);$_ = <SOCK>;
if (/^[45]/) { close SOCK; error("Service not available : Reason $!"); }
print SOCK "helo localhost$CRLF"; $_ = <SOCK>;
if (/^[45]/) { close SOCK; error ("Communication error : Reason $!"); }
print SOCK "mail from: <", $email, ">$CRLF"; $_ = <SOCK>;
if (/^[45]/) { close SOCK; error ("Communication error : Reason $!"); }
foreach (split(/,/, $to)) {
(/<(.*)>/) ? print SOCK "rcpt to: $1$CRLF" : print SOCK "rcpt to:
<$_>$CRLF";
$_ = <SOCK>; if (/^[45]/) { close SOCK;error("Unknown user. Email address
not valid"); }
}
print SOCK "data$CRLF";$_ = <SOCK>;
if (/^[45]/) { close SOCK; error("Communication error : Reason $!"); }
print SOCK "To: $toemail", $CRLF;
print SOCK "From: $efrom",$CRLF;
print SOCK "Cc: $ccopy\n", if ($ccopy);
print SOCK "X-Mailer: Email manager (http://www.mycgiscripts.com/)$CRLF";
print SOCK "Subject: $subject",$CRLF,$CRLF;
$message =~ s/\r//g;
$message =~ s/\n/$CRLF/g;
print SOCK $etext;
print SOCK $CRLF, '.', $CRLF;$_ = <SOCK>;
if (/^[45]/) { close SOCK;error("Transfer failed : Reason $!"); }
print SOCK "quit", $CRLF;$_ = <SOCK>;close SOCK;
if ($autoresponder) {
socket(SOCK, AF_INET, SOCK_STREAM, $proto) or error("Socket operation
failed : Reason $!");
connect(SOCK, pack('Sna4x8', AF_INET, $port, $smtpaddr)) or
error("Connection failed : Reason $!");
$oldfh = select(SOCK);
$| = 1; select($oldfh);$_ = <SOCK>;
if (/^[45]/) { close SOCK; error("Service not available : Reason $!"); }
print SOCK "helo localhost$CRLF"; $_ = <SOCK>;
if (/^[45]/) { close SOCK; error("Communication error : Reason $!"); }
print SOCK "mail from: <", $email, ">$CRLF"; $_ = <SOCK>;
if (/^[45]/) { close SOCK; error("Communication error : Reason $!"); }
foreach (split(/,/, $to)) {
(/<(.*)>/) ? print SOCK "rcpt to: $1$CRLF" : print SOCK "rcpt to:
<$_>$CRLF";
$_ = <SOCK>; if (/^[45]/) { close SOCK;error("Unknown user. Email address
not valid"); }
}
print SOCK "data$CRLF";$_ = <SOCK>;
if (/^[45]/) { close SOCK; error("Communication error : Reason $!"); }
print SOCK "To: $efrom", $CRLF;
print SOCK "From: $toemail",$CRLF;
print SOCK "X-Mailer: Email manager (http://www.mycgiscripts.com/)$CRLF";
print SOCK "Subject: $subject",$CRLF,$CRLF;
$aresp =~ s/\r//g;
$aresp =~ s/\n/$CRLF/g;
print SOCK $aresp;
print SOCK $CRLF, '.', $CRLF;$_ = <SOCK>;
if (/^[45]/) { close SOCK;error("Transfer failed : Reason $!"); }
print SOCK "quit", $CRLF;$_ = <SOCK>;close SOCK;
}
}
}
if ($url) {print "Location: $url \n\n"; exit;}
print "Content-type: text/html\n\n";
print qq~
<html><head><title>Email results</title></head>
<body>
<font face="Verdana">
<center><font size="3"><b>Email is sent</b><font face="2"><br></center>
<br><br><br>
<small><center>(c)-2001, <a
href="http://www.mycgiscripts.com">www.mycgiscripts.com</a></center></font>
</body>
</html>
~;
exit;
sub error{
$mes=shift;
print qq~Content-type: text/html\n\n
<font face="Verdana" size="2"><center><b>Error</b> : $mes<br><br>
<a href="javascript:history.go(-1)">Back</a>.<br><br><br>
~;
exit;
}
sub parse{my (@pairs, %in);my (@pairs, %in);my ($buffer, $pair, $name,
$value);if ($ENV{'REQUEST_METHOD'} eq 'GET') {@pairs = split(/&/,
$ENV{'QUERY_STRING'});}elsif($ENV{'REQUEST_METHOD'} eq 'POST') {read(STDIN,
$buffer, $ENV{'CONTENT_LENGTH'});@pairs = split(/&/, $buffer);}PAIR: foreach
$pair (@pairs) {($name, $value) = split(/=/, $pair);$name =~ tr/+/ /;$name
=~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;$value =~ tr/+/
/;$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;($value eq
"---") and next PAIR;exists $in{$name} ? ($in{$name} .= "~~$value") :
($in{$name} = $value);}return %in;}
------------------------------
Date: Thu, 28 Jun 2001 03:24:46 +0900
From: Batara Kesuma <bkesuma@REMOVE.CAPITALS.yahoo.com>
Subject: Re: Convert DD-MM-YYYY to age
Message-Id: <20010628032446.08edf65b.bkesuma@REMOVE.CAPITALS.yahoo.com>
On Wed, 27 Jun 2001 19:58:20 +0900
Batara Kesuma <bkesuma@REMOVE.CAPITALS.yahoo.com> wrote:
> Hi,
>
> I am trying to convert DD-MM-YYYY to the age of the person now. I tried
> to
> change the birthday to epoch second with timelocal, and then change the
> time now to epoch second, and then subsctract it, and change the seconds
> to years. But it doesn't work fot birthday before 1970. Is there any
> other
> way to do this? Thank you very much.
>
> --bk
Hi,
Thanks everyone :) At last I use the module Date::Calc for this purpose.
--
How do I verify wether someone has a certain age?
use Date::Calc qw( Decode_Date_EU Today leap_year Delta_Days );
$date = <STDIN>; # get birthday
($year1,$month1,$day1) = Decode_Date_EU($date);
($year2,$month2,$day2) = Today();
if (($day1 == 29) && ($month1 == 2) && !leap_year($year2))
{ $day1--; }
if ( (($year2 - $year1) > 18) ||
( (($year2 - $year1) == 18) &&
(Delta_Days($year2,$month1,$day1, $year2,$month2,$day2) >= 0) ) )
{
print "Ok - you are over 18.\n";
}
else
{
print "Sorry - you aren't 18 yet!\n";
}
------------------------------
Date: Wed, 27 Jun 2001 12:52:51 -0700
From: Michael Budash <mbudash@sonic.net>
Subject: Re: Convert DD-MM-YYYY to age
Message-Id: <mbudash-68C90C.12525127062001@news.pacbell.net>
In article <20010628032446.08edf65b.bkesuma@REMOVE.CAPITALS.yahoo.com>,
Batara Kesuma <bkesuma@REMOVE.CAPITALS.yahoo.com> wrote:
> On Wed, 27 Jun 2001 19:58:20 +0900
> Batara Kesuma <bkesuma@REMOVE.CAPITALS.yahoo.com> wrote:
>
> > Hi,
> >
> > I am trying to convert DD-MM-YYYY to the age of the person now. I tried
> > to
> > change the birthday to epoch second with timelocal, and then change the
> > time now to epoch second, and then subsctract it, and change the seconds
> > to years. But it doesn't work fot birthday before 1970. Is there any
> > other
> > way to do this? Thank you very much.
> >
> > --bk
>
> Hi,
>
> Thanks everyone :) At last I use the module Date::Calc for this purpose.
>
> --
> How do I verify wether someone has a certain age?
>
> use Date::Calc qw( Decode_Date_EU Today leap_year Delta_Days );
>
>
> $date = <STDIN>; # get birthday
>
>
> ($year1,$month1,$day1) = Decode_Date_EU($date);
>
>
> ($year2,$month2,$day2) = Today();
>
>
> if (($day1 == 29) && ($month1 == 2) && !leap_year($year2))
> { $day1--; }
>
>
> if ( (($year2 - $year1) > 18) ||
> ( (($year2 - $year1) == 18) &&
> (Delta_Days($year2,$month1,$day1, $year2,$month2,$day2) >= 0) ) )
> {
> print "Ok - you are over 18.\n";
> }
> else
> {
> print "Sorry - you aren't 18 yet!\n";
> }
>
i must be missing something here, 'cause, in spite of all the other
answers posted here, it seems like this oughta work just fine, and
doesn't use any modules:
$bdate = "04-30-1953";
($bmonth, $bday, $byear) = split(/-/,$bdate);
($cmonth, $cday, $cyear) = (localtime())[4, 3, 5];
$cmonth++;
$cyear += 1900;
$age = $cyear - $byear;
$age-- if (($cmonth < $bmonth) || ($cmonth == $bmonth && $cday < $bday));
if ($age < 18) {
print "Sorry - you aren't 18 yet!\n";
} else {
print "Ok - you are over 18.\n";
}
hth-
--
Michael Budash ~~~~~~~~~~ mbudash@sonic.net
------------------------------
Date: Wed, 27 Jun 2001 12:58:55 -0700
From: "Godzilla!" <godzilla@stomp.stomp.tokyo>
Subject: Re: Convert DD-MM-YYYY to age
Message-Id: <3B3A3AFF.4EA79139@stomp.stomp.tokyo>
Batara Kesuma wrote:
(snippage)
> Batara Kesuma wrote:
> > I am trying to convert DD-MM-YYYY to the age of the person now.
> Thanks everyone :) At last I use the module Date::Calc for this purpose.
> How do I verify wether someone has a certain age?
(snipped exceptionally slow overkill module method)
> print "Ok - you are over 18.\n";
> print "Sorry - you aren't 18 yet!\n";
There is no need for massive overkill by using a module.
You would benefit to read about and research laws regarding
a legal age of eighteen or twenty-one. A person, under
law, is considered to gain one year in age at the stroke
of midnight, on the day before his or her birthday, which
includes leap year February.
If you are confused by legal wording, think of this law
in this manner:
"A person gains one year in legal age the very moment a
calendar date changes to her or his birthdate."
I doubt you will ever experience being carded per your
actual hour, minute and second of birth.
Godzilla!
--
TEST SCRIPT:
____________
"I am trying to convert DD-MM-YYYY to the age of the person now...."
#!perl
$birthday = "27-06-1983";
print "\n\nBirthday: $birthday\n";
&Determine_Legal_Age;
$birthday = "27-06-1990";
print "\n\nBirthday: $birthday\n";
&Determine_Legal_Age;
$birthday = "29-02-1983";
print "\n\nBirthday: $birthday\n";
&Determine_Legal_Age;
$birthday = "01-04-1804";
print "\n\nBirthday: $birthday\n";
&Determine_Legal_Age;
$birthday = "12-31-2025";
print "\n\nBirthday: $birthday\n";
&Determine_Legal_Age;
sub Determine_Legal_Age
{ # sub
$current_year = substr (localtime(), -4, 4);
$birth_year = substr ($birthday, -4, 4);
if ($current_year - $birth_year > 18)
{ print "Person Is 18 Years Of Age Or Older."; }
elsif ($current_year - $birth_year == 18)
{
my ($birth_day, $birth_month, $birth_year) = split (/-/, $birthday);
my (undef, undef, undef, $monthday, $month, undef, undef, undef) = localtime();
$month++;
if ($birth_month < $month)
{ print "Person Is 18 Years Of Age Or Older."; }
elsif ($birth_month > $month)
{ print "Person Is Under 18 Years Of Age."; }
else
{
if (($birth_month == 2) & ($birth_day == 29))
{ $birth_day = 28; }
if ($birth_day <= $monthday)
{ print "Person Is 18 Years Of Age Or Older."; }
}
}
else
{ print "Person Is Under 18 Years Of Age."; }
} # sub
exit;
PRINTED RESULTS:
________________
Birthday: 27-06-1983
Person Is 18 Years Of Age Or Older.
Birthday: 27-06-1990
Person Is Under 18 Years Of Age.
Birthday: 29-02-1983
Person Is 18 Years Of Age Or Older.
Birthday: 01-04-1804
Person Is 18 Years Of Age Or Older.
Birthday: 12-31-2025
Person Is Under 18 Years Of Age.
------------------------------
Date: 27 Jun 2001 11:13:40 -0700
From: gururaj@powertec.com (Gururaj Upadhye)
Subject: Re: error making Archive::Zip
Message-Id: <23c54ab6.0106271013.1448781b@posting.google.com>
I tried installing PPM and it needs expat and though I am able to
compile that, I am not able to install PPM. Is there any other way I
can install the package?
Thanks and Regards,
-Gururaj.
helgi@NOSPAMdecode.is (Helgi Briem) wrote in message news:<3b30cad1.1841442404@news.isholf.is>...
> On 19 Jun 2001 08:59:25 -0700, gururaj@powertec.com (Gururaj
> Upadhye) wrote:
>
> >I am getting following error while making Archive::Zip. I am working
> >on Windows NT 4.0, perl 5.6.0. THis is from output of perl -v
> >This is perl, v5.6.0 built for MSWin32-x86-multi-thread
> >
> >Following is copied from command window:
> >D:\shared\Download\Archive-Zip-0.11>perl makefile.pl
> >Writing Makefile for Archive::Zip
> >
> >D:\shared\Download\Archive-Zip-0.11>nmake
> >
> >Microsoft (R) Program Maintenance Utility Version 6.00.8168.0
> >Copyright (C) Microsoft Corp 1988-1998. All rights reserved.
> >
> > D:\Perl\bin\perl.exe -Id:\Perl\lib -Id:\Perl\lib
> >-MExtUtils::Command -e cp crc32 b
> >lib\script\crc32
> > D:\Perl\bin\perl.exe -Id:\Perl\lib -Id:\Perl\lib -e "system
> >qq[pl2bat.bat ].shift
> >" blib\script\crc32
> >The name specified is not recognized as an
> >internal or external command, operable program or batch file.
>
> Why are you doing it this way? Use PPM.
>
> Regards,
> Helgi Briem
------------------------------
Date: Wed, 27 Jun 2001 20:09:18 GMT
From: Bart Lateur <bart.lateur@skynet.be>
Subject: Re: error making Archive::Zip
Message-Id: <i7fkjtccr6j6ip2b8k803mboofesvcaopf@4ax.com>
Gururaj Upadhye wrote:
>I tried installing PPM and it needs expat and though I am able to
>compile that, I am not able to install PPM. Is there any other way I
>can install the package?
>> >I am getting following error while making Archive::Zip. I am working
>> >on Windows NT 4.0, perl 5.6.0. THis is from output of perl -v
>> >This is perl, v5.6.0 built for MSWin32-x86-multi-thread
I don't get it. What brand of Perl are you using? If you're using
Activestate's ActivePerl, then PPM should already be on your system. If
using IndigoPerl, this one offers an equivalent alternative, called DPM,
and with a web interface called VPM.
You should never have to install it yourself.
--
Bart.
------------------------------
Date: Wed, 27 Jun 2001 18:12:04 -0000
From: gbacon@HiWAAY.net (Greg Bacon)
Subject: Re: expression match help
Message-Id: <tjk8fkjkpjf771@corp.supernews.com>
In article <3B3A1879.E0940EF7@agilent.com>,
Greg Miller <greg_j_miller@agilent.com> wrote:
: I want to match the expression below for "=" but *not* "==", "!=", or
: ">="
:
: pcamsndt =((nlev==4)*cam4s+(nlev!=5)*cam5s+(nlev>=6)*cam6s)
:
: I've come up with a few ugly expressions but I would like to have a more
: elegant way of doing it - any experts out there have a good way?
% cat try
#! /usr/local/bin/perl -w
$_ = 'pcamsndt =((nlev==4)*cam4s+(nlev!=5)*cam5s+(nlev>=6)*cam6s)';
print $_, "\n";
my $expr = qr/
(?!==|!=|>=) # no ==, !=, or >= ahead
= # the equals sign we want
(?<!==|!=|>=) # no ==, !=, or >= behind
/x;
while (/$expr/g) {
print "<", substr($_, 0, pos($_)), ">\n";
}
% ./try
pcamsndt =((nlev==4)*cam4s+(nlev!=5)*cam5s+(nlev>=6)*cam6s)
<pcamsndt =>
If you're doing anything sophisticated, you might want to consider
writing a real parser with Parse::RecDescent.
Hope this helps,
Greg
--
I dream of a world where you can buy liquor, cigarettes and firearms at a
drive-through and use them all before you get home. Basically anything that
gets rid of people, but FIRST, BUY MY BOOK!
-- Scott Adams
------------------------------
Date: Wed, 27 Jun 2001 18:16:00 GMT
From: tiltonj@erols.com (Jay Tilton)
Subject: Re: expression match help
Message-Id: <3b3a1dcf.50340450@news.erols.com>
On Wed, 27 Jun 2001 10:31:37 -0700, Greg Miller <greg_j_miller@agilent.com>
wrote:
>I want to match the expression below for "=" but *not* "==", "!=", or
>">="
>
>pcamsndt =((nlev==4)*cam4s+(nlev!=5)*cam5s+(nlev>=6)*cam6s)
>
>I've come up with a few ugly expressions but I would like to have a more
>elegant way of doing it - any experts out there have a good way?
With those criteria, there's not much to be done about the ugly. You can
use the /x modifier to burst the pattern into more digestible pieces.
This will match '=' where the preceding character is not '=' '!' or '>', and
the following character is not another '='.
$string = 'pcamsndt =((nlev==4)*cam4s+(nlev!=5)*cam5s+(nlev>=6)*cam6s)';
print "Found '=' at position $+[0]\n"
while $string =~ /
(?<![=!>]) #Negative lookbehind
=
(?!=) #Negative lookahead
/gx;
------------------------------
Date: Wed, 27 Jun 2001 11:33:45 -0700
From: "Godzilla!" <godzilla@stomp.stomp.tokyo>
Subject: Re: expression match help
Message-Id: <3B3A2709.3C03DF4F@stomp.stomp.tokyo>
Greg Miller wrote:
(snipped and [paraphrased] to make better sense)
> I want to match the expression below for "=" [sans quotes]
> but not "==" [nor] "!=" [nor] ">=" [all sans quotes]
> pcamsndt =((nlev==4)*cam4s+(nlev!=5)*cam5s+(nlev>=6)*cam6s)
Other than your initial equals assignment operator
immediately after pcamsndt, you have no unique equal
sign in your string.
Please reword your article in a coherent manner. What
you ask to match is not possible per your example; there
is no unique equal sign all to itself.
1 #!perl
2
3 pcamsndt =((nlev==4)*cam4s+(nlev!=5)*cam5s+(nlev>=6)*cam6s);
4
5 exit;
Operator or semicolon missing before *cam4s at test2.pl line 3.
Ambiguous use of * resolved as operator * at test2.pl line 3.
Operator or semicolon missing before *cam5s at test2.pl line 3.
Ambiguous use of * resolved as operator * at test2.pl line 3.
Operator or semicolon missing before *cam6s at test2.pl line 3.
Ambiguous use of * resolved as operator * at test2.pl line 3.
Can't modify constant item in scalar assignment at test2.pl line 3, near ");"
Execution of test2.pl aborted due to compilation errors.
My presumption is any responses to your article are
responses made by yourself under fake names. Your
article is indecipherable by a reasonable person
and, could only be deciphered by you, personally.
Godzilla!
------------------------------
Date: Wed, 27 Jun 2001 21:15:47 +0200
From: "carlos" <carlos@plant.student.utwente.nl>
Subject: Re: expression match help
Message-Id: <9hdbd5$rkr$1@dinkel.civ.utwente.nl>
do you even know what stupid means>?
"Godzilla!" <godzilla@stomp.stomp.tokyo> wrote in message
news:3B3A2709.3C03DF4F@stomp.stomp.tokyo...
> Greg Miller wrote:
>
> (snipped and [paraphrased] to make better sense)
>
> > I want to match the expression below for "=" [sans quotes]
>
> > but not "==" [nor] "!=" [nor] ">=" [all sans quotes]
>
> > pcamsndt =((nlev==4)*cam4s+(nlev!=5)*cam5s+(nlev>=6)*cam6s)
>
> Other than your initial equals assignment operator
> immediately after pcamsndt, you have no unique equal
> sign in your string.
>
> Please reword your article in a coherent manner. What
> you ask to match is not possible per your example; there
> is no unique equal sign all to itself.
>
>
> 1 #!perl
> 2
> 3 pcamsndt =((nlev==4)*cam4s+(nlev!=5)*cam5s+(nlev>=6)*cam6s);
> 4
> 5 exit;
>
> Operator or semicolon missing before *cam4s at test2.pl line 3.
> Ambiguous use of * resolved as operator * at test2.pl line 3.
> Operator or semicolon missing before *cam5s at test2.pl line 3.
> Ambiguous use of * resolved as operator * at test2.pl line 3.
> Operator or semicolon missing before *cam6s at test2.pl line 3.
> Ambiguous use of * resolved as operator * at test2.pl line 3.
> Can't modify constant item in scalar assignment at test2.pl line 3, near
");"
> Execution of test2.pl aborted due to compilation errors.
>
>
>
> My presumption is any responses to your article are
> responses made by yourself under fake names. Your
> article is indecipherable by a reasonable person
> and, could only be deciphered by you, personally.
>
> Godzilla!
------------------------------
Date: Wed, 27 Jun 2001 15:55:40 -0400
From: "Anthony" <hoa@nortelnetworks.com>
Subject: Re: expression match help
Message-Id: <9hddns$uj$1@bcarh8ab.ca.nortel.com>
$n = "pcamsndt=((nlev==4)*cam4s+(nlev!=5)*cam5s+(nlev>=6)*cam6s)";
$n =~ s/([^=!><])=([^=])/$1$2/g;
"Greg Miller" <greg_j_miller@agilent.com> wrote in message
news:3B3A1879.E0940EF7@agilent.com...
> I want to match the expression below for "=" but *not* "==", "!=", or
> ">="
>
> pcamsndt =((nlev==4)*cam4s+(nlev!=5)*cam5s+(nlev>=6)*cam6s)
>
> I've come up with a few ugly expressions but I would like to have a more
> elegant way of doing it - any experts out there have a good way?
>
> Thanks!
>
> -Greg
>
>
------------------------------
Date: Wed, 27 Jun 2001 13:12:08 -0700
From: Michael Budash <mbudash@sonic.net>
Subject: Re: expression match help
Message-Id: <mbudash-5C197F.13120827062001@news.pacbell.net>
In article <3B3A1879.E0940EF7@agilent.com>, Greg Miller
<greg_j_miller@agilent.com> wrote:
> I want to match the expression below for "=" but *not* "==", "!=", or
> ">="
>
> pcamsndt =((nlev==4)*cam4s+(nlev!=5)*cam5s+(nlev>=6)*cam6s)
>
> I've come up with a few ugly expressions but I would like to have a more
> elegant way of doing it - any experts out there have a good way?
>
> Thanks!
>
> -Greg
>
>
you don't say whether you care what you'd like to do with the fact that
such a match occurs. if all you care about is *if* it occurs, this works:
$_ = "pcamsndt =((nlev==4)*cam4s+(nlev!=5)*cam5s+(nlev>=6)*cam6s)";
if (/(^|[^=!>])=([^=]/|$)) {
print "match!\n";
} else {
print "no match!\n";
}
hth-
--
Michael Budash ~~~~~~~~~~ mbudash@sonic.net
------------------------------
Date: Wed, 27 Jun 2001 16:03:54 -0400
From: "Anthony" <hoa@nortelnetworks.com>
Subject: Re: expression match help
Message-Id: <9hde7b$1s3$1@bcarh8ab.ca.nortel.com>
$_ = "pcamsndt=((nlev==4)*cam4s+(nlev!=5)*cam5s+(nlev>=6)*cam6s)";
if ( m/([^=!><])=([^=])/ ) {
$exp = $2 . $';
}
print $exp . "\n";
"Anthony" <hoa@nortelnetworks.com> wrote in message
news:9hddns$uj$1@bcarh8ab.ca.nortel.com...
> $n = "pcamsndt=((nlev==4)*cam4s+(nlev!=5)*cam5s+(nlev>=6)*cam6s)";
> $n =~ s/([^=!><])=([^=])/$1$2/g;
>
> "Greg Miller" <greg_j_miller@agilent.com> wrote in message
> news:3B3A1879.E0940EF7@agilent.com...
> > I want to match the expression below for "=" but *not* "==", "!=", or
> > ">="
> >
> > pcamsndt =((nlev==4)*cam4s+(nlev!=5)*cam5s+(nlev>=6)*cam6s)
> >
> > I've come up with a few ugly expressions but I would like to have a more
> > elegant way of doing it - any experts out there have a good way?
> >
> > Thanks!
> >
> > -Greg
> >
> >
>
>
------------------------------
Date: 27 Jun 2001 21:10:09 GMT
From: Joonas Timo Taavetti Kekoni <jkekoni@cc.hut.fi>
Subject: Re: from linux to WinNT4 Ms Sql
Message-Id: <9hdi3h$ju6$1@nntp.hut.fi>
novastar <subscriber@novastar.dtdns.net> wrote:
: Can you tell me please what module do I have to use to connect and query a
: Microsoft SQL installed on a Windows NT4 box from a linux one ?
Microsoft SQL server is normally queried from perl via ODBC.
There is however no odbc drivers for MS SQL server outside
win32. Therefore you need either ODBC-ODBC bridge
like:
http://www.easysoft.com/products/da_components/oob/main.phtml
Or driver that talks directly SQL server protocol. Bea has
one for java, but i don't know one for perl.
--
_- Joonas Kekoni OH2MTF I -_
_-internet: jkekoni@cc.hut.fi I DO NOT EAT. -_
_-slowmail: j{mer{ntaival 7a176 I -_
_- 02150Espoo I It is a monitor -_
_- Finland/Europe I -_
------------------------------
Date: Wed, 27 Jun 2001 15:24:44 -0400
From: "Ho, Anthony [TOR:9T46:EXCH]" <hoa@americasm01.nt.com>
Subject: Highlight characters in DOS.
Message-Id: <9hdbts$qvt$1@bcarh8ab.ca.nortel.com>
Hi all,
My perl script run on WinNT which prints out messages to DOS prompt when
errors were occurred. I want to highlight some keywords in the messages. If
anyone knows what are the special characters to turn on/off highlight or
change color in DOS prompt?
Thanks.
Anthony
------------------------------
Date: Wed, 27 Jun 2001 15:48:31 -0400
From: "Anthony" <hoa@nortelnetworks.com>
Subject: Highlight message in DOS
Message-Id: <9hddag$5t$1@bcarh8ab.ca.nortel.com>
Hi all,
My perl script run on WinNT which prints out messages to DOS prompt when
errors were occurred. I want to highlight some keywords in the messages. If
anyone knows what are the special characters to turn on/off highlight or
change color in DOS prompt?
Thanks.
Anthony
------------------------------
Date: Wed, 27 Jun 2001 19:07:33 +0000 (UTC)
From: Ilya Zakharevich <nospam-abuse@ilyaz.org>
Subject: Re: Interacting prompts with perl
Message-Id: <9hdatl$79q$1@agate.berkeley.edu>
[A complimentary Cc of this posting was sent to
Anno Siegel
<anno4000@lublin.zrz.tu-berlin.de>], who wrote in article <9hd6io$kd8$1@mamenchi.zrz.TU-Berlin.DE>:
> There is no special requirement (at least under Unix) for a command
> to be able to handle pipes, they all do.
Try speaking via pipes with perl -de0. ;-) "Able to handle pipes" is
an *absense* of a feature, not a feature.
Ilya
------------------------------
Date: Wed, 27 Jun 2001 15:30:56 -0400
From: Jason Goodrow <"goodrow"@opencity. com>
Subject: Re: newbie directory question
Message-Id: <9hdc2k$q9s$1@news.panix.com>
Hello and thanks to all for addressing my ignorance.
------------------------------
Date: 27 Jun 2001 20:50:04 GMT
From: abigail@foad.org (Abigail)
Subject: Re: Perl *is* strongly typed (was Re: Perl description)
Message-Id: <slrn9jkhvc.4a6.abigail@alexandra.xs4all.nl>
Joe Schaefer (joe+usenet@sunstarsys.com) wrote on MMDCCCLV September
MCMXCIII in <URL:news:m3hex4s3f3.fsf@mumonkan.sunstarsys.com>:
@@ David Coppit <newspost@coppit.org> writes:
@@
@@ > The code I posted illustrates this. Two ostensibly equivalent scalars
@@ > behaved differently under the same "closure of operations" on scalars.
@@ > e.g. " 3 . '' " is a different scalar subtype than " 3 ".
@@
@@ I doubt you can find any Perl that treats ("3") different than (3).
$ perl -wle 'print "32" & "10"'
10
$ perl -wle 'print 32 & 10'
0
This one will eventually loop:
perl -wle '$var = 3; while (1) {print ++ $var}'
This one never loops:
perl -wle '$var = "3"; while (1) {print ++ $var}'
Abigail
--
$_ = "\x3C\x3C\x45\x4F\x54";
print if s/<<EOT/<<EOT/e;
Just another Perl Hacker
EOT
------------------------------
Date: Wed, 27 Jun 2001 19:16:24 GMT
From: ced@bcstec.ca.boeing.com (Charles DeRykus)
Subject: Re: range operator in scalar context - how to make it true?
Message-Id: <GFLs7C.5po@news.boeing.com>
In article <9h9ide$f31@netnews.hinet.net>,
John Lin <johnlin@chttl.com.tw> wrote:
>..
>Thanks. To summarize:
>
>perl -le "$.=10; print 'OK' if 10..20"
>
>perl -le "tell STDIN; $.=10; print 'OK' if 10..20"
>OK
>perl -le "tell F; $.=10; print 'OK' if 10..20"
>OK # any filehandle would do
>
>It looks like the problem is not $. because its value is well-defined
>and visible to the range-operator all through the process.
>
>perl -le "$.=10; print 'OK' if 10..20; print $."
>10
>
>The problem is the range-operator doesn't look at the value at all,
>unless the runtime is in a special status (reading file) which we
>triggered by tell (or <>, seek ... etc).
>
>I am surprised that this is a 'runtime' behavior which we can't
>detect it at compile time.
>
$. though appears to remain undefined until the triggering
occurs.
perl -le 'print defined $. ? "yes" : "no"' # no
perl -le 'tell STDIN; print defined $. ? "yes" : "no"' # yes
So, you could do your own run time check:
perl -le "defined $. or warn "\$. runtime undef"; ... "
--
Charles DeRykus
------------------------------
Date: 27 Jun 2001 13:39:09 -0700
From: aougav@hotmail.com (Zur Aougav)
Subject: Re: Search Patterns
Message-Id: <bccc87cc.0106271239.25ef854a@posting.google.com>
"Blnukem" <blnukem@hotmail.com> wrote in message news:<TIk_6.15437$I22.1540721@news02.optonline.net>...
> Hi All
>
> I'm trying to replace a string of "filename **.dat" to "filename.txt" I can
> get it to replace "filename **.dat" to ""filename *.txt" with this:
>
> $CATAGORY_DATA {$key} =~ s/ \*\.dat/.txt/g;
>
> but I cant figure out how to replace two of the * in the string
>
> $CATAGORY_DATA {$key} =~ s/ \*\*\.dat/.txt/g;
>
> This don't work please help
>
> Thanxs in Advance
If you code
$CATAGORY_DATA {$key} =~ s/\s*\**\.dat/.txt/g;
it will replace
"spaces" 0 or more times
* 0 or more times
\. 1 dot
dat
by
.txt
Zur
------------------------------
Date: Wed, 27 Jun 2001 20:31:00 GMT
From: "ffg" <john@trumpetweb.co.uk>
Subject: Selling Scripts
Message-Id: <8or_6.4277$4i5.341643@news1.cableinet.net>
Anyone got any advice on sites you can register with to sell perl scripts,
with maybe the site taking credit card details etc in exchange for a
percentage. I'm UK based
I don't want the hassle of setting up a shopping cart with a merchant
account of my own.
Also, any tips on the best way to distribute / password protect the scripts?
Thanks in Advance John
------------------------------
Date: Wed, 27 Jun 2001 23:50:36 +0200
From: <tsee@gmx.net>
Subject: Re: Selling Scripts
Message-Id: <9hdka5$if2$07$1@news.t-online.com>
"ffg" <john@trumpetweb.co.uk> schrieb im Newsbeitrag
news:8or_6.4277$4i5.341643@news1.cableinet.net...
[snip]
> Also, any tips on the best way to distribute / password protect the
scripts?
Just in case you mean password protecting the scripts' code:
You can't. There is no way to reliably protect a script from being read by
anybody. In order to make it run, you need perms to be 555 or more.
Anyway, this is in the faq.
Regards,
Steffen Müller
------------------------------
Date: 27 Jun 2001 21:05:15 GMT
From: abigail@foad.org (Abigail)
Subject: Re: Six degrees of separation
Message-Id: <slrn9jkirr.4a6.abigail@alexandra.xs4all.nl>
Greg Bacon (gbacon@HiWAAY.net) wrote on MMDCCCLIV September MCMXCIII in
<URL:news:tjagkjouefr34b@corp.supernews.com>:
[] In article <9h2rvm$k9c$1@s1.uklinux.net>,
[] John <boxrec@uklinux.net> wrote:
[]
[] : I'm hoping to write a script to find degrees of separation. Before I go away
[] : and reinvent the wheel does anyone know if there is already a script or
[] : module that does this (CPAN turned up 0). Also if anyone else is interested
[] : in this let me know and I'll email you if/when it's finished.
[]
[] I guess I'd be the obvious choice for the Kevin Bacon of Perl. :-)
Yeah, but who would be Paul Erd\"os?
Abigail (with Erd\"os number == 3)
--
perl -we '$_ = q ;4a75737420616e6f74686572205065726c204861636b65720as;;
for (s;s;s;s;s;s;s;s;s;s;s;s)
{s;(..)s?;qq qprint chr 0x$1 and \161 ssq;excess;}'
------------------------------
Date: Wed, 27 Jun 2001 15:45:43 -0400
From: "Anthony" <hoa@nortelnetworks.com>
Subject: testing
Message-Id: <9hdd57$t25$1@bcarh8ab.ca.nortel.com>
------------------------------
Date: Wed, 27 Jun 2001 17:36:31 -0400
From: "Anthony Ho" <hoa@nortelnetworks.com>
Subject: Re: XML::DOM error when there is a "&" in the data
Message-Id: <9hdjkv$a7g$1@bcarh8ab.ca.nortel.com>
Replace "&" with "&" in the data before parsing.
Anthony
"Silvan Schmid" <sschmid@student.ethz.ch> wrote in message
news:3b39ee3a$1@pfaff.ethz.ch...
> Hi,
>
> I am parsing a XML-string with the XML::DOM module. Now my data includes
> some "&" (example: π).
> The parser breaks. In the error log file it says, that an undefined
enitity
> was found. I need to use this "&"-symbols.
> How can I go on using them and the parser will accept them?
>
> Gruss
> Silvan
>
> ________________________________
> Silvan Schmid
> Dufourstrasse 97
> 8008 Zürich
>
> Tel: 01 381 7095
> CellPhone: 076 316 86 76
>
> http://n.ethz.ch/student/sschmid
> ________________________________
>
>
------------------------------
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.
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 1206
***************************************
