[22029] in Perl-Users-Digest

home help back first fref pref prev next nref lref last post

Perl-Users Digest, Issue: 4251 Volume: 10

daemon@ATHENA.MIT.EDU (Perl-Users Digest)
Thu Dec 12 00:05:46 2002

Date: Wed, 11 Dec 2002 21:05:10 -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           Wed, 11 Dec 2002     Volume: 10 Number: 4251

Today's topics:
    Re: @INC error in in unix (Tad McClellan)
    Re: A formating problem (Tad McClellan)
    Re: Apology (Tad McClellan)
        CGI page comments <terraxFILTER@rogers.com>
    Re: Downloading images from web pages using perl. <bwalton@rochester.rr.com>
    Re: Downloading images from web pages using perl. <pkent77tea@yahoo.com.tea>
    Re: How to get GIF pixel information? <bwalton@rochester.rr.com>
    Re: How to get GIF pixel information? <mgjv@tradingpost.com.au>
    Re: Is this portable and safe? <pkent77tea@yahoo.com.tea>
    Re: Is this portable and safe? <jeff@vpservices.com>
    Re: multiline regex matching (Tad McClellan)
    Re: multiline regex matching <mgjv@tradingpost.com.au>
    Re: multiline regex matching <zahm@uiuc.edu>
        Newbie Q: Searching a directory for all the files in it <kasp@NO_SPAMepatra.com>
    Re: Newbie Q: Searching a directory for all the files i <jurgenex@hotmail.com>
    Re: Output Lines of 70 Characters <wsegrave@mindspring.com>
    Re: Output Lines of 70 Characters <jurgenex@hotmail.com>
    Re: reg exp problem (Tad McClellan)
        REGEX match on hostnames <junk@x-art.be>
    Re: REGEX match on hostnames (Jay Tilton)
    Re: REGEX match on hostnames <junk@x-art.be>
    Re: REGEX match on hostnames <matthew.garrish@sympatico.ca>
        Digest Administrivia (Last modified: 6 Apr 01) (Perl-Users-Digest Admin)

----------------------------------------------------------------------

Date: Wed, 11 Dec 2002 21:21:23 -0600
From: tadmc@augustmail.com (Tad McClellan)
Subject: Re: @INC error in in unix
Message-Id: <slrnavg05j.37o.tadmc@magna.augustmail.com>

Dick Penny <penny1482@attbi.com> wrote:
> "Abernathey Family" <family2@aracnet.com> wrote in message
> news:3DF69F63.8165D24F@aracnet.com...
>> Brian McCauley wrote:

>> > You have made two careless mistakes in reading the perlrun manpage.

>> Christmas is coming and Santa is going to put you on the naughty list if
>> you don't learn to leave your vitrol out of your "help".
> 
> Aw come on, Brian didn't use much "vitrol" here, twas just a gentle nudge.


The Family was probably just trying to keep his 
"whining ratio" above .500


-- 
    Tad McClellan                          SGML consulting
    tadmc@augustmail.com                   Perl programming
    Fort Worth, Texas


------------------------------

Date: Wed, 11 Dec 2002 21:46:08 -0600
From: tadmc@augustmail.com (Tad McClellan)
Subject: Re: A formating problem
Message-Id: <slrnavg1k0.3b8.tadmc@magna.augustmail.com>

Jan Fure <jan_may2002_fure@attbi.com> wrote:
> tadmc@augustmail.com (Tad McClellan) wrote in message 
>> 
>> Yes it does. What makes you think it doesn't?
> The boxplot reoutine using @points as input failed!


Can't help with that. Don't have a "boxplot routine".

We must rely on your description of what you need.


