[28911] in Perl-Users-Digest

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

Perl-Users Digest, Issue: 155 Volume: 11

daemon@ATHENA.MIT.EDU (Perl-Users Digest)
Tue Feb 20 16:10:08 2007

Date: Tue, 20 Feb 2007 13:09:08 -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           Tue, 20 Feb 2007     Volume: 11 Number: 155

Today's topics:
        Combining M-F school week and 6 day class cycle gfoyle@gmail.com
        Creating pivot table <arunmandalapu@gmail.com>
    Re: Creating pivot table <nospam@somewhere.com>
    Re: fcntl call to check if a file is open - help needed <nobull67@gmail.com>
    Re: fcntl call to check if a file is open - help needed <sysadmin00@gmail.com>
    Re: find the last element of a line in a file <xicheng@gmail.com>
    Re: find the last element of a line in a file <wahab-mail@gmx.de>
    Re: find the last element of a line in a file anno4000@radom.zrz.tu-berlin.de
        Finding Background processes? <pankaj_wolfhunter@yahoo.co.in>
    Re: Finding Background processes? <nobull67@gmail.com>
        Help with string replacement <amerar@iwc.net>
    Re: Help with string replacement <noreply@invalid.net>
        net::mysql holds onto my query <lskatz@gmail.com>
    Re: Newbie...Not able to include a file in perl script <pankaj_wolfhunter@yahoo.co.in>
        Quick Question thorassic5@gmail.com
    Re: Quick Question usenet@DavidFilmer.com
    Re: Quick Question <wahab-mail@gmx.de>
    Re: Quick Question thorassic5@gmail.com
    Re: Quick Question <wahab-mail@gmx.de>
    Re: Quick Question <jurgenex@hotmail.com>
        Read Zip on SMB drive with Perl danny@debsinc.com
    Re: Regex: Why is overreaching necessary? <Shannon.Jacobs.nospam@gmail.com>
    Re: waitpid woes on Solaris, Perl 5.8.8 <ad_101@yahoo.com>
    Re: waitpid woes on Solaris, Perl 5.8.8 <ad_101@yahoo.com>
        Digest Administrivia (Last modified: 6 Apr 01) (Perl-Users-Digest Admin)

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

Date: 20 Feb 2007 12:55:51 -0800
From: gfoyle@gmail.com
Subject: Combining M-F school week and 6 day class cycle
Message-Id: <1172004951.013862.199120@m58g2000cwm.googlegroups.com>

I work at a school where we have repeating events over a six day
school cycle. So we have classes on Day 1 that repeat on the next
school day after Day 6. Our school days are Monday through Friday,
with days off for holidays and what not. For example if our school
year started on August 30, 2007, that would be DAY 1. August 31, 2007,
would be DAY 2. There is no school on the weekend and the following
Monday is Labor Day, so September 4, 2007, would be DAY 3. Etc., etc.
till you get to the end date.

This makes it very difficult to use regular calendars to schedule
events, because they all assume things repeat on a daily, weekly, or
monthly basis.

I want to create (or find) a perl script that can take a start date,
an end date, and a set of "off days" and output an iCalendar
compatible file where each date in the iCalendar is marked as a DAY
1-6 or an off day. With this script, I will be able to label each day
(DAY 1, DAY 2, etc.) and put in my classes. For me, weekends would
always be off-days, but it would be nice to be able to turn off this
assumption.

If you know of a project that is already working on this, please share
it with me.

If you can recommend some CPAN modules that would be helpful for me to
build this script, it would be much appreciated. I'm currently looking
at DateTime::Format::ICal.

Thank you for your assistance,
Gully.



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

Date: 20 Feb 2007 08:48:01 -0800
From: "myperl" <arunmandalapu@gmail.com>
Subject: Creating pivot table
Message-Id: <1171990081.659818.157280@m58g2000cwm.googlegroups.com>

Hi,

I am bringing the data to an excel sheet and showing it as a report
through perl. Now my requirement is to produce a pivot table on the
same data and show it.I am using win32::OLE in my perl code to bring
the sheet. If some have an URL or code example will be great.


Thanks



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

Date: Tue, 20 Feb 2007 15:48:43 -0500
From: "Thrill5" <nospam@somewhere.com>
Subject: Re: Creating pivot table
Message-Id: <fu-dnemKz9Qxw0bYnZ2dnUVZ_oqmnZ2d@comcast.com>

"myperl" <arunmandalapu@gmail.com> wrote in message 
news:1171990081.659818.157280@m58g2000cwm.googlegroups.com...
> Hi,
>
> I am bringing the data to an excel sheet and showing it as a report
> through perl. Now my requirement is to produce a pivot table on the
> same data and show it.I am using win32::OLE in my perl code to bring
> the sheet. If some have an URL or code example will be great.
>
>
> Thanks
>

As far as I know you can't create a pivot table in Excel using OLE.  This is 
an Excel problem, not a Perl problem.

