[22098] in Perl-Users-Digest
Perl-Users Digest, Issue: 4320 Volume: 10
daemon@ATHENA.MIT.EDU (Perl-Users Digest)
Sun Dec 29 14:05:48 2002
Date: Sun, 29 Dec 2002 11:05:09 -0800 (PST)
From: Perl-Users Digest <Perl-Users-Request@ruby.OCE.ORST.EDU>
To: Perl-Users@ruby.OCE.ORST.EDU (Perl-Users Digest)
Perl-Users Digest Sun, 29 Dec 2002 Volume: 10 Number: 4320
Today's topics:
"use autouse" question (was Re: Not loading unneeded mo (Tim Shoppa)
Re: Adding umlaut character to string <pilsl_use@goldfisch.at>
AUTOLOAD registered with XS will not called on linux 5. (Roger Rene Kommer)
beginner: trying to dig in syslog <japie@nospam.org>
Re: beginner: trying to dig in syslog (Anno Siegel)
Re: beginner: trying to dig in syslog <japie@nospam.org>
Re: beginner: trying to dig in syslog (Jay Tilton)
Re: beginner: trying to dig in syslog (Anno Siegel)
Re: beginner: trying to dig in syslog <japie@nospam.org>
Re: beginner: trying to dig in syslog (Anno Siegel)
Re: C Backend (Jeff Mott)
Devel::DProf giving bad results? (tî'pô)
Re: Devel::DProf giving bad results? (Anno Siegel)
Re: how to make my perl cgi program run in IE <extendedpartition@NOSPAM.yahoo.com>
Re: IE uploads result in zero length files using CGI.pm <phignuton@_#NOSPAM#_hotmail.com>
Re: Newbie Reg. Exp. questions.. <eric.ehlers@btopenworld.com.nospam>
Re: Newbie Reg. Exp. questions.. <bongie@gmx.net>
Palm::Datebook generated events disappearing! <ethan@tabrel.localdomain>
Re: regexp for hostnames <zmeneti@chello.hu>
Digest Administrivia (Last modified: 6 Apr 01) (Perl-Users-Digest Admin)
----------------------------------------------------------------------
Date: 29 Dec 2002 08:42:41 -0800
From: shoppa@trailing-edge.com (Tim Shoppa)
Subject: "use autouse" question (was Re: Not loading unneeded modules with use strict?)
Message-Id: <bec993c8.0212290842.5f719a15@posting.google.com>
Benjamin Goldberg <goldbb2@earthlink.net> wrote in message news:<3E0E8D1B.A3C647A1@earthlink.net>...
> The third way is the autouse module:
> use autouse GD => qw(subname1 subname2 subname3);
> use autouse PDF::API2 => qw(subname4 subname5 subname6);
>
> With this, you don't have to make *any* changes to the rest of your code
> -- you don't even have to make ->new load up one of the two modules via
> require and perform an import, as autouse will do that automatically.
Thanks, "use autouse" looks very tempting. One question, though:
Both GD and PDF::API2 have a "new" method. When I say
use autouse GD::Image => qw(new);
use autouse PDF::API2 => qw(new);
it seems that the only "new" I can access is the PDF::API2 one, and
when I explicitly try a "GD::Image->new" or a "PDF::API2->new" I get a
Can't locate object method "new" via package "GD::Image" (perhaps you
forgot to load "GD::Image"?) at Unigraph.pm line 7.
I'm assuming that my only problem here is syntax (e.g. "how do I distinguish
between the two autoused "new"'s) but maybe the disconnect is more
fundamental. I looked at the online docs for "use autouse" as well
as in the Perl Cookbook but they're really very vague about how I can
use them to abstract two classes with identical method names into one
"universal" class, like I want.
Tim.
------------------------------
Date: Sun, 29 Dec 2002 15:35:35 +0100
From: peter pilsl <pilsl_use@goldfisch.at>
Subject: Re: Adding umlaut character to string
Message-Id: <3e0f083d$1@e-post.inode.at>
Marc-A. Woog wrote:
> Hello there,
>
> I have trouble understanding something.
>
> I receive an attribute value from an LDAP directory containing umlauts.
> Perl displays these special chars as UTF8 (I assume). I tried
> Unicode::String for conversion with no luck yet.
>
I put a working example for unicode-conversion using Unicode::String on:
http://www2.goldfisch.at/knowledge/130
Maybe this is help to your problem.
best,
peter
--
peter pilsl
pilsl_@goldfisch.at
http://www.goldfisch.at
------------------------------
Date: 29 Dec 2002 04:34:41 -0800
From: kommer@artefaktur.com (Roger Rene Kommer)
Subject: AUTOLOAD registered with XS will not called on linux 5.6.1
Message-Id: <6e58c965.0212290434.3f10c2ac@posting.google.com>
Hi,
In my generic script wrapper for acdk (http://acdk.sourceforge.net)
I wrote an XS unit to connect Perl with ACDK classes.
I register an AUTOLOAD method via
newXS("acdk::AUTOLOAD", XM_acdk_ObjectWrapper_AUTOLOAD, file);
Now: On many platforms and at least the perl 5.0* version the perl
interpreter calls this method if a method of the acdk unit cannot
be found.
Unfortunatelly perl 5.6.1 doesn't call this method.
"Can't locate object method "append" via package "acdk" (perhaps you
forgot to load "acdk"?) at -e line 7 during global destruction."
Other XS methods, including DESTROY will be called.
I tried several possibilities, like use/require AutoLoader,
DynaLoader, XSLoader, but no success.
Anybody an idea?
Regards,
Roger
------------------------------
Date: Sun, 29 Dec 2002 10:18:02 GMT
From: Japie <japie@nospam.org>
Subject: beginner: trying to dig in syslog
Message-Id: <uZzP9.77$9J5.37369@amsnews02.chello.com>
Hello,
I'am trying to adapt an existing perl script that digs in the syslog for
iptables lines and then puts found lines in a database.
my($log_tag)="kernel: DROPPED";
workes fine and trows all the lines with DROPPED in it in the database, but I
also wanted my REJECTED and ABORTED in it, so I did:
my($log_tag)="kernel: DROPPED","kernel: ABORTED","kernel: REJECTED";
But that didn't work, neither did:
my($log_tag)=("kernel: DROPPED", "kernel: ABORTED", "kernel: REJECTED");
This is probably a very stupid question but the last option I found on
the perl doc page but that didn't work.
Can someone help me out please?
--
Japie
------------------------------
Date: 29 Dec 2002 11:19:21 GMT
From: anno4000@lublin.zrz.tu-berlin.de (Anno Siegel)
Subject: Re: beginner: trying to dig in syslog
Message-Id: <aumlnp$hrt$1@mamenchi.zrz.TU-Berlin.DE>
According to Japie <japie@nospam.org>:
> Hello,
>
> I'am trying to adapt an existing perl script that digs in the syslog for
> iptables lines and then puts found lines in a database.
> my($log_tag)="kernel: DROPPED";
> workes fine and trows all the lines with DROPPED in it in the database, but I
> also wanted my REJECTED and ABORTED in it, so I did:
> my($log_tag)="kernel: DROPPED","kernel: ABORTED","kernel: REJECTED";
> But that didn't work, neither did:
> my($log_tag)=("kernel: DROPPED", "kernel: ABORTED", "kernel: REJECTED");
> This is probably a very stupid question but the last option I found on
> the perl doc page but that didn't work.
> Can someone help me out please?
Not without knowing the script you are trying to modify.
You'd have better chances for useful advice if you used one of the
CPAN modules for syslog parsing (a search brings up a few).
Anno
------------------------------
Date: Sun, 29 Dec 2002 13:46:29 GMT
From: Japie <japie@nospam.org>
Subject: Re: beginner: trying to dig in syslog
Message-Id: <V0DP9.63$B46.39346@amsnews02.chello.com>
On Sun, 29 Dec 2002 12:19:21 +0100, Anno Siegel wrote:
> Not without knowing the script you are trying to modify.
OK, here's the full script:
#!/usr/bin/perl
# name: feed_db.pl
use strict;
use DBI;
use POSIX qw(strftime);
my $dsn = 'DBI:mysql:iptables:localhost';
my $db_user_name = 'admin';
my $db_password = 'geheim';
my $log_file = '/var/log/syslog';
my $pid_file = "/var/run/iptablelog.pid";
# Here the subjects the script should log.
my($log_tag)="kernel: DROPPED","kernel: ABORTED","kernel: REJECTED";
my $go_to_background=($ARGV[0] eq '--background');
$SIG{INT} = \&got_int;
my ($id, $password);
my $dbh = DBI->connect($dsn, $db_user_name, $db_password);
my(%m);
my($month_nb);
for $month_nb (0..11) {
$m{strftime("%b", 0, 0, 0, 1, $month_nb, 96)}=sprintf("%02d",$month_nb+1);
}
open(LOG_FILE,"tail --follow=name --retry $log_file 2>/dev/null |") or die "Unable to open log file $log_file : $!\n";
if ($go_to_background) {
my($f) = fork();
if (!defined($f)) { die "Unable to fork : $!\n"; }
if($f) {
open(PID, ">$pid_file") or die "Unable to create pid file $pid_file: $!";
print PID "$f\n";
close PID;
exit(0);
} else {
close STDIN;
open(STDIN, '</dev/null');
close STDOUT;
open(STDOUT, '>/dev/null');
close STDERR;
open(STDERR, '>/dev/null');
}
}
while (<LOG_FILE>) {
if (!/$log_tag/) { next; }
my(@entry_split)=split / +/;
my(%entry);
my($year);
(undef,undef,undef,undef,undef,$year,undef,undef,undef) = localtime(time);
$year += 1900;
$entry{'date'}="$year-".$m{shift(@entry_split)}."-".shift(@entry_split)." ".shift(@entry_split);
$entry{'host'}=shift(@entry_split);
shift(@entry_split);
my($chain_name)=shift(@entry_split);
$chain_name=~s/\]//;
shift(@entry_split);
foreach (@entry_split) {
if (/(.*)=(.*)/) {
(my($field),my($value))=split /=/;
$entry{$field}=$value;
}
}
my($iaddr) = inet_aton($entry{'SRC'});
my($host_name) = gethostbyaddr($iaddr, AF_INET);
if (defined($host_name)) { $entry{"SRC_NAME"}=$host_name; } else { $entry{"SRC_NAME"}="unknown"; }
my($iaddr) = inet_aton($entry{'DST'});
my($host_name) = gethostbyaddr($iaddr, AF_INET);
if (defined($host_name)) { $entry{"DST_NAME"}=$host_name; } else { $entry{"DST_NAME"}="unknown"; }
close(HOST);
my($dummy)="'".$entry{"host"}."','".$entry{"date"}."','".$chain_name."','".$entry{'IN'}."','".$entry{'SRC'}."','".$entry{'SRC_NAME'}."','".$entry{'DST'}."','".$entry{'DST_NAME'}."','".$entry{'PROTO'}."','".$entry{'SPT'}."','".$entry{'DPT'}."'";
print "$dummy\n";
$dbh->do("insert into logs
(host,date,chain,interface_in, ip_src, name_src, ip_dest, name_dest, proto, port_src, port_dest) values ($dummy)");
}
$dbh->disconnect();
sub got_int {
$SIG{INT} = \&got_int;
close(LOG_FILE);
}
> You'd have better chances for useful advice if you used one of the CPAN
> modules for syslog parsing (a search brings up a few).
I've been thinking about that, now the script is started with:
tail --follow=name --retry /var/log/syslog | /usr/bin/feed_db.pl &
Adding a entry in syslog.conf and feeding that into the script should be
bether, but you understand that if I already have problems with the above
that would be a bit over my head :-)
--
Japie
------------------------------
Date: Sun, 29 Dec 2002 14:51:13 GMT
From: tiltonj@erols.com (Jay Tilton)
Subject: Re: beginner: trying to dig in syslog
Message-Id: <3e0f085a.133389373@news.erols.com>
Japie <japie@nospam.org> wrote:
: On Sun, 29 Dec 2002 12:19:21 +0100, Anno Siegel wrote:
:
: > Not without knowing the script you are trying to modify.
:
: OK, here's the full script:
[Massive bulk of code trimmed to just the pertinent pieces.]
: my($log_tag)="kernel: DROPPED","kernel: ABORTED","kernel: REJECTED";
: while (<LOG_FILE>) {
: if (!/$log_tag/) { next; }
# do stuff
: }
So $log_tag is being used as a regex. Write it like one.
While we're here, write that test a little more perlishly.
my $log_tag = qr/kernel: (?:DROPPED|ABORTED|REJECTED)/;
while (<LOG_FILE>) {
next unless /$log_tag/;
# do stuff
}
------------------------------
Date: 29 Dec 2002 15:26:54 GMT
From: anno4000@lublin.zrz.tu-berlin.de (Anno Siegel)
Subject: Re: beginner: trying to dig in syslog
Message-Id: <aun47u$r4i$1@mamenchi.zrz.TU-Berlin.DE>
According to Japie <japie@nospam.org>:
> On Sun, 29 Dec 2002 12:19:21 +0100, Anno Siegel wrote:
>
> > Not without knowing the script you are trying to modify.
>
> OK, here's the full script:
Ugh. I was afraid that would happen.
[most of two pages of Perl code snipped]
Normally, posting more than ten or twenty lines of code to clpm is useless,
nobody is going to read that much anyway. I am making an exception here
because
- the script (unlike most scripts that are presented this way) is
reasonably well written
- the case is exceptionally simple
> #!/usr/bin/perl
> # name: feed_db.pl
>
> use strict;
You should have added "use warnings" as soon as the script gave you
trouble. It would have pointed out the mistake you made below.
> use DBI;
> use POSIX qw(strftime);
>
> my $dsn = 'DBI:mysql:iptables:localhost';
> my $db_user_name = 'admin';
> my $db_password = 'geheim';
I hope this is not the real password. If it is, change it now.
> my $log_file = '/var/log/syslog';
> my $pid_file = "/var/run/iptablelog.pid";
> # Here the subjects the script should log.
The pertinent line:
> my($log_tag)="kernel: DROPPED","kernel: ABORTED","kernel: REJECTED";
This will set $log_tag to "kernel: DROPPED" and ignore the other two
strings. Perl warnings would have detected that.
[...]
> while (<LOG_FILE>) {
> if (!/$log_tag/) { next; }
Here is the only place $log_tag is used in the program, and it is used
as a regular expression. So make $log_tag a (string that compiles as
a) regular expression that matches the three kinds of lines you want to
catch. Something like "kernel: (?:DROPPED|ABORTED|REJECTED)" ought to
do, but I'm not testing.
> > You'd have better chances for useful advice if you used one of the CPAN
> > modules for syslog parsing (a search brings up a few).
>
> I've been thinking about that, now the script is started with:
> tail --follow=name --retry /var/log/syslog | /usr/bin/feed_db.pl &
> Adding a entry in syslog.conf and feeding that into the script should be
> bether, but you understand that if I already have problems with the above
> that would be a bit over my head :-)
What does this have to do with using a CPAN module?
Anno
------------------------------
Date: Sun, 29 Dec 2002 18:29:29 GMT
From: Japie <japie@nospam.org>
Subject: Re: beginner: trying to dig in syslog
Message-Id: <daHP9.225$Ey6.86269@amsnews02.chello.com>
On Sun, 29 Dec 2002 16:26:54 +0100, Anno Siegel wrote:
>> OK, here's the full script:
>
> Ugh. I was afraid that would happen.
:-)
> - the script (unlike most scripts that are presented this way) is
> reasonably well written
I didn't do it, that explains it...
>> my $db_password = 'geheim';
>
> I hope this is not the real password. If it is, change it now.
It's dutch for "top secret", I use it as my root passwd. on my server,
wanne have my IP? (yust kidd'n)
> What does this have to do with using a CPAN module?
Sorry, I misunderstood you.
Thanks for helping out, and explaining things.
Thanks Jay for making it easy, if anyone knows a good place to start
reading a bit more about perl coding please tell me, I found
http://www.perldoc.com/perl5.8.0/pod/perlintro.html wich seemed a good
start for me, so if you have more of that...
--
Japie
------------------------------
Date: 29 Dec 2002 19:04:16 GMT
From: anno4000@lublin.zrz.tu-berlin.de (Anno Siegel)
Subject: Re: beginner: trying to dig in syslog
Message-Id: <aungvg$5ep$1@mamenchi.zrz.TU-Berlin.DE>
According to Japie <japie@nospam.org>:
> On Sun, 29 Dec 2002 16:26:54 +0100, Anno Siegel wrote:
>
> >> OK, here's the full script:
> >
> > Ugh. I was afraid that would happen.
>
> :-)
>
> > - the script (unlike most scripts that are presented this way) is
> > reasonably well written
>
> I didn't do it, that explains it...
No, no. Yours is quite the typical situation: Having a Perl script
you didn't write but want to change. Perfectly normal, except for
the quality of the script you have there, which is way above average.
> >> my $db_password = 'geheim';
> >
> > I hope this is not the real password. If it is, change it now.
>
> It's dutch for "top secret",
Just like in German, though pronounced rather differently.
> I use it as my root passwd. on my server,
> wanne have my IP? (yust kidd'n)
Noted. However, it is good practice to mark changes you have made to
the original code, even trivial ones. There were (at least) two more
places that should have been marked this way.
> > What does this have to do with using a CPAN module?
>
> Sorry, I misunderstood you.
>
> Thanks for helping out, and explaining things.
> Thanks Jay for making it easy, if anyone knows a good place to start
> reading a bit more about perl coding please tell me, I found
> http://www.perldoc.com/perl5.8.0/pod/perlintro.html wich seemed a good
> start for me, so if you have more of that...
Quite a few tutorials are part of the Perl documentation (hence part
of Perl) and locally available through the perldoc command. Start with
"perldoc perl" for an overview and take it from there.
Anno
------------------------------
Date: 29 Dec 2002 10:41:31 -0800
From: jeffmott@twcny.rr.com (Jeff Mott)
Subject: Re: C Backend
Message-Id: <f9c0ce19.0212291041.4ad7c5a@posting.google.com>
Benjamin Goldberg <goldbb2@earthlink.net> wrote in message news:<3E0E8712.17CF0384@earthlink.net>...
> Jeff Mott wrote:
> [snip]
> > 912: no such instruction ""
> > There were 912 assembly errors
> > CHECK failed--call queue aborted.
> >
> > I realize it's experimental, but does it work at all? Is there
> > something vital I'm missing?
>
> The vital thing that you're missing is that it was "experimental" in
> perl 5.005_03, and hasn't been updated since then.
> > I realize it's experimental, but...
I'm not sure how you can interpret this to think I didn't already know that.
> If there's even one new opcode which your program uses but which didn't
> exist in that version of perl, it's going to cause perlcc to fail.
The script I was testing this with had only one line:
print 'Hello World!';
Nothing even remotely new there.
------------------------------
Date: Sun, 29 Dec 2002 16:09:35 +0200
From: "Teh (tî'pô)" <teh@mindless.com>
Subject: Devel::DProf giving bad results?
Message-Id: <7bst0vk2smm9gknr1ck1p4jf36qp7vdaj2@4ax.com>
Hi, I've just downloaded Devel::DProf from cpan.org and I'm getting
very suspicious results.
Before we get to my results I should mention that I haven't installed
the module on the system, I spoke to our sys-admin and he said I
should be sure I want this module before we install it (root
privileges and all that). The way I got it to work was to insert the
appropriate directories in PERL5LIB and LD_LIBRARY_PATH.
As for my system:
% perl -v
This is perl, version 5.005_02 built for sun4-solaris
% uname -a
SunOS sanjer 5.8 Generic_108528-11 sun4u sparc SUNW,Ultra-5_10
Here's my test code
----------------------------------
#!/bin/env perl -w
use strict;
sub pre_inc {
my $num = shift;
my $ret = 0;
++$ret while $ret < $num;
return $ret;
}
sub pst_inc {
my $num = shift;
my $ret = 0;
$ret++ while $ret < $num;
return $ret;
}
my $targ = 10000;
my $i = 0;
$i += pre_inc($targ);
$i += pst_inc($targ);
print STDERR "Ooops.\n" if $i != ($targ *2);
------------------------------------------
I run
% /usr/local/bin/perl -d:DProf test.pl
% dprofpp
Total Elapsed Time = 0.159815 Seconds
User+System Time = 0.12981 Seconds
Exclusive Times
%Time ExclSec CumulS #Calls sec/call Csec/c Name
38.5 0.050 0.050 2 0.0250 0.0250 main::BEGIN
30.8 0.040 0.040 1 0.0400 0.0400 main::pst_inc
0.00 0.000 -0.000 1 0.0000 - strict::import
0.00 0.000 -0.000 1 0.0000 - strict::bits
% dprofpp -T
main::BEGIN
strict::import
strict::bits
main::pst_inc
main::BEGIN
Where did pre_inc disapear to? Why isn't it showing up?
I expected my results to show that about half the time was spent in
pre_inc and half in pst_inc.
------------------------------
Date: 29 Dec 2002 16:21:37 GMT
From: anno4000@lublin.zrz.tu-berlin.de (Anno Siegel)
Subject: Re: Devel::DProf giving bad results?
Message-Id: <aun7eh$suj$1@mamenchi.zrz.TU-Berlin.DE>
According to Teh (tî'pô) <teh@mindless.com>:
> Hi, I've just downloaded Devel::DProf from cpan.org and I'm getting
> very suspicious results.
>
> Before we get to my results I should mention that I haven't installed
> the module on the system, I spoke to our sys-admin and he said I
> should be sure I want this module before we install it (root
> privileges and all that). The way I got it to work was to insert the
> appropriate directories in PERL5LIB and LD_LIBRARY_PATH.
That is certainly not the reason for the misbehavior. I have seen other
inconsistencies (negative elapsed time) with a standard install, and
I could reproduce your results here. After some fiddling, (swapping
around code lines, renaming subs) both subs do turn up in the output,
but it claims pre_inc takes exactly twice the time of pst_inc, which
I don't believe. Plus, I'm unable to reproduce the original state of
affairs where pst_inc isn't mentioned at all. In between, I also had
the expected result with pre_inc and pst_inc taking (exactly) equal time.
"Inconsistent" doesn't begin to describe it...
> As for my system:
> % perl -v
> This is perl, version 5.005_02 built for sun4-solaris
This is ancient, relatively speaking. I'm running 5.8.0 and seeing the
same effect. Looks like Devel::DProf could use an overhaul.
[test code snipped]
Anno
------------------------------
Date: Sun, 29 Dec 2002 03:24:31 -0600
From: Extended Partition <extendedpartition@NOSPAM.yahoo.com>
Subject: Re: how to make my perl cgi program run in IE
Message-Id: <voft0vg6n65ek4mhkcdkfs1ms1onta2aa4@4ax.com>
On 20 Dec 2002 13:08:58 -0800, philip_ord@yahoo.com (philip) wrote:
>I wrote a simple perl program to print some HTML tags.
>but it can only run in command mode.
>when I tried to run it in IE, it launched the command window.
>what is the program?
Could be that your webserver isn't configured to recognize perl
scripts. See your documentation as to how to make different webservers
recognize them.
Extended
------------------------------
Date: Sun, 29 Dec 2002 11:27:27 -0600
From: Chris Kolosiwsky <phignuton@_#NOSPAM#_hotmail.com>
Subject: Re: IE uploads result in zero length files using CGI.pm
Message-Id: <nkbu0vgg34vfbngsikbp8q446acsnap4at@4ax.com>
On Sun, 29 Dec 2002 00:31:22 -0500, Benjamin Goldberg
<goldbb2@earthlink.net> wrote:
>Chris Kolosiwsky wrote:
>[snip]
>> my $uploadedfile = $q->upload('UploadedFile');
>
>At this point, $uploadedfile is a globref which has been blessed into a
>class with an overloaded '""' operator.
>
>> $uploadedfile =~ s/.*[\/\\](.*)/$1/;
>> # only grab the file after the last / in the pathname
>
>After doing this, $uploadedfile has been forced to be a string and
>*only* a string. It is no longer a filehandle.
Okay, but it hasn't been untainted, correct? If I'm to be accepting
files on a public site using this script, I would need to take steps
to insure that the filename itself is not a carefully crafted file
name like \`cat /etc/passwd|mail someone@somewhere.com\`.
How is it that you can both untaint the filename and still maintain
its status as strictly a filehandle? In order to untaint the file you
would have to do some sort of s/// on the filename, no?
However if $uploadedfile is forced into a string, then is it a happy
coincidence that the "while (<$uploadedfile>)" still works in a
filehandle context when the file is actually copied to the relevant
directory? I would think that this would not be the case, however, I'm
not an expert on this.
At any rate, as I said, this script does work with the other netscape
based browsers (and IE for the Mac), so is it possible that something
with IE for the PC is just not behaving in the correct (or broken)
manner?
Chris
------------------------------
Date: Sun, 29 Dec 2002 10:22:09 +0000 (UTC)
From: "eric" <eric.ehlers@btopenworld.com.nospam>
Subject: Re: Newbie Reg. Exp. questions..
Message-Id: <aumich$c43$1@venus.btinternet.com>
hello.
> > if ($_<100||$_>255) {
> ^^^
> > print "invalid - digit $_ not between 100 and 255
> ^^^
> This 100 looks a bit arbitrary to me for an IP address... ;-)
to me too...
the OP, who i gather is not speaking english as his native tongue, wrote
>>>Can anyone teach me how to validate IP address?
>>>example checking for the correct format: 220.110.113.111
>>>have 4 group of 3 number and each group not over 255 ?
i think by "4 group of 3 number" he means "four three-digit numbers" ??
and "each group not over 255" = "each of the four three-digit numbers is <=
255" ??
so for each digit $_ i say it's invalid if ($_<100||$_>255).
i coded exactly to spec, whether the spec solves the problem is another
question ... :)
regards,
eric
------------------------------
Date: Sun, 29 Dec 2002 17:10:24 +0100
From: "Harald H.-J. Bongartz" <bongie@gmx.net>
Subject: Re: Newbie Reg. Exp. questions..
Message-Id: <1257357.Gs602JN16u@nyoga.dubu.de>
eric wrote:
[...]
> i think by "4 group of 3 number" he means "four three-digit numbers"
> ?? and "each group not over 255" = "each of the four three-digit
> numbers is <= 255" ??
> so for each digit $_ i say it's invalid if ($_<100||$_>255).
>
> i coded exactly to spec, whether the spec solves the problem is
> another question ... :)
You're absolutely right. I overlooked that detail of the spec. :-)
> regards,
> eric
Ciao,
Harald
--
Harald H.-J. Bongartz <bongie@gmx.net>
-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
I love to go down to the schoolyard and watch all the little children
jump up and down and run around yelling and screaming...They don't know
I'm only using blanks. -- Emo Phillips
------------------------------
Date: 29 Dec 2002 09:20:35 -0800
From: Ethan Brown <ethan@tabrel.localdomain>
Subject: Palm::Datebook generated events disappearing!
Message-Id: <m2of74u4gs.fsf@tabrel.localdomain>
I'm in the process of writing an interface between a web-based
calendar currently out on the web (http://www.WheresTheGig.com) and my
Palm Pilot, using the Palm::Datebook module from pilot-link.
Everything worked fine initially. The information added by my
application shows up correctly in JPilot. After a Palm sync it appeared
on my Palm.
However, after I deleted the event in the palm all subsequent event
additions also disappear after a palm sync. So I'm seeing the following:
(1) Run my application.
(2) See event show up in JPilot.
(3) Sync the palm
(4) Event not added to palm and event gone from JPilot.
I made sure to set the record to 'dirty', and I'm explicitly setting
the record ID.
Help is appreciated, as are pointers as to where I can RTFM. I feel
I've reviewed the Palm::PDB docs pretty well, but I may have missed
somthing. Code is appended to the end of this posting.
Thanks for your help,
--
--Ethan Brown
--Keyboards/The Fabulous Pelicans (www.pelicans.com)
--Author: WheresTheGig.com
--ethan@ethanbrown.org
===========================================================================
#!/usr/bin/perl -w
##
## Test program to add gig entry to datebook.
## requires the Palm perl modules
#
# http://search.cpan.org/doc/ARENSB/p5-Palm-1.1.5/Palm/PDB.pm
#
use CGI;
use Palm::PDB;
use Palm::Datebook;
use Text::Wrap;
use strict;
## Max value for rand (probably not appropriate for palm, but will
## work for now.
##
my $maxint = 4294967290;
my $pdb = new Palm::PDB;
my $dbfile="$ENV{HOME}/.jpilot/DatebookDB.pdb";
$pdb->Load($dbfile) || die print "Couldn\'t load database file $dbfile\n";
#$pdb->{sort};
##print "There are " . scalar(@{$pdb->{records}}) . " records\n";
## Create hash of events having WheresTheGig ID strings.
my %existing_records;
foreach my $record (@{$pdb->{records}})
{
# &dump_record($record);
my $note = $record->{note};
if ($note)
{
$note =~ m/(\[WheresTheGig ID String \(don\'t modify\) \w+:\d+\])/s;
my $gig_id_string = $1;
$existing_records{$gig_id_string} = $record if $gig_id_string;
}
}
## Sample gig record:
my %gig_info = ('roomavail' => '2:00',
'soundcheck' => '5:30',
'venue' => 'Sammy\'s Sleazy Bar',
'start' => '9:30',
'end' => '11:30',
'address' => '132 Main St., Los Gatos, CA',
'phone' => '(123) 444-5678',
'gig_contact' => 'Melissa Moran',
'coats' => 'Tuxes;Green Coats;Blue Jeans',
'otherdress' => 'Kakie shorts and Bow Ties',
'comments' => "Do your best\nBecause this is an imporant\ngig.",
'confirmed' => 'Confirmed',
'band_account' => "foobar",
'band_name' => "The Foobars",
'duration' => 1,
'gig_id' => 12345,
'day' => 15,
'month' => 5,
'year' => 2003);
&add_or_update_wtg_record($pdb, \%existing_records, \%gig_info);
rename ($dbfile, $dbfile . ".bak") or die "Can\'t make backup of $dbfile";
$pdb->Write($dbfile);
print "Done!\n";
##
## If an existing record exists for this gig, modify it. Otherwise,
## create a new record.
##
sub add_or_update_wtg_record{
my ($pdb, $existing_records, $gig_info) = @_;
my $existing_gig = 0;
##
## I know this is redundant with the later code, but it's here
## for testing/debugging:
if (&find_existing_record($existing_records,
$gig_info->{band_account},
$gig_info->{gig_id}))
{
print "Found existing gig\n";
$existing_gig = 1;
}
else
{
print "Didn't find existing gig\n";
}
my $record = &find_existing_record($existing_records,
$gig_info->{band_account},
$gig_info->{gig_id})
|| $pdb->append_Record;
$record->{day} = $gig_info{day};
$record->{month} = $gig_info{month};
$record->{year} = $gig_info{year};
$record->{description} = &make_description($gig_info);
$record->{note} = &make_note_from_gig_info($record->{note}, $gig_info);
##Handle repeats for gig duration
if ($gig_info{duration} > 1)
{
$record->{repeat}{type} = 2;
$record->{repeat}{frequency} = 1;
## Use Date:Manip to compute ending date
my ($end_day, $end_month, $end_year)
= &get_end_date($gig_info{day}, $gig_info{month},
$gig_info{year}, $gig_info{day}, $gig_info{duration});
$record->{repeat}{end_day} = $end_day;
$record->{repeat}{end_month} = $end_month;
$record->{repeat}{end_year} = $end_year;
}
$record->{attributes}{dirty} = 1;
#$pdb->{ctime} = time;
#$pdb->{mtime} = time;
$record->{id} = int(rand $maxint) unless $existing_gig;
# &dump_record ($record);
}
sub dump_record{
my $record = shift;
my %local_hash = %{$record};
foreach (keys %local_hash)
{
print "Key = $_, Value = " . $record->{$_} ."\n";
}
my %atts = %{$record->{attributes}} if $record->{attributes};
if ($record->{attributes})
{
foreach (keys %atts)
{
print "Key = $_, Value = " . $atts{$_} ."\n";
}
}
}
##
## Create the note string for the event. This will contain all of the
## gig information, much like a gig alert. The first line contains the
## gig id string.
##
## The existing note is passed in so that any additional information added
## by the user can be preserved.
sub make_note_from_gig_info{
my ($current_note, $gig_info) = @_;
my $note_string;
($note_string) = ($current_note =~ m/(^.*\.\.\.and this line\)){1}?/s)
if $current_note;
$note_string = &make_note_header($gig_info) unless $note_string;
## Now list the gig specifics
$note_string .= "\n-+-+-+-+-+-+-+-+-+-+-+-+-+\n";
$note_string .= "Load In: " . $gig_info->{roomavail} . "\n" if $gig_info->{roomavail};
$note_string .= "Sound Check: " . $gig_info->{soundcheck} . "\n" if $gig_info->{soundcheck};
$note_string .= "Start: " . $gig_info->{start} . "\n" if $gig_info->{start};
$note_string .= "End: " . $gig_info->{end} . "\n" if $gig_info->{end};
$note_string .= "Address: " . $gig_info->{address} . "\n" if $gig_info->{address};
$note_string .= "Phone: " . $gig_info->{phone} . "\n" if $gig_info->{phone};
$note_string .= "Contact: " . $gig_info->{gig_contact} . "\n" if $gig_info->{gig_contact};
if ($gig_info->{coats})
{
my $coats = $gig_info->{coats};
$coats =~ s/;/\n\t/g;
$note_string .= "\nOutfits:\n\t$coats";
}
if ($gig_info->{otherdress})
{
$note_string .= "\nOther dress info:\n";
$note_string .= wrap(" ", " ", $gig_info->{otherdress});
}
if ($gig_info->{comments})
{
$note_string .= "\n\nOther important information:\n";
$note_string .= wrap(" ", " ", CGI::unescape($gig_info->{comments}));
}
}
sub make_note_header{
my $gig_info = shift;
my $account = $gig_info->{band_account} || die "make_note_header: no band_account!";
my $gig_id = $gig_info->{gig_id} || die "make_note_header: no gig_id!";;
return( &make_id_string($account, $gig_id)
. "\n(Put your comments between here)\n\n"
. "(...and this line)");
}
##
## Create the calendar event description string
## in the form "GIG (confirmed): The Foobars at Scummy's Bar (see note for details)"
##
sub make_description{
my $gig_info = shift;
my $band_name = $gig_info->{band_name};
my $venue = $gig_info->{venue};
my $confirmed = $gig_info->{confirmed};
return "GIG ($confirmed): $band_name "
. ($venue ? "at $venue" : "")
. " (see note for details)";
}
## Find a record associated with a gig. Existing records hash is keyed (conveniently!)
## by the gig id string
sub find_existing_record{
my ($existing_records, $band_account, $gig_id) = @_;
my $id_string = &make_id_string($band_account, $gig_id);
return $existing_records{$id_string};
}
## Make the identification string for this gig. This string is the first line
## of the palm "note" entry and is used to synchronize gigs between WheresTheGig
## and the palm entry.
##
## [WheresTheGig ID String (don't modify) <band_account>:<gigid>]
sub make_id_string{
my ($band_account, $gig_id) = @_;
return "[WheresTheGig ID String (don't modify) $band_account:$gig_id]";
}
------------------------------
Date: Sun, 29 Dec 2002 13:09:13 GMT
From: Zoltan Nemeti <zmeneti@chello.hu>
Subject: Re: regexp for hostnames
Message-Id: <3E0EF487.3010303@chello.hu>
Merry Christmas for you all, and thanks for the help.
I really forgot to mention that I cannot use any program code here.
So I like Tad's idea. Yes, the master of look behind.
Combining my previous experiments with Tad's idea, I think
this is the pattern:
/^\w+(\.\w+)*(?<!green)(?<!red)\.\w+\.\w+$/
or, reflecting to Martin's note (a.1green.foo.com):
/^\w+(\.\w+)*(?<!\.green)(?<!\.red)\.\w+\.\w+$/
Do you like it? I do.
And thank you very much for all of you for your efforts.
Zoltan
Tad McClellan wrote:
> Zoltan Nemeti <zmeneti@chello.hu> wrote:
>
>
>>I'd like to match everything except of red|green
>>at the 3rd pos. from right:
>>
>>So Z.Y.X.red.W.com and
>> b.green.a.com shouldn't match
>>
>>but Z.Y.X.heavy.W.com should match, and so on.
>>
>
>
> /(?<!green)(?<!red)\.[^.]+\.[^.]+$/
------------------------------
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 4320
***************************************