> But it is not clear to me how you realize the
> 
>   while (<DATA>) { 
> 
> instruction step. Is DATA a filehandle?


Yes, as documented in perldata.pod.


> In my specific code, the data being processed has a tab as delimiter,
> and is allready in array form, and I changed 'split' to 'split /\t/',
> but still could not get the code to work.


Since you have no other whitespace in your data, that change
will have no effect.


>   while (<@data1>) {


You're using an awfully strange looking filehandle in the input operator...

     foreach ( @data1 ) {


-- 
    Tad McClellan                          SGML consulting
    tadmc@augustmail.com                   Perl programming
    Fort Worth, Texas


------------------------------

Date: Wed, 11 Dec 2002 20:59:09 -0600
From: tadmc@augustmail.com (Tad McClellan)
Subject: Re: Apology
Message-Id: <slrnavfurt.2jd.tadmc@magna.augustmail.com>

Rob Richardson <therobs@n2net.net> wrote:
> tadmc@augustmail.com (Tad McClellan) wrote in message news:<slrnavd8dv.49c.tadmc@magna.augustmail.com>...
>> Rob Richardson <therobs@n2net.net> wrote:
>> > 
>> > No thanks to Tad.  
>> 
> 
> Tad, please accept my apology for this thoughtless and offensive
> comment.  


Accepted. Thank you.


> I will keep this
> embarassment in mind as I write future posts.


Well, I've experienced similar embarassments myself, which
is why I added the "count to ten" thing in the Posting Guidelines:

   http://mail.augustmail.com/~tadmc/clpmisc.shtml


-- 
    Tad McClellan                          SGML consulting
    tadmc@augustmail.com                   Perl programming
    Fort Worth, Texas


------------------------------

Date: Wed, 11 Dec 2002 20:08:21 -0500
From: "stephen" <terraxFILTER@rogers.com>
Subject: CGI page comments
Message-Id: <at8ntq$11r3lm$1@ID-96300.news.dfncis.de>

Without SSI, modperl, or frames, is there a good way to add a comments board
to the bottom of a webpage?

Basically I have a website (ridecanada.com) that provides profiles of winter
resorts. At the bottom of the resort profile pages I would like visitors to
be able to add comments about the resort.

The only thing I've been able to think of is to have a script that takes an
html filename as a parameter then writes an output html file by copying the
passed file then appending the comment board. I'm not entirely happy with
this solution.

Any ideas?

Thanks,
Stephen




------------------------------

Date: Thu, 12 Dec 2002 01:28:31 GMT
From: Bob Walton <bwalton@rochester.rr.com>
Subject: Re: Downloading images from web pages using perl.
Message-Id: <3DF7E498.1010103@rochester.rr.com>

Kawaii wrote:

> Hello everyone.
> I am trying to get or request Images from web pages and often I find
> the program
> putting html source code into a .jpg or .gif file. (with the name of
> the image)
> 
> I have tried,
> 
> use LWP::Simple;
> $image = get ("ftp://images.cosplay.com/data/566/1dsc02111.jpg");
> open (FILEHANDLE, ">image.jpg");
> binmode FILEHANDLE; ## With or without this, does nothing to help.
> print FILEHANDLE $image;
> close (FILEHANDLE);
> 
> (this is on a unix machine, solaris)
> 
> 
> I've tried the mirror option within lwp, which returns a 0 byte file.
> I've tried the Request option, which is basicly another get done by
> another module.
> If you simply paste the URL listed above, You get the image all by
> itself.


Nope.  One needs a valid userid/password for that FTP site.


> (The image is an example, but not a bad image just the same.)
> 
> Can anyone, in a few lines of perl code, get the above image to
> actually download and save into the specified file. Alot of the images
> I am trying to aqcuire are in php or ez board's, but again, I simply
> need to insert the above url into a browser and voila. Just the raw
> image.


 ...


You should *always* test the results of your operations for success.  In 
this case, the get is failing because your URL does not contain a valid 
FTP userid/password for that FTP site.  Your code would probably work 
verbatim were it not for that.  Although the open could also fail, and 
you would never know why the output file wasn't created.

-- 
Bob Walton



------------------------------

Date: Thu, 12 Dec 2002 01:32:39 GMT
From: pkent <pkent77tea@yahoo.com.tea>
Subject: Re: Downloading images from web pages using perl.
Message-Id: <pkent77tea-EDD7CD.01323912122002@news-text.blueyonder.co.uk>

In article <186949a0.0212111440.4df7ed8a@posting.google.com>,
 kawaii@networkduels.com (Kawaii) wrote:

> I am trying to get or request Images from web pages and often I find
> the program
> putting html source code into a .jpg or .gif file. (with the name of
> the image)

> Can anyone, in a few lines of perl code, get the above image to
> actually download and save into the specified file. Alot of the images

> Any help would be great.
> (Please do not suggest wget)

Unless you have a burning desire to write your own code to do this, just 
use the "GET" program which comes as part of the standard LWP bundle. It 
sends the _successfully_ retrieved resource out on STDOUT, or if it was 
_unsusccessful_ it prints an error message (in HTML) to STDERR.

`GET -h` prints out the options you can use.

Note: I don't know whether you need to do this download from inside 
another perl program or as a command line thing - I've assumed the 
latter. If you meant the former, just look at the code in GET :-)

P

-- 
pkent 77 at yahoo dot, er... what's the last bit, oh yes, com
Remove the tea to reply


------------------------------

Date: Thu, 12 Dec 2002 01:46:05 GMT
From: Bob Walton <bwalton@rochester.rr.com>
Subject: Re: How to get GIF pixel information?
Message-Id: <3DF7E8B3.5050109@rochester.rr.com>

David Kurtz wrote:

> I'd like to find the most simple way to pack the colors of an image
> into an array or variable, for use elsewhere. I don't need to display
> the image, but I need to get the color values for each individual
> pixel as it might be displayed.
> 
> I'm looking over Image::Magick right now, but I haven't yet 1)
> determined whether it will do what I need, and  2) decided whether I
> want to install a completely separate program (other than a Perl
> module) to do this.
> 
> Any ideas?
> 