Scott




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

Date: 20 Feb 2007 10:16:17 -0800
From: "Brian McCauley" <nobull67@gmail.com>
Subject: Re: fcntl call to check if a file is open - help needed
Message-Id: <1171995377.452188.107580@j27g2000cwj.googlegroups.com>

On Feb 20, 12:46 pm, "sa" <sysadmi...@gmail.com> wrote:
> > perldoc -f fileno
> >    fileno FILEHANDLE
> >            Returns the file descriptor for a filehandle, or undefined if the
> >            filehandle is not open.
>
> I don't see how it's going to work for me - I need to check whether a
> file is open by another process. Sorry if it wasn't clear. I need to
> copy the file and I should not do it if there is another process
> writing to it. To complicate things further, the file is located on a
> CIFS share. I'm in the process of checking if fcntl can do it for a
> network drive but I'm having problems using it on a local file.

Well, the first thing to do would be to check that the CIFS protocol
is capable of conveying such a query (I don't think it is). If I'm
wrong then see if the particular server implementation implements it.
The look to see if the client implements it. Then, and only then,
should you consider how to get Perl to tell the CIFS client to ask the
CIFS server if the file is open.

I think this is probably XY. The safest, most portable and widely
accepted approach to having one process create a file and another read
it only after creation is complete is to rename the file upon
completion of creation.



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

Date: 20 Feb 2007 10:33:02 -0800
From: "sa" <sysadmin00@gmail.com>
Subject: Re: fcntl call to check if a file is open - help needed
Message-Id: <1171996382.147069.203650@a75g2000cwd.googlegroups.com>

> > I don't see how it's going to work for me - I need to check whether a
> > file is open by another process. Sorry if it wasn't clear. I need to
> > copy the file and I should not do it if there is another process
> > writing to it. To complicate things further, the file is located on a
> > CIFS share. I'm in the process of checking if fcntl can do it for a
> > network drive but I'm having problems using it on a local file.
>
> Well, the first thing to do would be to check that the CIFS protocol
> is capable of conveying such a query (I don't think it is). If I'm
> wrong then see if the particular server implementation implements it.
> The look to see if the client implements it. Then, and only then,
> should you consider how to get Perl to tell the CIFS client to ask the
> CIFS server if the file is open.
>
> I think this is probably XY. The safest, most portable and widely
> accepted approach to having one process create a file and another read
> it only after creation is complete is to rename the file upon
> completion of creation.

Ha! I wish I had control over the process of creating of those files!
Unfortunately, this is totally out of the question.

The CIFS protocol and client do know something - when I open a CIFS
file in say, notepad, and try mv'ing it from the shell prompt - I get
this:

[root@willow tmp]# mv test.txt test.txt_
mv: preserving ownership for `test.txt_': Operation not permitted
mv: cannot unlink `test.txt': Text file busy
mv: cannot remove `test.txt': Text file busy

I get $! of "Text file busy" from perl when I try to rename. It looks
like this info can be tapped into, I just don't know how.

Going back to the original question - I'd also like to be able to do
what lsof does using perl. lsof rocks but it's a bit slow.

Thanks,
Alex.




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

Date: 20 Feb 2007 08:01:00 -0800
From: "Xicheng Jia" <xicheng@gmail.com>
Subject: Re: find the last element of a line in a file
Message-Id: <1171987260.290497.315260@s48g2000cws.googlegroups.com>

On Feb 20, 7:54 am, Mirco Wahab <wahab-m...@gmx.de> wrote:
> anno4...@radom.zrz.tu-berlin.de wrote:
> > Mirco Wahab  <wahab-m...@gmx.de> wrote in comp.lang.perl.misc:
>
> >>   my @ftpfilesout = grep defined, map m{(?<=\s/).*?/([^/]+?)$}, <LOGFILE>;
>
> > The "grep defined" stage isn't really necessary here.  A regex will only
> > return an undefined capture if the capture is in an optional part.  That
> > doesn't happen here.
>
> > If the match fails altogether (in list context), it returns an empty
> > list, not undef, so map does the right thing and adds nothing.
>
> Correct.
>
> I was under the (wrong) impression
> a *non match situation* would inject
> undefs. It, of course, does not.
>
> Furthermore, the lookbehind is not necessary here
> (I tried to get a non-capturing solution first), so
> a simple:   @stuff= map m|\s/.*?/([^/]+?)$|, <LOGFH>
> would (imho) catch all.

how about just removing all stuff before the last forward slash:

  @stuff = map { s|.*/||; $_ } <LOGFH>

Regards,
Xicheng



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

Date: Tue, 20 Feb 2007 18:07:54 +0100
From: Mirco Wahab <wahab-mail@gmx.de>
Subject: Re: find the last element of a line in a file
Message-Id: <erfa7f$541$1@mlucom4.urz.uni-halle.de>

Xicheng Jia wrote:
> On Feb 20, 7:54 am, Mirco Wahab <wahab-m...@gmx.de> wrote:
>> anno4...@radom.zrz.tu-berlin.de wrote:
>>> Mirco Wahab  <wahab-m...@gmx.de> wrote in comp.lang.perl.misc:
>>>>   my @ftpfilesout = grep defined, map m{(?<=\s/).*?/([^/]+?)$}, <LOGFILE>;
>>> The "grep defined" stage isn't really necessary here.  A regex will only
>>> return an undefined capture if the capture is in an optional part.  That
>>> doesn't happen here.
>>> If the match fails altogether (in list context), it returns an empty
>>> list, not undef, so map does the right thing and adds nothing.
>> Correct.
>>
>> I was under the (wrong) impression
>> a *non match situation* would inject
>> undefs. It, of course, does not.
>>
>> Furthermore, the lookbehind is not necessary here
>> (I tried to get a non-capturing solution first), so
>> a simple:   @stuff= map m|\s/.*?/([^/]+?)$|, <LOGFH>
>> would (imho) catch all.
> 
> how about just removing all stuff before the last forward slash:
> 
>   @stuff = map { s|.*/||; $_ } <LOGFH>

This would return matches on both lines of the OP's data:

2007/02/15 18:29:22 192.168.0.12 ftpuser1 STOR 436699136 /ftp-data/expl/data/out/region1/ftpuser1/video.mpg
2007/02/15 17:46:31 192.168.0.12 ftpuser1 RETR - -

where the alternative:

     m|\s/.*?/([^/]+?)$|

would match only on the first line
(it bails out if no /'es with one [:space:] in front).

Regards

M.


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

Date: 20 Feb 2007 17:26:53 GMT
From: anno4000@radom.zrz.tu-berlin.de
Subject: Re: find the last element of a line in a file
Message-Id: <540pasF1ua3oqU1@mid.dfncis.de>

Xicheng Jia <xicheng@gmail.com> wrote in comp.lang.perl.misc:
> On Feb 20, 7:54 am, Mirco Wahab <wahab-m...@gmx.de> wrote:
> > anno4...@radom.zrz.tu-berlin.de wrote:
> > > Mirco Wahab  <wahab-m...@gmx.de> wrote in comp.lang.perl.misc:
> >
> > >>   my @ftpfilesout = grep defined, map m{(?<=\s/).*?/([^/]+?)$}, <LOGFILE>;
> >
> > > The "grep defined" stage isn't really necessary here.  A regex will only
> > > return an undefined capture if the capture is in an optional part.  That
> > > doesn't happen here.
> >
> > > If the match fails altogether (in list context), it returns an empty
> > > list, not undef, so map does the right thing and adds nothing.
> >
> > Correct.
> >
> > I was under the (wrong) impression
> > a *non match situation* would inject
> > undefs. It, of course, does not.
> >
> > Furthermore, the lookbehind is not necessary here
> > (I tried to get a non-capturing solution first), so
> > a simple:   @stuff= map m|\s/.*?/([^/]+?)$|, <LOGFH>
> > would (imho) catch all.
> 
> how about just removing all stuff before the last forward slash:
> 
>   @stuff = map { s|.*/||; $_ } <LOGFH>

That will leave line feeds at the end of each file name.  It also
won't work on data that doesn't have a file name at the end -- that
was at least one problem addressed in the OP.

I am never quite happy with solutions that use s/// where
a capture would do.  Simplest tool for the job, and all that...
There is usually a capturing equivalent, in this case

    @stuff = map m|.*/(.+)|s, @data;

If you drop the /s, it won't capture line feeds.  Of course,
it still fails on data without a file name (or, for that matter,
for file names without a slash).

Anno


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

Date: 20 Feb 2007 09:04:44 -0800
From: "pankaj_wolfhunter@yahoo.co.in" <pankaj_wolfhunter@yahoo.co.in>
Subject: Finding Background processes?
Message-Id: <1171991084.259201.250560@a75g2000cwd.googlegroups.com>

Greetings,
               I want to check whether a particular script (say
test.txt) is already running in background or not?
If it exists then I want to exit the code else proceed further.

I am new to perl and have done this in shell scripting but not able to
find the equivalent in perl

-- unix shell script
if [[ `ps -ef | grep $script_name | grep -vcE "grep|vi|cat|more|tail|
head" ` > 1 ]]; then
   echo " $script_name script is currently running on `hostname`"
   exit
fi

Any help would be appreciated?

TIA



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

Date: 20 Feb 2007 10:04:52 -0800
From: "Brian McCauley" <nobull67@gmail.com>
Subject: Re: Finding Background processes?
Message-Id: <1171994692.410867.147380@t69g2000cwt.googlegroups.com>

On Feb 20, 5:04 pm, "pankaj_wolfhun...@yahoo.co.in"
<pankaj_wolfhun...@yahoo.co.in> wrote:
> Greetings,
>                I want to check whether a particular script (say
> test.txt) is already running in background or not?
> If it exists then I want to exit the code else proceed further.
>
> I am new to perl and have done this in shell scripting but not able to
> find the equivalent in perl
>
> -- unix shell script
> if [[ `ps -ef | grep $script_name | grep -vcE "grep|vi|cat|more|tail|
> head" ` > 1 ]]; then
>    echo " $script_name script is currently running on `hostname`"
>    exit
> fi

You can similarly parse the STDOUT /bin/ps executed with argument '-
ef' using Perl just as you do above in shell script.

if ( grep { /$script_name/ && !/grep|vi|cat|more|tail|head/ } `ps -
ef` )

Alternatively you could look on CPAN for a Perl module with similar
semantics to /bin/ps (Proc::ProcessTable).

Be aware, of course, that the approach you have above is somewhat
prone to false readings.

I'd recommend you use some sort of resource lock to prevent multiple
instances of a program.



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

Date: 20 Feb 2007 12:21:32 -0800
From: "amerar@iwc.net" <amerar@iwc.net>
Subject: Help with string replacement
Message-Id: <1172002892.510099.222000@q2g2000cwa.googlegroups.com>


Hi,

I'm trying to use the -pi switches to replace some strings in a file.
However, I'm getting some very strange results.

My test file looks like this:

daily_rank.sh|22:30|22:31|22:35|Y
dart_process.sh|17:45|17:45|14:46|Y
prft_trck.sh|7:30|7:30|7:46|Y

Here is my command line:

perl -pi -e "s/$x/$y/;" job_control

$x = daily_rank.sh|22:30|22:31|22:35|Y
$y = daily_rank.sh|22:30|14:13|22:35|N

After the Perl command executes, my file looks like this:

daily_rank.sh|22:30|14:13|22:35|N|22:30|22:31|22:35|Y
dart_process.sh|17:45|17:45|14:46|daily_rank.sh|22:30|14:13|22:35|N
prft_trck.sh|7:30|7:30|7:46|daily_rank.sh|22:30|14:13|22:35|N

This is not what I expected.  I excpected just the first line to be
replaced.

This may have to do with quotes?  Or maybe it has to do with the pipe
being a special character?  But, I've been at it for hours and was
looking for a bit of help?

Thanks!



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

Date: Tue, 20 Feb 2007 20:49:33 GMT
From: Ala Qumsieh <noreply@invalid.net>
Subject: Re: Help with string replacement
Message-Id: <x9JCh.29691$yC5.8756@newssvr27.news.prodigy.net>

amerar@iwc.net wrote:

> 
> Hi,
> 
> I'm trying to use the -pi switches to replace some strings in a file.
> However, I'm getting some very strange results.
> 
> My test file looks like this:
> 
> daily_rank.sh|22:30|22:31|22:35|Y
> dart_process.sh|17:45|17:45|14:46|Y
> prft_trck.sh|7:30|7:30|7:46|Y
> 
> Here is my command line:
> 
> perl -pi -e "s/$x/$y/;" job_control
> 
> $x = daily_rank.sh|22:30|22:31|22:35|Y
> $y = daily_rank.sh|22:30|14:13|22:35|N
> 
> After the Perl command executes, my file looks like this:
> 
> daily_rank.sh|22:30|14:13|22:35|N|22:30|22:31|22:35|Y
> dart_process.sh|17:45|17:45|14:46|daily_rank.sh|22:30|14:13|22:35|N
> prft_trck.sh|7:30|7:30|7:46|daily_rank.sh|22:30|14:13|22:35|N
> 
> This is not what I expected.  I excpected just the first line to be
> replaced.
> 
> This may have to do with quotes?  Or maybe it has to do with the pipe
> being a special character?  But, I've been at it for hours and was
> looking for a bit of help?

Yes, the pipe. You need to quotemeta-it:

  s/\Q$x/$y/

checkout 'perlre' and '-f quotemeta' for more info.

--Ala



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

Date: 20 Feb 2007 09:45:56 -0800
From: "Lee" <lskatz@gmail.com>
Subject: net::mysql holds onto my query
Message-Id: <1171993556.106359.291480@s48g2000cws.googlegroups.com>

Hi,
I am sending this query to Net::MySQL, and it halts.  The program
doesn't move forward to tell me if there is an error or to print the
next line after that.  This query works in the query browser, and I
can make other queries in the same program.  Thus, I know that there
is no general problem with making queries, and I know that there is no
problem with how I make the queries.  Can you guys help me figure out
what is wrong with pairing this query with perl?  Many thanks!

sub writeCsvFromQuery{
    my($query,$newFilename)=@_;
    my $time = time();
    print "Running query\n$query\n";
    $mysql->query($query);
    print "Getting result..\n";
    if($mysql->is_error()){
        print "Cannot run query because " . $mysql-
>get_error_message();
        return;
    }
    my $result=$mysql->create_record_iterator();
    my @field=$result->get_field_names();
    open(SPREADSHEET,">$newFilename") or die ($!);
    print SPREADSHEET join(',',@field) . "\n";
    while(my $row=$result->each){
        my $line = join(',',@$row) . "\n";
        chomp($line);
        print SPREADSHEET $line . "\n";
    }
    close SPREADSHEET;
    print "Spreadsheet was written to $newFilename\n";
    my $timeTook = time() - $time;
    print "Query took " . ($timeTook) . " seconds to complete, or " .
($timeTook/60) . " minutes.\n";
    return 1;
}

this query works:
SELECT * FROM network LIMIT 3;

this query does not work (but works in the query browser):
SELECT DISTINCT niNode1,niNode2,niR,maNode1,maNode2,maR FROM(
  SELECT net.node1 AS niNode1,net.node2 AS niNode2,net.r AS
niR,cloneid
  FROM intersection,
  network net
  WHERE lineage='NI'
  AND r>0.92
  AND (net.node1 IN (SELECT cloneid FROM intersection) AND net.node2
IN (SELECT cloneid FROM intersection) )
  AND (intersection.cloneid = net.node1 OR intersection.cloneid =
net.node2)
) niEdge,
(
  SELECT net.node1 AS maNode1,net.node2 AS maNode2,net.r AS
maR,cloneid
  FROM intersection,
  network net
  WHERE lineage='MA'
  AND r>0.92
  AND (net.node1 IN (SELECT cloneid FROM intersection) AND net.node2
IN (SELECT cloneid FROM intersection) )
  AND (intersection.cloneid = net.node1 OR intersection.cloneid =
net.node2)
 ) maEdge
    WHERE (maNode1=niNode1 AND maNode2=niNode2)
    OR (maEdge.maNode2=niEdge.niNode1 AND
maEdge.maNode1=niEdge.niNode2)
    ORDER BY niNode1,maNode1;



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

Date: 20 Feb 2007 09:59:43 -0800
From: "pankaj_wolfhunter@yahoo.co.in" <pankaj_wolfhunter@yahoo.co.in>
Subject: Re: Newbie...Not able to include a file in perl script
Message-Id: <1171994383.442578.128880@t69g2000cwt.googlegroups.com>

On Feb 20, 2:39 pm, Josef Moellers <josef.moell...@fujitsu-
siemens.com> wrote:
> pankaj_wolfhun...@yahoo.co.in wrote:
> > One more thing, whats the difference between USE, INCLUDE and DO?
>
> perldoc -f use
> ITYM perldoc -f require
> perldoc -f do
>
> --
> Josef M=F6llers (Pinguinpfleger bei FSC)
>         If failure had no penalty success would not be a prize
>                                                 -- T.  Pratchett

Thanks Joseph



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

Date: 20 Feb 2007 10:41:09 -0800
From: thorassic5@gmail.com
Subject: Quick Question
Message-Id: <1171996869.698063.221490@a75g2000cwd.googlegroups.com>

Im trying to read a series of files and extract a small, unique piece
of data from each of them, and print it in a log file.  grep didnt
seem to be working as i expected, until i realized that the files
werent being opened, and my regex was banging against the <i>names</i>
of the files.  heres what i have,
#!/usr/bin/perl
opendir(DIR, ".");
my @files = glob "*.txt";
closedir(DIR);
open(OUT, ">log.log");
foreach $file (@files){
	my @user = grep{!/inventory\d{6}/} $file;
	print OUT "$_ \n";
}
close OUT;

Where have i led myself astray?

Thanks!



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

Date: 20 Feb 2007 11:07:40 -0800
From: usenet@DavidFilmer.com
Subject: Re: Quick Question
Message-Id: <1171998460.908644.60890@l53g2000cwa.googlegroups.com>

On Feb 20, 10:41 am, thorass...@gmail.com wrote:
> #!/usr/bin/perl

Your next line should be:
   use strict;

> opendir(DIR, ".");
> my @files = glob "*.txt";
> closedir(DIR);

You don't need opendir to do a glob().  If you are doing a readdir()
then you need opendir().

Also, it's almost always a bad idea to "load up" an array with the
results of an IO operation.  Just iterate over the results directly.

> open(OUT, ">log.log");

Better to use lexical filehandles and the three-argument form of
open()

> foreach $file (@files){
>         my @user = grep{!/inventory\d{6}/} $file;
>         print OUT "$_ \n";}
>
> Where have i led myself astray?

I believe you've already deduced that you're matching against the file
name instead of the file contents. You need to look inside the file:

#!/usr/bin/perl
   use strict;
   use warnings;

   open (my $logfile, ">", '/tmp/log.log');

   foreach my $file(glob '/tmp/*.txt') {
      open (my $in, "<", $file);
      while (<$in>) {
         print $logfile $_ unless /inventory\d{6}/i;
      }
      close $in;
   }
   close $logfile;

__END__






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

Date: Tue, 20 Feb 2007 20:26:13 +0100
From: Mirco Wahab <wahab-mail@gmx.de>
Subject: Re: Quick Question
Message-Id: <erfiar$79f$1@mlucom4.urz.uni-halle.de>

thorassic5@gmail.com wrote:
> #!/usr/bin/perl
> opendir(DIR, ".");
> my @files = glob "*.txt";
> closedir(DIR);
> open(OUT, ">log.log");
> foreach $file (@files){
> 	my @user = grep{!/inventory\d{6}/} $file;
> 	print OUT "$_ \n";
> }
> close OUT;
> 
> Where have i led myself astray?

There are some problems, as David
already pointed out, I won't repeat
his remarks.

I'd like to add the idea to re-structure
the program in order to read the directories
sequentially per Perl-Idiom (opendir/readdir)
and check for "real" files before accessing them:

  use strict;
  use warnings;

  my $dir = shift || '.';
  my $not_if = qr/inventory\d{6}/;

  open my $outh, '>', 'log.log' or die "can't write $!";

  opendir( my $dirhandle, $dir ) or die "can't open $!";
  while( my $fname = readdir $dirhandle ) {
     my $fpath = $dir.'/'.$fname;
     next if not -f $fpath;

     open my $fh, '<', $fpath or die "can't read $!";
     print $outh "$fname\n" if grep !/$not_if/, <$fh>;
     close $fh;
  }
  closedir $dirhandle;
  close $outh;




Regards

M.


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

Date: 20 Feb 2007 11:29:42 -0800
From: thorassic5@gmail.com
Subject: Re: Quick Question
Message-Id: <1171999782.177794.127380@p10g2000cwp.googlegroups.com>

On Feb 20, 11:07 am, use...@DavidFilmer.com wrote:
> On Feb 20, 10:41 am, thorass...@gmail.com wrote:
>
> > #!/usr/bin/perl
>
> Your next line should be:
>    use strict;
>
> > opendir(DIR, ".");
> > my @files = glob "*.txt";
> > closedir(DIR);
>
> You don't need opendir to do a glob().  If you are doing a readdir()
> then you need opendir().
>
> Also, it's almost always a bad idea to "load up" an array with the
> results of an IO operation.  Just iterate over the results directly.
>
> > open(OUT, ">log.log");
>
> Better to use lexical filehandles and the three-argument form of
> open()
>
> > foreach $file (@files){
> >         my @user = grep{!/inventory\d{6}/} $file;
> >         print OUT "$_ \n";}
>
> > Where have i led myself astray?
>
> I believe you've already deduced that you're matching against the file
> name instead of the file contents. You need to look inside the file:
>
> #!/usr/bin/perl
>    use strict;
>    use warnings;
>
>    open (my $logfile, ">", '/tmp/log.log');
>
>    foreach my $file(glob '/tmp/*.txt') {
>       open (my $in, "<", $file);
>       while (<$in>) {
>          print $logfile $_ unless /inventory\d{6}/i;
>       }
>       close $in;
>    }
>    close $logfile;
>
> __END__

Brilliant, this is much closer to what i was hoping for.  Switch
[unless] for [if] and its perfect!  Thank you!



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

Date: Tue, 20 Feb 2007 20:39:58 +0100
From: Mirco Wahab <wahab-mail@gmx.de>
Subject: Re: Quick Question
Message-Id: <erfj4j$7ka$1@mlucom4.urz.uni-halle.de>

thorassic5@gmail.com wrote:
> my @files = glob "*.txt";
> closedir(DIR);
> open(OUT, ">log.log");
> foreach $file (@files){
> 	my @user = grep{!/inventory\d{6}/} $file;
> 	print OUT "$_ \n";
> }
> close OUT;
> Where have i led myself astray?

There are some problems, as David
already pointed out, I won't repeat
his remarks.

I'd like to add the idea to re-structure
the program in order to read the directories
sequentially per Perl-Idiom (opendir/readdir)
and check for "real" files before accessing them:


use strict;
use warnings;

  my $dir = shift || '.';
  my $pattern = '.txt';
  my $not_if = qr/inventory\d{6}/;

  open my $outh, '>', 'log.log' or die "can't write $!";

  opendir( my $dirhandle, $dir ) or die "can't open $!";
  while( my $fname = readdir $dirhandle ) {
     my $fpath = $dir.'/'.$fname;
     next if ! -f $fpath
          or $fname !~ /$pattern$/;

     open my $fh, '<', $fpath or die "can't read $!";
     print $outh "$fname\n" if grep !/$not_if/, <$fh>;
     close $fh;
  }
  closedir $dirhandle;
  close $outh;


Regards

M.


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

Date: Tue, 20 Feb 2007 20:22:02 GMT
From: "Jürgen Exner" <jurgenex@hotmail.com>
Subject: Re: Quick Question
Message-Id: <KLICh.9895$SR.6233@trndny06>

thorassic5@gmail.com wrote:
> Im trying to read a series of files and extract a small, unique piece
> of data from each of them, and print it in a log file.  grep didnt
> seem to be working as i expected, until i realized that the files
> werent being opened, and my regex was banging against the <i>names</i>
> of the files.  heres what i have,
> #!/usr/bin/perl

Missing
    use strict;
    use warnings;

> opendir(DIR, ".");

Missing
    or die ("Can't open '.' because $!\n";

> my @files = glob "*.txt";
> closedir(DIR);
> open(OUT, ">log.log");


Missing
    or die ("Can't open 'log.log' because $!\n";

> foreach $file (@files){
> my @user = grep{!/inventory\d{6}/} $file;

@files contains the file names. Are you sure you want to match/grep them?

jue 




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

Date: 20 Feb 2007 12:02:45 -0800
From: danny@debsinc.com
Subject: Read Zip on SMB drive with Perl
Message-Id: <1172001765.673763.138970@t69g2000cwt.googlegroups.com>

I have been able to create a zip file on my Windows box using the
Filesys::SmbClient interface, but cannot open it back up with the F::S
and Archive::Zip combination.  Anyone else tried this?



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

Date: 20 Feb 2007 12:33:19 -0800
From: "Shannon Jacobs" <Shannon.Jacobs.nospam@gmail.com>
Subject: Re: Regex: Why is overreaching necessary?
Message-Id: <1172003598.103049.218420@t69g2000cwt.googlegroups.com>

On Feb 20, 8:47 pm, Ilya Zakharevich <nospam-ab...@ilyaz.org> wrote:
> [A complimentary Cc of this posting was sent to
> Shannon Jacobs
> <Shannon.Jacobs.nos...@gmail.com>], who wrote in article <1171928007.342955.293...@v45g2000cwv.googlegroups.com>:
>
> > (I did test Ilya Zakharevich's proposed suggestion in the next post,
> > and it worked more poorly, producing additional false matches. I'm
> > eager to study the differences there, though his approach seems more
> > complicated than yours.)
>
> The only difference *in semantic* is //x which I used (for clarity);
> the possible difference I meant is in performance.
>
> If your hash contains spaces etc, you may need to modify it
> accordingly (either remove //x and formatting, or wrap the hash in (?-x:)).
>
> Hope this helps,
> Ilya

Looking at your version again, the problem is the same one that I had
before with the first part being included in the match. For example,
if the search target includes 1101, and the first fifty characters
include 1101, then it produces a false match for that line. I tested
it both with and without the x parameter, and it made no difference.
(My ancient version of the camel book doesn't even 'translate' that
"x" word in that context. From that perspective, my limited Japanese
is superior to my fluency in Perl.) I couldn't understand your .50
versus my .{50}, so I tried that, too. No joy.

I did some more testing with Anno's version, and I feel like it is
correct and that there is some other problem going on there. In
particular, when I 'manually' forced a search on 1101 in isolation
using Anno's version, it works correctly, but running in the normal
context with other values, it produces a false match on the second
line of the following data:

Algorithms + Data Structures = Programs 19760010021657        CS

Waking Up Just in Time                  1995001003210921101612PsPh

Boukyouhen: Hinotori No.6               19870010042111        SFJa


So in my next round of experiments, I manually trimmed the search
target to see what it was really matching on. This broke my mind...
However, I think I found the minimal example of the problem. If I
limit the search target to this:

 909|1101

It produces the false match of that second line. But as

1101| 909

there is no problem. The problem is somehow apparently due to the
leading space, since

 908|1101

also produces the false match (though the rest of the results are
correct). Lisp and Japanese make more sense to me... If this was a
contest, I would say that the laurels rest with Anno, and I think I'll
just try to live with this slight peculiarity.



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

Date: 20 Feb 2007 11:40:41 -0800
From: "A" <ad_101@yahoo.com>
Subject: Re: waitpid woes on Solaris, Perl 5.8.8
Message-Id: <1172000440.864370.103930@v45g2000cwv.googlegroups.com>

On Feb 14, 7:54 pm, "Mark" <goo...@markginsburg.com> wrote:
> On Feb 13, 11:22 am, "A" <ad_...@yahoo.com> wrote:
>
> > I am getting intermittent unexpected result fromwaitpidon Solaris 9
>
> > sub runIt
> > {
> >   my $oldSigCld  = $SIG{CLD};
> >   local $SIG{CLD}  = \&sigChldHandler;
>
> I think you meant sigCLDhandler here.

Yes!



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

Date: 20 Feb 2007 12:06:39 -0800
From: "A" <ad_101@yahoo.com>
Subject: Re: waitpid woes on Solaris, Perl 5.8.8
Message-Id: <1172001999.884071.176260@h3g2000cwc.googlegroups.com>

On Feb 14, 12:31 pm, xhos...@gmail.com wrote:
> "A" <ad_...@yahoo.com> wrote:
> > On Feb 13, 3:44 pm, xhos...@gmail.com wrote:
>
> > > You are mucking with $SIG{CLD} when, as far as I can tell, you have
> > > no need to.  getChildStatus (and thewaitpidin it) can get called
> > > twice, once from the sig handler and once from the runIt.  If it does
> > > get called twice, the second time that child no longer exists, as it
> > > was already waited on. Remove the $SIG{CLD} stuff.
>
> > > Xho
>
> > > - Show quoted text -
>
> > Thanks for your reply.
>
> > First, there's a typo in my original message.
>
> > The third line after the while(1) in getChildStatus should be
> >      $tm = $!;
> > instead of
> >      $em = $!;
>
> > Now, to the point that thewaitpidcould get called twice.
>
> > Please note that the code is designed to guard against this, the
> > assignments to the globals $ec and $em are done if and only ifwaitpid
> > returns the matching pid.
>
> The waitpid of one getChildStatus returns the expected pid and sets the
> global $? and $!.  Before it can do anything else, the waitpid of the other
> getChildStatus returns -1 and over writes the global $? and $! with it's
> own values, but for this one $r does not meet the if and so returns control
> to the first getChildStatus.  The first getChildStatus was the right pid
> recorded in $r (as that was a lexical and didn't get overwritten), but has
> the wrong $? and $! because they did get overwritten, and now those get
> recorded into your $tm and $cm
>

Thanks for your explanation. Yes, it has every indication of being a
race condition.

>
> > On your advice to remove the $SIG{CLD}, there are 3 statements,
>
> >    the first statement saves the handler,
> >    the second statement installs the current one needed by this
> > routine
> >    and the last one re-installs the saved handler.
>
> > which one(s) would you suggest I remove?
>
> Probably all of them, but it is not really possible to know from what you
> give. We would need to see the code that set the orginal handler that is
> getting saved and then restored.  If the handler you inherit is necessary,
> then why would it be safe to overwrite it with something else for even the
> duration of this routine?  On the other hand, if the handler you inherit is
> not necessary, then what is the point of saving and re-installing it?  If
> there is no other code which intalls a handler in the first place, then I'd
> remove all three of those things.  (And even if not, remove at least two,
> see below)
>
> > Yes, there's a deficiency (bug, if you will) in the code. The
> > $SIG{CLD} should be re-installed if fork fails, but that I think, is
> > of no consequence to the problem at hand.
>
> Since you use local to install the handler, I think the old one will be
> reinstalled upon fork failure anyway.  Saving the old one explicitly and
> reinstalling explicit seem to be unnecessary, assuming the local is doing
> its job.
>
> Xho
>

I am not sure I understand your remark that the rest of the code
should be a factor in determining what signal handling should be used
here. The rest of the code may or may not contain other routines which
may or may not install their own handlers, and the same may be true
for the calling routine.

Now I had been scouring our logs since my earlier posts, and here is
the finding:
   This is a "bug" in Perl 5.8.8 itself, at least in Perl 5.8.8 on
Solaris 9.


The original Program_A (in Perl) and Program_B (C++) are running
unchanged for about a year. We had been using Perl 5.6.1 that came
with the Solaris. We discovered a separate "bug" in that Perl (related
to file locking). Then we migrated to the Perl 5.8.8. And the "errors"
I described in the OP started appearing exactly at the same time.

More tellingly, these applications run of a set of servers which are,
network wise and geographic location wise, diverse. The upgrade to the
Perl 5.8.8 was done in stages and the "problem" started on each
machine on precisely the date that machine was upgraded to Perl 5.8.8.

So, it appears that we traded one Perl bug for another.

Thanks.



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

Date: 6 Apr 2001 21:33:47 GMT (Last modified)
From: Perl-Users-Request@ruby.oce.orst.edu (Perl-Users-Digest Admin) 
Subject: Digest Administrivia (Last modified: 6 Apr 01)
Message-Id: <null>


Administrivia:

#The Perl-Users Digest is a retransmission of the USENET newsgroup
#comp.lang.perl.misc.  For subscription or unsubscription requests, send
#the single line:
#
#	subscribe perl-users
#or:
#	unsubscribe perl-users
#
#to almanac@ruby.oce.orst.edu.  

NOTE: due to the current flood of worm email banging on ruby, the smtp
server on ruby has been shut off until further notice. 

To submit articles to comp.lang.perl.announce, send your article to
clpa@perl.com.

#To request back copies (available for a week or so), send your request
#to almanac@ruby.oce.orst.edu with the command "send perl-users x.y",
#where x is the volume number and y is the issue number.

#For other requests pertaining to the digest, send mail to
#perl-users-request@ruby.oce.orst.edu. Do not waste your time or mine
#sending perl questions to the -request address, I don't have time to
#answer them even if I did know the answer.


------------------------------
End of Perl-Users Digest V11 Issue 155
**************************************


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