[22767] in Perl-Users-Digest

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

Perl-Users Digest, Issue: 4988 Volume: 10

daemon@ATHENA.MIT.EDU (Perl-Users Digest)
Thu May 15 14:10:46 2003

Date: Thu, 15 May 2003 11:10:21 -0700 (PDT)
From: Perl-Users Digest <Perl-Users-Request@ruby.OCE.ORST.EDU>
To: Perl-Users@ruby.OCE.ORST.EDU (Perl-Users Digest)

Perl-Users Digest           Thu, 15 May 2003     Volume: 10 Number: 4988

Today's topics:
    Re: is there a built in mathematical type "dot product" <bigj@kamelfreund.de>
    Re: is there a built in mathematical type "dot product" <bigj@kamelfreund.de>
    Re: is there a built in mathematical type "dot product" (Anno Siegel)
    Re: is there a built in mathematical type "dot product" <w.koenig@acm.org>
    Re: Managing remote win32 hosts <MHW@MHW.com>
    Re: mysql DBI ? relaced by NULL (Kevin Collins)
    Re: Negating phrases <john.thetenant-s@moving-picture.com>
    Re: No data entering @array from open(DATA...) <dodger@dodger.org>
        open3 and Perl 5.8 <Andrew.Belsey@sun.com>
        Perlcom.dll - deployment and licensing (Stephane Gregoire)
    Re: removing spaces in a string <bigj@kamelfreund.de>
    Re: To parse two text files and get a combined output.. <wksmith@optonline.net>
    Re: Which module to use for ordered hashes? (Anno Siegel)
        Digest Administrivia (Last modified: 6 Apr 01) (Perl-Users-Digest Admin)

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

Date: Thu, 15 May 2003 15:11:48 +0200
From: "Janek Schleicher" <bigj@kamelfreund.de>
Subject: Re: is there a built in mathematical type "dot product" function	for arrays in perl? How about composition of Hashes?
Message-Id: <pan.2003.05.15.13.02.22.444944@kamelfreund.de>

Anno Siegel wrote at Thu, 15 May 2003 12:29:51 +0000:

> Janek Schleicher <bigj@kamelfreund.de> wrote in comp.lang.perl.misc:
>> Mitchell Laks wrote at Wed, 14 May 2003 05:31:34 -0700:
>> 
>> > is there a built in mathematical "dot product" of arrays in perl (ie
>> > component wise "combination", for each array element) or do we simply
>> > write the obvious loop?
>> 
>> Eric's solution is fantastic,
>> however here's the solution that works as a classic Perl one line.
>> I don't find that this loop is that inconvenient.
>> 
>> my @dot_product = map {$_->[0] . $_->[1]} \@array1, \@array2;
>> # or
>> my @dot_product = map {shift . shift} \@array1, \@array2;
> 
> This is not even an approximation to the dot product.  It concatenates
> the first two elements of @array1 and the first two of @array2 and
> returns these in a two-element list.

D'oh, of course.
Let's have another assault :-)