Sure [untested]:

    use GD;
    $myImage = newFromPng GD::Image('barnswallow.png');
    ($x,$y)=$image->getBounds( );
    $maxColors = $myImage->colorsTotal;
    $pixel=$image->getPixel(23,34);
    ($r,$g,$b)=$image->rgb($pixel);

HTH.
-- 
Bob Walton



------------------------------

Date: Thu, 12 Dec 2002 04:11:29 GMT
From: Martien Verbruggen <mgjv@tradingpost.com.au>
Subject: Re: How to get GIF pixel information?
Message-Id: <slrnavg372.865.mgjv@verbruggen.comdyn.com.au>

On 11 Dec 2002 11:21:07 -0800,
	David Kurtz <d0@earthlink.net> wrote:
> I'd like to find the most simple way to pack the colors of an image
> into an array or variable, for use elsewhere. I don't need to display
> the image, but I need to get the color values for each individual
> pixel as it might be displayed.
> 
> I'm looking over Image::Magick right now, but I haven't yet 1)
> determined whether it will do what I need, and  2) decided whether I
> want to install a completely separate program (other than a Perl
> module) to do this.

1) yes, it will.

2) Most image manipulation modules for Perl rely on external
libraries, at least to be able to read various image formats. You will
need to provide any that are required.

That said: Imager is probably easiest to install, because most of its
code is internal to the module. GD would be the next easiest, followed
by Image::Magick. On the other hand, Image::Magick is probably the
most powerful and featureful package, followed by Imager. GD is the
most lightweight and fast. However, depending on the version, GD is
limited to a certain number of colours in an image (256), plus, not
all versions of GD support GIF images.

Here's some code that walks all pixels in an image, and gets all
colours. Individual modules might have methods that give you access to
the image palette directly, but the below code also works for images
that don't have palettes. I have kept the code for each module as
similar as possible.

#!/usr/local/bin/perl -w
use strict;

my $imagefile = shift or die "No file specified\n";

sub rgba2hex
{
    sprintf "%02x%02x%02x%02x", map { $_ || 0 } @_
}

{
    use Imager;
    my %colors;
    my $img = Imager->new();
    $img->open(file => $imagefile) or die $img->errstr;
    my ($w, $h) = ($img->getwidth, $img->getheight);
    for my $i ( 0 .. $w - 1 )
    {
	for my $j ( 0 .. $h - 1 )
	{
	    my $color = $img->getpixel(x => $i, y => $j);
	    my $hcolor = rgba2hex $color->rgba();
	    $colors{$hcolor}++;
	}
    }

    printf "Imager: Number of colours: %d\n", scalar keys %colors;
}

{
    use GD;
    my %colors;
    my $gd = GD::Image->new($imagefile) or die "GD::Image->new($imagefile)";
    my ($w, $h) = $gd->getBounds();
    for my $i ( 0 .. $w - 1 )
    {
	for my $j ( 0 .. $h - 1 )
	{
	    my $index = $gd->getPixel($i, $j);
	    my $hcolor = rgba2hex($gd->rgb($index), 0);
	    $colors{$hcolor}++;
	}
    }

    printf "GD: Number of colours: %d\n", scalar keys %colors;
}

{
    use Image::Magick;
    my %colors;
    my $img = Image::Magick->new();
    my $rc = $img->Read($imagefile);
    die $rc if $rc;
    my ($w, $h) = $img->Get('width', 'height');
    for my $i ( 0 .. $w - 1 )
    {
	for my $j ( 0 .. $h - 1 )
	{
	    my $color = $img->Get("pixel[$i,$j]");
	    my $hcolor = rgba2hex split /,/, $color;
	    $colors{$hcolor}++;
	}
    }

    printf "Image::Magick: Number of colours: %d\n", scalar keys %colors;
}


None of these is fast, mainly because of the overhead of calling Perl
code for each pixel.

Martien
-- 
                        | 
Martien Verbruggen      | True seekers can always find something to
Trading Post Australia  | believe in.
                        | 


------------------------------

Date: Thu, 12 Dec 2002 01:42:39 GMT
From: pkent <pkent77tea@yahoo.com.tea>
Subject: Re: Is this portable and safe?
Message-Id: <pkent77tea-B1898F.01423912122002@news-text.blueyonder.co.uk>

In article <PhMJ9.6$mk.167@news.oracle.com>,
 "Sunil" <sunil_franklin@hotmail.com> wrote:

> system << "EOF" ;
>     sqlplus  scott/tiger\@iasdb.local  \@test.sql 1>test.log
> EOF

when I run it I get:

sh: sqlplus: command not found

so "No" it isn't portable to my machine :-) Seriously though it assumes 
that 'sqlplus' is installed and is in the path - and on at least one 
machine at work the oracle binaries are under /u01/oracle somewhere, 
which isn't in the PATH by default. You may also need to set 
LD_LIBRARY_PATH (or similar) if the Oracle libraries are not where the 
dynamic linker can find them.

You should also usually check the return code of system() in case the 
command failed for whatever reason (see the docs for examples.

I think with the '1>' syntax you're limiting yourself to a Bourne-ish 
shell, whereas a simple '>' may work with the windows shell through 
system (sorry I can't check now but I'm sure someone who knows better 
will say) - AFAIK the Oracle SQL*Plus program on windows is also called 
'sqlplus' and takes the same arguments. Maybe this isn't an issue for 
you though.

P

-- 
pkent 77 at yahoo dot, er... what's the last bit, oh yes, com
Remove the tea to reply


------------------------------

Date: Wed, 11 Dec 2002 19:39:01 -0800
From: Jeff Zucker <jeff@vpservices.com>
Subject: Re: Is this portable and safe?
Message-Id: <3DF804D5.1050502@vpservices.com>

Sunil wrote:

> system << "EOF" ;
>     sqlplus  scott/tiger\@iasdb.local  \@test.sql 1>test.log
> EOF


If portable means portable to a variety of database systems as well as 
on a vairety of platforms, check out DBI::Shell which aims to provide a 
sqlplus-like interface to all DBI accessible databases.

-- 
Jeff

 




------------------------------

Date: Wed, 11 Dec 2002 21:11:51 -0600
From: tadmc@augustmail.com (Tad McClellan)
Subject: Re: multiline regex matching
Message-Id: <slrnavfvjn.37o.tadmc@magna.augustmail.com>

eric <eric.ehlers@btopenworld.com.spamoff> wrote:
>> I've looked at the /m and /s modifiers, but unless I am missing something,
> I
>> don't see how they can help, since I'm not particularly looking to match
> at
>> the beginning or end of a line.  I know that I can parse through the
> 
> the /s modifier tells . to match the newline character just like any other
> character - that's exactly what you need here.  


No it isn't.


-- 
    Tad McClellan                          SGML consulting
    tadmc@augustmail.com                   Perl programming
    Fort Worth, Texas


------------------------------

Date: Thu, 12 Dec 2002 04:21:01 GMT
From: Martien Verbruggen <mgjv@tradingpost.com.au>
Subject: Re: multiline regex matching
Message-Id: <slrnavg3ov.865.mgjv@verbruggen.comdyn.com.au>

On Wed, 11 Dec 2002 16:09:42 -0600,
	Tad McClellan <tadmc@augustmail.com> wrote:
> Robert Zahm <zahm@uiuc.edu> wrote:
> 
>> I am trying to match patterns that may or may not have embedded newlines in
>> them, 
> 
>> I want this to match a couple of different things, including:
>> AAA
>> BBB
>> 
>> BAA
>> ACC
>> 
>> BBA
>> AAC
>> 
>> A
>> A
>> A
>> 
>> So there may or may not be an embedded newline anywhere in the sequence.
> 
> 
>    s/(A\s*?){3}/match/g;

But that also matches spaces.... :)