use List::Util;
my @dot_product = map {$array1->[0] . $array2->[1]} 
                      (0 .. max($#array1,$#array2));

That's not that beautiful anymore,
but was meant.


Greetings,
Janek



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

Date: Thu, 15 May 2003 10:39:32 +0200
From: "Janek Schleicher" <bigj@kamelfreund.de>
Subject: Re: is there a built in mathematical type "dot product" function for arrays in perl? How about composition of Hashes?
Message-Id: <pan.2003.05.15.08.39.30.174320@kamelfreund.de>

Mitchell Laks wrote at Wed, 14 May 2003 05:31:34 -0700:

> is there a built in mathematical "dot product" of arrays in perl (ie
> component wise "combination", for each array element) or do we simply
> write the obvious loop?

Eric's solution is fantastic,
however here's the solution that works as a classic Perl one line.
I don't find that this loop is that inconvenient.

my @dot_product = map {$_->[0] . $_->[1]} \@array1, \@array2;
# or
my @dot_product = map {shift . shift} \@array1, \@array2;
                      

Greetings,
Janek

PS: I really hope Eric will upload the pairwise function to CPAN.
    What aboud adding it to the List::Utils package ?


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

Date: 15 May 2003 12:29:51 GMT
From: anno4000@lublin.zrz.tu-berlin.de (Anno Siegel)
Subject: Re: is there a built in mathematical type "dot product" function for arrays in perl? How about composition of Hashes?
Message-Id: <ba017v$fo$2@mamenchi.zrz.TU-Berlin.DE>

Janek Schleicher <bigj@kamelfreund.de> wrote in comp.lang.perl.misc:
> Mitchell Laks wrote at Wed, 14 May 2003 05:31:34 -0700:
> 
> > is there a built in mathematical "dot product" of arrays in perl (ie
> > component wise "combination", for each array element) or do we simply
> > write the obvious loop?
> 
> Eric's solution is fantastic,
> however here's the solution that works as a classic Perl one line.
> I don't find that this loop is that inconvenient.
> 
> my @dot_product = map {$_->[0] . $_->[1]} \@array1, \@array2;
> # or
> my @dot_product = map {shift . shift} \@array1, \@array2;

This is not even an approximation to the dot product.  It concatenates
the first two elements of @array1 and the first two of @array2 and
returns these in a two-element list.

Anno


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

Date: Thu, 15 May 2003 18:14:06 +0200
From: Winfried Koenig <w.koenig@acm.org>
Subject: Re: is there a built in mathematical type "dot product" function for arrays in perl? How about composition of Hashes?
Message-Id: <3EC3BCCE.8070707@acm.org>

Janek Schleicher wrote:
> Anno Siegel wrote at Thu, 15 May 2003 12:29:51 +0000:
> 
> 
>>Janek Schleicher <bigj@kamelfreund.de> wrote in comp.lang.perl.misc:
>>
>>>Mitchell Laks wrote at Wed, 14 May 2003 05:31:34 -0700:
>>>
>>>
>>>>is there a built in mathematical "dot product" of arrays in perl (ie
>>>>component wise "combination", for each array element) or do we simply
>>>>write the obvious loop?
>>>
>>>Eric's solution is fantastic,
>>>however here's the solution that works as a classic Perl one line.
>>>I don't find that this loop is that inconvenient.
>>>
>>>my @dot_product = map {$_->[0] . $_->[1]} \@array1, \@array2;
>>># or
>>>my @dot_product = map {shift . shift} \@array1, \@array2;
>>
>>This is not even an approximation to the dot product.  It concatenates
>>the first two elements of @array1 and the first two of @array2 and
>>returns these in a two-element list.
> 
> 
> D'oh, of course.
> Let's have another assault :-)
> 
> use List::Util;
> my @dot_product = map {$array1->[0] . $array2->[1]} 
>                       (0 .. max($#array1,$#array2));
> 
> That's not that beautiful anymore,
> but was meant.

please, test Your stuff!

use List::Util qw(max);

my @array1 = qw(a b c d e);
my @array2 = qw(A B C D E);

my @dot_product = map {$array1[$_] . $array2[$_]}
                       (0 .. max($#array1,$#array2));

Winfried Koenig



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

Date: Thu, 15 May 2003 06:10:23 -0700
From: "MHW" <MHW@MHW.com>
Subject: Re: Managing remote win32 hosts
Message-Id: <zrMwa.21388$hd6.19012@fed1read05>

Thanks all. I have approached this from all angles I can find and it looks
like WMI scripting may be the way to go. Windows 2000 and 2003 has a WMI
provider for WLBS located at root\MicrosoftNLB. I am pretty sure I can
interface with this object through perl.

Thanks,

MHW

"William Goedicke" <goedicke@goedsole.com> wrote in message
news:m3n0hrf2tx.fsf@mail.goedsole.com...
> Dear MHW -
>
> "MHW" <MHW@MHW.com> writes:
>
> > I want the ability to pole for service availability (HTTP, Terminal
> > Services, etc.) on a Windows Load Balanced Cluster (WLBS)
>
> You should investigate netsaint (i.e. http://www.netsaint.org).
>
> > and [then I want to] generate windows commands from the Linux server
> > to remove hosts from the cluster.
>
> In the past I solved this problem by creating a CGI script on the
> servers that would execute arbitrary commands contained in the URL.
>
> "What?!?!?!" you say; that's the worst security disaster possible!
> The trick was that I encrypted the URL-embedded command with the
> public key of each server I was controlling.  I used this in
> combination with netsaint to automatically control services for
> several hundred machines at a web-hosting firm.  It worked like a
> charm.
>
> We also used it for systems configuration management and diagnostics.
> We kept a database of diagnostic commands which we ran against
> machines when customers reported problems to isolate changes.
> Consider commands: perl -v, cksum /etc/xinetd.conf and net services.
>
>      Yours -      Billy
>
> ============================================================
>      William Goedicke     goedicke@goedsole.com
>                           http://www.goedsole.com:8080
> ============================================================
>
>           Lest we forget:
>
> A day without raw fish is like a day without sunshine.
>
> - William Goedicke




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

Date: 15 May 2003 10:11:44 -0700
From: spamtotrash@toomuchfiction.com (Kevin Collins)
Subject: Re: mysql DBI ? relaced by NULL
Message-Id: <a6882f32.0305150911.46753a7e@posting.google.com>

mike_solomon@lineone.net (Mike Solomon) wrote in message news:<56568be5.0305130336.14772d10@posting.google.com>...
> I am using DBI and mysqlPP to insert into a database
> 
> If my data includes '?' they get replaced with NULL
> 
> I have tried prefixing ? with \ but that makes no difference
> 
> Any help to resolve this would be much appreciated
> 
> Sample script below:
> 
> use strict;
> 
> #connect to database
> use DBI ();
> 
> #database connect info
> my $host = "localhost";
> my $database = "test";
> my $user = "test";
> my $password = "test";
> 
>  # Connect to the database.
> my $g_dbh = DBI->connect("DBI:mysqlPP:database=$database;host=$host","$user","$password")
> 	 or die "$DBI::errstr";
> 
> my $sql = qq \
> INSERT INTO datacodes (codetype, code, description,description2)
> 			VALUES ( 'mike ? mike' , '01' ,'MIKE ? TEST' ,'MIKE ??? TES' )
> \;
> 
> my $g_data = $g_dbh->prepare($sql);
> $g_data->execute();
> 
> Regards
> 
> Mike Solomon

Mike,

   the '?' is used as a "bind variable" placeholder when used in a
prepare().

I would think that backslash escape would work, but you are escaping
it once when defining $sql where "\?" will end up as "?" after
interpolation (because you are using qq// - I'm also not sure about
using the "\" as a delimiter for the qq being a wise choice).

When you pass $sql to prepare(), the backslashes are gone. I suspect
that if you double escape (or use q// instead of qq//), it will work:


my $g_dbh = DBI->connect("DBI:mysqlPP:database=$database;host=$host","$user","$password")
or die "$DBI::errstr";

my $sql = qq/INSERT INTO datacodes (codetype, code,
description,description2)
	VALUES ( 'mike \\? mike' , '01' ,'MIKE \\? TEST' ,'MIKE \\?\\?\\?
TES' )/;

my $g_data = $g_dbh->prepare($sql);
$g_data->execute();


Optionally, you can skip the prepare()/execute and use do() without
defining $sql:

my $g_dbh = DBI->connect("DBI:mysqlPP:database=$database;host=$host","$user","$password")
or die "$DBI::errstr";

my $g_data = $g_dbh->do("INSERT INTO datacodes (codetype,
code,description, description2) VALUES ( 'mike \? mike' , '01' ,'MIKE
\? TEST' ,'MIKE \?\?\?TES')");

I would recommend reading 'perldoc DBI' or 'man DBI' - specifically
the section on prepare()...

Good luck,

Kevin


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

Date: Thu, 15 May 2003 11:35:07 +0100
From: John Strauss <john.thetenant-s@moving-picture.com>
Subject: Re: Negating phrases
Message-Id: <20030515113507.17ad6566.john.thetenant-s@moving-picture.com>

On Thu, 15 May 2003 09:49:51 GMT
Bart Lateur <bart.lateur@pandora.be> wrote:
>
> Allanon wrote:
> 
> >>     print unless /Name is (?:Billy|Fred)/;
> >
> >Yes, I guess that would work.. however, I wanted to handle the negation
> >purely inside the regular expression.
> 
> Eh? That *is* inside the regular expression.
> 
> -- 
> 	Bart.

the negation is not in the regexp, it's in the "unless", right?

i don't see why it matters, but maybe he could use:
print if /Name is (?!Billy|Fred(?!.))/;

btw, the suggested solution would work perfectly if it were anchored:
print unless /Name is (?:Billy|Fred)$/;
otherwise Freda matches.
                                 


~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
drop the .thetenant to get me via mail


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

Date: Thu, 15 May 2003 12:55:11 -0500
From: Dodger <dodger@dodger.org>
Subject: Re: No data entering @array from open(DATA...)
Message-Id: <Xns937C6F7ED8FA8dodgerdodgerorg@216.166.71.239>

On 13 May 2003, "Brad Walton" <sammie@greatergreen.com> in 
news:oZhwa.837397$F1.105601@sccrnsc04 said something that resembled:

> This has me stumped. I must be missing something very basic, but I cannot
> get @currplids to populate with the data from $playeriddb. Anyone see the
> mistake?
> 
> Code:
> ----
>  my (@currplids, $playerid, $currplids, $playerupdate);
>  #Grab current player id database
>  open(CPDATA, ">>$playeriddb") or "cannot open $playeriddb: $! \n";
>  while (<CPDATA>) {
>   @currplids = (@currplids,$_);
>  }
> 
>  #Set variable for next new player id
>  $playerid = @currplids;
>  print "first $playerid\n@currplids\n";


Everyone has pointed out the append-mode magick on the open that you also 
noticed yourself.

And Anno pointed out that you're telling perl to open or simply think about 
a string (open(CPDATA, ">>$playeriddb") or "cannot open $playeriddb: $! 
\n";) rather than warning, dying, printing, storing the error, or 
something.

But something else I noticed about this...

> @currplids = (@currplids,$_);

Would normally be said like this (which is, I think, better Perl grammar):
push @currplids, $_;

And of course, then, rather than the whole block:

>  while (<CPDATA>) {
>   @currplids = (@currplids,$_);
>  }

 if this is all you're doing, you could do this:

1 while push @currplids, <CPDATA>;

but at that point, since you're instantiating @currplids empty anyway and 
not stickign things on the front of it (which you could unshift 
onto it afterwards anyway if you were) it would be simpler and more 
standard just to say:

my @currplids = (<CPDATA>);

since you're sucking the whole file into an array anyway. This second way 
of doing this simply treats the entire file as a list seperated by \n (or 
whatever you've set the input record seperator to be, though I'm sure 
you've wisely not messed around with that without reason).

Of course, if you want to chomp the lines then that won't work, and the 
normal way to do it is with the while loop. Or you could just do this:

my @currplids = map {chomp; $_} (<CPDATA>);

-- 
Dodger


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

Date: Thu, 15 May 2003 13:38:22 +0100
From: Andy Belsey <Andrew.Belsey@sun.com>
Subject: open3 and Perl 5.8
Message-Id: <ba01nv$1eo$1@new-usenet.uk.sun.com>

Hi,

	I've found a problem with Perl 5.8 and the open3 function. I'm not sure 
if I'm doing something stupid, so I'd like the group's opinion on what's 
going on here. I've cut down the application code I have to the bare 
minimum to show the problem. The problem only seems to exist in V5.8 
(I've tested it on both Solaris and Linux), older versions of Perl work 
fine.

  The spawner.pl file below uses the open3 function to fork off a 
process to execute the child.pl file (also below). Then, spawner.pl 
reads and processes the stdout and stderr streams from the forked child 
until these are both closed, whereupon it reaps the exit status of the 
child. The child.pl script does this:

1. prints a message to its stdout
2. prints a message to its stderr
3. forks and becomes a proper daemon (closing and redirecting
    its standard streams)
4. parent exits
5. (grand)child prints messages to stdout/stderr, sleeps and prints
    a final message to both stdout and stderr then exits

  In versions of Perl other than 5.8, you can see that the spawner.pl 
script behaves as expected, it sees the child exiting and immediately 
after that it sees the child file handles close. However, with 5.8, 
spawner.pl doesn't see the child handles close until the grandchild 
process has finished. Note that only the Perl version running the 
spawner.pl script is important. I tried a Tcl version of the child with 
the same result.

  I tried using lsof to see what files are open in the child process and 
I see three extra FIFO's in the 5.8 case which I suspect are the 
original pipes created by the open3 call. I can't see why there are 
still open in the child though.

  This code is part of a larger application which streams the child 
stdout/stderr bytes back across a socket. If the child process forks, I 
can only be sure that I've got all the I/O when the handles close - if I 
rely on the SIGCHLD to tell me, I sometimes miss some of the I/O in Perl 
5.8 case as the handles are still (erroneously) open in the grandchild 
and haven't been flushed.

  Any help will be very much appreciated. It looks like a bug in 5.8. 
However, if people can point out where I've went wrong (and why it works 
in older Perl versions), I'll be very grateful.


Andy Belsey,
Sun Microsystems,
Linlithgow,
Scotland.




spawner.pl:
------------ CUT HERE --------------------
#!/usr/bin/perl -w


use strict;
use POSIX;
use IPC::Open3;
use IO::Select;
use IO::Handle;


sub set_non_blocking {
     my $flags = fcntl(${$_[0]}, F_GETFL(), 0);
     fcntl(${$_[0]}, F_SETFL(), $flags | O_NONBLOCK());
}



     # this is a forking daemon script
     my $cmdLine = './child.pl';


     # watch for SIGCHLD signals
     $SIG{CHLD} = sub {
         print "received a SIGCHLD\n";
     };


     my ($childIN, $childOUT, $childERR) =
             (IO::Handle->new(),
              IO::Handle->new(),
              IO::Handle->new());

     my $pid = open3($childIN, $childOUT, $childERR, $cmdLine);
     close($childIN);

     print "forked pid $pid to execute '$cmdLine'\n";

     set_non_blocking($childOUT);
     set_non_blocking($childERR);


     # asynch I/O loop, select on child streams
     my $selector = new IO::Select;
     $selector->add($childOUT, $childERR);

     my @ready;

     MAINLOOP: while(1) {

         # nothing readable?
         unless (@ready = $selector->can_read(0.5)) {

             # check if all handles have closed
             last MAINLOOP unless $selector->handles();
         }


         print "select() returned ".
               scalar @ready.
               " ready handle(s)\n";


         # we have something to read on one or more handles,
         # so we fetch all we can from all that are ready
         my ($bytesRead, $data) = ();

         foreach my $fh (@ready) {

             # we'll try to read in 8k chunks
             my $bytesToRead = 8192;
             my $handle;

             if ($fh == $childERR) {
                 $handle = 'child STDERR';
             } else {
                 $handle = 'child STDOUT';
             }

             print "$handle is ready to read\n";


             # read all the available bytes for this handle
             READLOOP: while ($bytesToRead) {

                 my $bytes = sysread $fh, $data, $bytesToRead;

                 if (defined $bytes) {

                     print " read $bytes bytes from $handle\n";

                     # check if handle was closed
                     if ($bytes == 0) {

                         print " $handle was closed\n";

                         $selector->remove($fh);
                         close $fh;

                     } else {

                         $bytesToRead -= $bytes;
                         chomp $data;
                         print " data: '$data'\n";
                     }

                 } else {

                     # blocked, nothing left to read, or
                     # error back to the select() call
                     print " no more data available\n";

                     last READLOOP;
                 }
             }
         }
     }


     # blocking wait for the child's exit status
     waitpid($pid,0);

     my $exitValue = POSIX::WEXITSTATUS($?);
     my $signalNum = POSIX::WTERMSIG($?);
     my $dumpedCore = $? & 128;

     print "exit/sig/core status for child pid ".
           "$pid: ($exitValue, ".
           "$signalNum, $dumpedCore)\n";

     exit 0;
------------ CUT HERE --------------------





child.pl:
------------ CUT HERE --------------------
#!/usr/bin/perl -w


use strict;
use POSIX;

# how long the child sleeps between messages
use constant DELAY      => 5;

# the name of the daemon's log file
use constant LOGNAME    => 'child.log';



     # autoflush stdout
     $| = 1;

     print STDOUT "message to child's STDOUT: about to fork\n";
     print STDERR "message to child's STDERR: about to fork\n";


     # fork
     die "can't fork\n" unless defined(my $child = fork());

     # parent exits here
     exit 0 if $child;

     # setsid (to become process and session group leader)
     die "can't setsid()\n" if (POSIX::setsid() == -1);

     # fork again
     die "can't fork\n" unless defined($child = fork());

     # parent exits here (again)
     exit 0 if $child;

     # redirect STDOUT
     my $logfile = "perl_child.log";
     close STDOUT;
     open(STDOUT, ">".LOGNAME);

     # stderr stream same as stdout
     close STDERR;
     open(STDERR, ">&STDOUT");

     # stdin becomes /dev/null
     close STDIN;
     open(STDIN, '/dev/null');



     # ------------------------------------------------------
     # now, we're a proper daemon
     # ------------------------------------------------------
     print STDOUT "message to child's STDOUT: forked, about to sleep\n";
     print STDERR "message to child's STDERR: forked, about to sleep\n";

     sleep DELAY;

     print STDOUT "message to child's STDOUT: awake, about to exit\n";
     print STDERR "message to child's STDERR: awake, about to exit\n";

     exit 0;
------------ CUT HERE --------------------



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

Date: 15 May 2003 08:33:11 -0700
From: stephanegregoire@hotmail.com (Stephane Gregoire)
Subject: Perlcom.dll - deployment and licensing
Message-Id: <9ed209ed.0305150733.64f3d0c7@posting.google.com>

Hello,

I've searched everywhere for an answer to this question and found
nothing but vague info so I'll try posting in this newsgroup:

My problem:
I have made several application which uses Activestates' PERLCOM.DLL
and this works great (at least on my development workstation). My
problem is about deployment of software built by using the dll...

In my tests, it seems that the only way for the software to work on
another machine is to deploy and run the Perl SDK license executable
on each machine along with the software. Merely registering
Perlcom.dll (and it's dependency perl56.dll) does not works.

Does that mean that we need to buy one license per machine on which we
deploy an application which uses perlcom.dll ? As far as I am
concerned, all activex DLL that I know of are "pay per developper who
uses it" licensing basis, not on a "pay per workstation to deploy to"
basis.

If anyone could shed some light on this issue it would be appreciated.


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

Date: Thu, 15 May 2003 15:11:46 +0200
From: "Janek Schleicher" <bigj@kamelfreund.de>
Subject: Re: removing spaces in a string
Message-Id: <pan.2003.05.15.13.03.58.863030@kamelfreund.de>

Kevin wrote at Tue, 13 May 2003 10:32:11 -0700:

> how do you remove spaces in a string varaible?

Or if you like to work with modules, have a look to:

use String::Strip;
StripSpace($string);


Greetings,
Janek


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

Date: Thu, 15 May 2003 15:54:50 GMT
From: "Bill Smith" <wksmith@optonline.net>
Subject: Re: To parse two text files and get a combined output...
Message-Id: <eLOwa.9761$6L5.4734408@news4.srv.hcvlny.cv.net>


"Jim Carter" <carterave@yahoo.com> wrote in message
news:9c2a26b6.0305141828.7e9c0aad@posting.google.com...
> Hi experts,
>
> I have a file (file1.txt) with the following text (with 21 lines):
> -------------------------------------------
> 1. test1 C:\john\hello1.txt
>                 C:\john\hello2.txt
>
> 2. test2 C:\john\hello4.txt
>    C:\john\hello6.txt
>              C:\john\hello3.tx
>                 C:\john\hello10.txt
>
> 3. test3 C:\john\hello111.txt
>
> 4. test4 C:\john\hello123.txt
>
> 5. test5 C:\john\hello34.txt
>                 C:\john\hello27.txt
>
> 6. test20 C:\john\hello34.txt
>                 C:\john\hello4.txt
>   C:\john\hello36.txt
>                 C:\john\hello8.txt
>     C:\john\hello9.txt
>                 C:\john\hello10.txt
> ----------------------------------------------
>
>
> Then, I have a second file (file2.txt).
> ---------------------------
> test1 America
> test2 Russia
> test3 Italy
> test7 Germany
> test10 France
> test12 Canada
> test20 Mexico
> ---------------------------
>
>
> Now, I want to compare all 7 first fields (test1, test2,....test20)in
> the second file with those in the first file and I want the below
> output, extracted from both the files.
> ---------------------------------------------------------------------
> 1. test1 America C:\john\hello1.txt
>                 C:\john\hello2.txt
>
> 2. test2 Russia C:\john\hello4.txt
>                 C:\john\hello6.txt
>                 C:\john\hello3.tx
>                 C:\john\hello10.txt
>
> 3. test3 Italy C:\john\hello111.txt
>
> 4. test7 Germany         none
>
> 5. test10 France none
>
> 6. test12 Canada none
>
> 7. test20 Mexico C:\john\hello34.txt
>                  C:\john\hello4.txt
>                C:\john\hello36.txt
>                C:\john\hello8.txt
>                 C:\john\hello9.txt
>                 C:\john\hello10.txt
> ---------------------------------------------------------------------
>
> Here, there can be more than one tab at the beginning of the lines (in
> the first file), where the line doen't start with the first field
> (like test 1, test2 etc).
>
> I wrote the below script to compare and stuck somewhere in the middle:
> ----------------------------------
> #! C:/perl/bin/perl
>
> chomp(@file1 = `cat C:\\file1.txt`);
> chomp(@file1 = `cat C:\\file1.txt`);
>
> foreach $line (@file2)
>   {
>       if(! grep /$word/, @file1)
>        {
>          print "@file1\n";
>        }
>   }
> -------------------------------------------
>
> I know this doen't work. And I am struggling to get the combined
> output that I gave above.
>
> Can someone pl. help me out?
>
I had to make some assumptions about your definition of fields.  You
will probably have to change my regex's.
This seems to work for you sample data.  It should get you started.

use strict;
use warnings;
my %hash;
open (FILE1,"file1.dat") or die "Cannot open file1.";
{
 local $/ = "\n\n";   # "Paragraph mode"
 foreach (<FILE1>){
  /\d+\.\s+(\S+)\s+(.*)/s;
  $hash{$1}=$2;
 }
}
close FILE1;

open(FILE2, "file2.dat") or die "Cannot open file2.";
my $i;
foreach (<FILE2>){
 chomp;
 /^(\S+)/;
 print ++$i," $_ ", exists($hash{$1})? $hash{$1}: "none\n\n";
}
close FILE2;

Refer to perldoc perlvar for use of INPUT_RECORD_SEPARATOR ($\).

Enjoy,
Bill




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

Date: 15 May 2003 10:57:11 GMT
From: anno4000@lublin.zrz.tu-berlin.de (Anno Siegel)
Subject: Re: Which module to use for ordered hashes?
Message-Id: <b9vrq7$fo$1@mamenchi.zrz.TU-Berlin.DE>

Lechu  <kopetnik@s-pam-nie.yahoo.com> wrote in comp.lang.perl.misc:
> On Wed, 14 May 2003 14:00:23 +0200, Tore Aursand <tore@aursand.no>
> wrote:
> 
> >On Wed, 14 May 2003 13:18:22 +0200, Lechu wrote:
> >> There are some implementations of ordered hashes on CPAN.
> >> [...]
> 
> >The Tie::IxHash module from CPAN
> >  might also be instructive.
> Unfortunately this module doesn't provide solution for
> multidimensional hashes:
> 
> 
> my $hash={};
> tie %$hash,'Tie::IxHash';
> 
> # here the order is preserved
> $hash->{a}={};
> $hash->{b}={};
> $hash->{c}={};
> $hash->{d}={};
> $hash->{e}={};
> $hash->{f}={};
> 
> # here the order is lost
> $hash->{a}{a}={};
> $hash->{a}{b}={};
> $hash->{a}{c}={};
> $hash->{a}{d}={};
> $hash->{a}{e}={};
> $hash->{a}{f}={}; 

Sure.  %{ $hash-{ a}} is just a vanilla hash.  If you want it to
preserve order, tie it:

    tie %{ $hash->{ a}}, 'Tie::IxHash';

 ...and similar for every other index you use in the outer hash.

Anno


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

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


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