s/(A\n*?){3}/match/g;

I would have probably picked something like:

s/A\n?A\n?A/match/g;

although yours generalises better to, say, 24 consecutive A's, with
potentially newlines in between.

Actually, I'd probably prefer to clean up the input data first, and
then match.

Martien
-- 
                        | 
Martien Verbruggen      | Failure is not an option. It comes bundled
Trading Post Australia  | with your Microsoft product.
                        | 


------------------------------

Date: Wed, 11 Dec 2002 23:03:53 -0600
From: "Robert Zahm" <zahm@uiuc.edu>
Subject: Re: multiline regex matching
Message-Id: <nKUJ9.5584$Vf3.60665@vixen.cso.uiuc.edu>

> Actually, I'd probably prefer to clean up the input data first, and
> then match.

This creates other formatting problems for me that I would rather not deal
with though, which is why I want to try to match while keeping the embedded
newlines.  I'll try both of those out, thanks so much for your help guys!

Rob
zahm@uiuc.edu




------------------------------

Date: Thu, 12 Dec 2002 10:12:22 +0530
From: "Kasp" <kasp@NO_SPAMepatra.com>
Subject: Newbie Q: Searching a directory for all the files in it.
Message-Id: <at943j$e8s$1@newsreader.mailgate.org>

Hi,

I need to get a list of files in a particular directory. Say C:\temp or
/usr/tmp/users (Windows and/or Unix types).
How can I do this?

I actually need only a filtered sample of files. For Eg. *.txt. Can this
filter be implemented or do I have to provide this logic in the code for
this?

TIA.




------------------------------

Date: Thu, 12 Dec 2002 04:44:19 GMT
From: "Jürgen Exner" <jurgenex@hotmail.com>
Subject: Re: Newbie Q: Searching a directory for all the files in it.
Message-Id: <DuUJ9.2173$m8.211@nwrddc01.gnilink.net>

Kasp wrote:
> I need to get a list of files in a particular directory. Say C:\temp
> or /usr/tmp/users (Windows and/or Unix types).
> How can I do this?

perldoc -f opendir
perldoc -f readdir

> I actually need only a filtered sample of files. For Eg. *.txt. Can
> this filter be implemented or do I have to provide this logic in the
> code for this?

perldoc -f glob

jue




------------------------------

Date: Wed, 11 Dec 2002 22:24:39 -0600
From: "William Alexander Segraves" <wsegrave@mindspring.com>
Subject: Re: Output Lines of 70 Characters
Message-Id: <at9379$k09$1@slb6.atl.mindspring.net>

"Tad McClellan" <tadmc@augustmail.com> wrote in message
news:slrnavfer8.2do.tadmc@magna.augustmail.com...
> William Alexander Segraves <wsegrave@mindspring.com> wrote:
>
> > You should be able to do this with built-in formatting ( format)
> > capabilities of Perl
>
> > Hint: Write to a temp file, then print that to STDOUT.
>
>
> What is the hint supposed to help with?
>
> Is there a problem with using
>
>    write;
> or
>    write STDOUT;

I don't know, off hand; but I'm certainly willing to learn something new. I
just didn't know how to write simultaneously to a file and STDOUT. Fragment
of my original code follows:

# stuff deleted
open(TXT70CHAR, ">text_file_70col.txt") || die "can't create";
open(TXT2CVT, "text_file.txt") || die "cannot open text file";
while (<TXT2CVT>) {
write (TXT70CHAR);
}
# more code deleted

#Layout - 70 columns
#---------1111111112222222222333333333334444444444555555555566666666667
#1234567890123456789012345678901234567890123456789012345678901234567890
format TXT70CHAR =
  ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
$_
~~^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
$_
 .

OTOH, the OP's original "homework" problem was to write to STDOUT; so the
revised code, writing just to STDOUT, would be:

#!perl -w
# usage - perl textcvt_to_70char_v3.pl > text_redir.txt
use strict;
open(TXT2CVT, "text_file.txt") || die "cannot open text file";
while (<TXT2CVT>) {
 write (STDOUT);
}
close(TXT2CVT);

#Layout - 70 columns
#---------1111111112222222222333333333334444444444555555555566666666667
#1234567890123456789012345678901234567890123456789012345678901234567890
format STDOUT =
  ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
$_
~~^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
$_
 .

ISTM this is a lot shorter than what the OP was trying to do.

Thanks again for *your* hints.

Cheers.

Bill Segraves

P.S. The OP had not stated if the input would be on STDIN. In that case, the
above script could be shortened still further to:

#!perl -w
# usage - perl textcvt_to_70char_v4.pl < text_in.txt > text_out.txt
use strict;
while (<STDIN>) {write (STDOUT)}

#Layout - 70 columns
#---------1111111112222222222333333333334444444444555555555566666666667
#1234567890123456789012345678901234567890123456789012345678901234567890
format STDOUT =
  ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
$_
~~^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
$_
 .

You'll see I "cheated" a little on the first line of the format by padding
it with two spaces to align the first line with the continuation lines (
Note: the ~~ are translated into spaces). Now all we need is a way to get
rid of the two leading spaces on every line.

Cheers.

Bill Segraves












------------------------------

Date: Thu, 12 Dec 2002 04:47:28 GMT
From: "Jürgen Exner" <jurgenex@hotmail.com>
Subject: Re: Output Lines of 70 Characters
Message-Id: <AxUJ9.2202$m8.331@nwrddc01.gnilink.net>

William Alexander Segraves wrote:
> I don't know, off hand; but I'm certainly willing to learn something
> new. I just didn't know how to write simultaneously to a file and
> STDOUT.

Please see the FAQ "How do I print to more than one file at once?"
(STDIN is just another file handle)

jue




------------------------------

Date: Wed, 11 Dec 2002 20:56:24 -0600
From: tadmc@augustmail.com (Tad McClellan)
Subject: Re: reg exp problem
Message-Id: <slrnavfumo.2jd.tadmc@magna.augustmail.com>

jaya prakash <prakashrj@hotmail.com> wrote:

> Do you see nay problems with the following modification. 
> 
> pos($sequence) = pos($sequence) - 3;


Looks OK to me...


-- 
    Tad McClellan                          SGML consulting
    tadmc@augustmail.com                   Perl programming
    Fort Worth, Texas


------------------------------

Date: Wed, 11 Dec 2002 23:25:39 GMT
From: "Heavy-G" <junk@x-art.be>
Subject: REGEX match on hostnames
Message-Id: <Xns92E245C88CEBjunkxartbe@195.130.132.65>

Hello,

I'm coding an IRC bot, and for some really basic authentication (i know 
it is really not foolproof, but it is enough for what we need it to) we 
use the hostmask of the user who requested the action, to see if he is 
authorized to do so..
Now, I'm pretty sure that my regex'es are correct, but for some reason, 
the little piece of code beneath only works if the checked host is on the 
last line of the compare file.
You will see that the way it is set now, it will not find a match, but 
change the host to the one with natox@natoxicus... and it will find a 
match.. can anyone help me out here?

thank you very much..

<snippet of code>

#!/usr/bin/perl -w
$|=1;

sub sec_isowner {
	local $chan=shift;
	local $host=shift;
	local $filename="owners";

	if (!-e $filename || !-r $filename) {
		printf "Could not open owner file for channel $chan";
	}

	open OWNERS, "$filename";
	foreach $line (<OWNERS>) {
		print "checking $line";
		if($line =~ $host) {
			close OWNERS;
			print "\n$host =~ $line\n"; #debug output
			return 1;			
		}
	}
	close OWNERS;
	return 0;
}

$host='~heavy-g@heavy-g-.tsps1.freenet6.net';
#$host='~firese7en@D57695CD.kabel.telenet.be';
#$host='~natox@4444554.adsl.skynet.be';
#$host='~sto@C3829418.kabel.telenet.be';
#$host='~natox@natoxicus.tsps1.freenet6.net';

if (sec_isowner("#dpp",$host)) {
	print "\n\nFound Owner";
}
else {
	printf "\n\nNo owner";
}

getc;

</snippet of code>

and the file I use to check against is

<OWNERS file>
~?natox@(.+).adsl.skynet.be
~?stijnvanp@(.*).kabel.telenet.be
~?heavy-g@(.*).kabel.telenet.be
~?supc@(.*).adsl.easynet.be
~?berten@(.*).kabel.telenet.be
~?sto@(.*).kabel.telenet.be
~?heavy-g@heavy-g-.tsps1.freenet6.net
~?natox@natoxicus.tsps1.freenet6.net
</OWNERS file>

-- 
Heavy-G

Daddy? What does FORMATTING DRIVE C: mean?


------------------------------

Date: Thu, 12 Dec 2002 00:22:30 GMT
From: tiltonj@erols.com (Jay Tilton)
Subject: Re: REGEX match on hostnames
Message-Id: <3df7d27a.94314930@news.erols.com>

"Heavy-G" <junk@x-art.be> wrote:

: Now, I'm pretty sure that my regex'es are correct, but for some reason, 
: the little piece of code beneath only works if the checked host is on the 
: last line of the compare file.

Only if there is no trailing newline on the data file's last line.

: sub sec_isowner {
: 	local $chan=shift;
: 	local $host=shift;
: 	local $filename="owners";

my() should be preferred over local().

: 	if (!-e $filename || !-r $filename) {
: 		printf "Could not open owner file for channel $chan";

print() should be preferred over printf() when a formatting string is
not used.

: 	}
: 	open OWNERS, "$filename";
                     ^         ^
Useless use of quotes.

The existence/readability test is nice, but the failure message should
really be saved for when the open() itself fails.

: 	foreach $line (<OWNERS>) {

<OWNERS> in list context like that is slurping the file.  Not a big
deal when the volume is small, but something to be aware of.

    chomp $line; # lest the \n become a necessary part of the match

: 		print "checking $line";
: 		if($line =~ $host) {

Backwards.  $host is your target string, and $line is the regex.

    if( $host =~ /$line/ ) {

: 			close OWNERS;
: 			print "\n$host =~ $line\n"; #debug output

You got it right there, though.  Your debug output was misleading.

: 			return 1;			
: 		}
: 	}
: 	close OWNERS;
: 	return 0;
: }

[snip]
 
: and the file I use to check against is
: 
: ~?natox@(.+).adsl.skynet.be
              ^    ^      ^
: ~?stijnvanp@(.*).kabel.telenet.be
                  ^     ^       ^
[etc]

Lots of unescaped regex metas in there.  Be careful.



------------------------------

Date: Thu, 12 Dec 2002 00:48:39 GMT
From: "Heavy-G" <junk@x-art.be>
Subject: Re: REGEX match on hostnames
Message-Id: <Xns92E2126EF7E54junkxartbe@195.130.132.65>

tiltonj@erols.com (Jay Tilton) wrote in
news:3df7d27a.94314930@news.erols.com: 

> "Heavy-G" <junk@x-art.be> wrote:
> 
>: Now, I'm pretty sure that my regex'es are correct, but for some
>: reason, the little piece of code beneath only works if the checked
>: host is on the last line of the compare file.
> 
[snip really good help]

Thank you very much :)
It works like a charm now :)

That some of the lines were kind of crappy was because I quickly wrote  
this piece to test it, and partially because today is kind of the first day 
I used Perl to write a "big" project, but you pointed out some that I 
didn't know of yet, I'm learning every day :)

-- 
Heavy-G

Daddy? What does FORMATTING DRIVE C: mean?


------------------------------

Date: Wed, 11 Dec 2002 22:32:49 -0500
From: "Matt Garrish" <matthew.garrish@sympatico.ca>
Subject: Re: REGEX match on hostnames
Message-Id: <%rTJ9.3872$281.1035804@news20.bellglobal.com>


"Heavy-G" <junk@x-art.be> wrote in message
news:Xns92E245C88CEBjunkxartbe@195.130.132.65...
>
> You will see that the way it is set now, it will not find a match, but
> change the host to the one with natox@natoxicus... and it will find a
> match.. can anyone help me out here?
>

Don't you hate it when you assume the answer is more difficult than it
really is? Try chomping the line you read in from the file before testing it
against your pattren (you also have the two variables reversed in your
code):

chomp($line);
if ($host =~ /$line/) { # and so on...

Matt




------------------------------

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 4251
***************************************


home help back first fref pref prev next nref lref last post