[19693] in Perl-Users-Digest

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

Perl-Users Digest, Issue: 1888 Volume: 10

daemon@ATHENA.MIT.EDU (Perl-Users Digest)
Mon Oct 8 03:05:41 2001

Date: Mon, 8 Oct 2001 00:05:09 -0700 (PDT)
From: Perl-Users Digest <Perl-Users-Request@ruby.OCE.ORST.EDU>
To: Perl-Users@ruby.OCE.ORST.EDU (Perl-Users Digest)
Message-Id: <1002524708-v10-i1888@ruby.oce.orst.edu>
Content-Type: text

Perl-Users Digest           Mon, 8 Oct 2001     Volume: 10 Number: 1888

Today's topics:
    Re: Apply Regex In Place <goldbb2@earthlink.net>
    Re: Apply Regex In Place (Martien Verbruggen)
    Re: binmode with "perl -p" doesn't work (John Lin)
    Re: Grafikeinbettung (Martien Verbruggen)
        integer division <yah00204052@yahoo.com>
    Re: integer division eric+u@taedium.com
    Re: integer division <goldbb2@earthlink.net>
    Re: join two hashrefs (F. Xavier Noria)
    Re: join two hashrefs <goldbb2@earthlink.net>
        pattern matching (Tony)
    Re: Perl 5.6.0 chmod bug? (Doug)
    Re: Perl 5.6.0 chmod bug? (Doug)
        Stop Transversal of a Directory... the dot dot problem <whataman@home.com>
    Re: Stop Transversal of a Directory... the dot dot prob <dtweed@acm.org>
    Re: Stop Transversal of a Directory... the dot dot prob <goldbb2@earthlink.net>
    Re: Stop Transversal of a Directory... the dot dot prob <whataman@home.com>
    Re: Stop Transversal of a Directory... the dot dot prob <dtweed@acm.org>
    Re: Stop Transversal of a Directory... the dot dot prob <goldbb2@earthlink.net>
    Re: time transformation <dtweed@acm.org>
    Re: time transformation <bwalton@rochester.rr.com>
    Re: time transformation (Tim Hammerquist)
    Re: unix comm perl style blah@blah.blah.invalid
        Digest Administrivia (Last modified: 6 Apr 01) (Perl-Users-Digest Admin)

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

Date: Sun, 07 Oct 2001 23:00:13 -0400
From: Benjamin Goldberg <goldbb2@earthlink.net>
Subject: Re: Apply Regex In Place
Message-Id: <3BC116BD.4FB14664@earthlink.net>

Linda Turner wrote:
> 
> Thanks for that.  I added a counter to capture the number of times
> something was changed, but it doesn't seem to be working.  I am also
> getting some messages that I wonder if I should worry about.  Any
> thoughts?
> 
> C:\uf\sql>perl -W c:\UF\PERL\SIP.PL
> Subroutine cwd redefined at C:/Perl/lib/Cwd.pm line 397.
> Subroutine getcwd redefined at C:/Perl/lib/Cwd.pm line 398.
> Subroutine fastcwd redefined at C:/Perl/lib/Cwd.pm line 399.
> Subroutine fastgetcwd redefined at C:/Perl/lib/Cwd.pm line 400.
> Subroutine abs_path redefined at C:/Perl/lib/Cwd.pm line 401.
> processing C:\UF\SQL/roll.sql : 0
> processing C:\UF\SQL/ex.sql : 0
> processing C:\UF\SQL/locks.sql : 0
> ...
> 
> #!/usr/local/bin/perl -w
> 
> use File::Find;
> use strict;
> 
> $/ = undef;
> 
> my $start_dir = 'C:\\UF\\SQL';
> 
> File::Find::find( \&each_file, $start_dir );
> 
> sub each_file {
>   return unless /\.sql$/;
>   if ( -T $_ ) {

Your code would be slightly easier to read, if instead of:
  if( -T $_ ) {
    ...do stuff...
  }
you changed it to:
  return if !-T $_;
  ...do stuff...
which gets rid of one level of nesting.
You can combine this with the test for the filename being *.sql :
  return if !/\.sql\z/i || !-T $_;

>     print "processing $File::Find::name : ";
>     my $match_count = 0;
>     if ( open F, "< $_" ) {

Again, you could change this to decrease the amount of nesting:

#!/usr/local/bin/perl -w;
use File::Find;
use strict;
my $start_dir = "C:/UF/SQL";
my $match_count = 0; # have to declare it up here for it to work right.
File::Find::find( sub {
  return if !/\.sql\z/i || !-T $_;
  unless( open( local(*F), "<+ $_" ) ) {
    print "Error opening $_ for read/write: $!\n";
    return;
  }
  unless( defined read( F, my($s), -s F ) ) {
    print "Error reading from file $_: $!\n";
    return;
  }
  $match_count += ($s =~ s/COLUMN1/COLUMN2/ig);
  print "match count: $match_count\n";
  unless( seek F, 0, 0 ) {
    print "Error seeking to beginning of file $_: $!\n";
    return;
  }
  unless( print F $s ) {
    print "Error writing back to file $_: $!\n"; 
    return;
  }
  unless( truncate F, length $s ) {
    print "Error truncating file to new length $_: $!\n";
    return;
  }
  unless( close F ) {
    print "Error closing file $_: $!\n";
    return;
  }
}, $start_dir );
print "match count: $match_count\n";

>       my $s = <F>;
>       close F;
>       if ( open F, "> $_" ) {
>         if ($s =~ s/COLUMN1/COLUMN2/ig) {
>            my $match_count++;
>         }
>         print F $s;
>         close F;
>         print "$match_count\n";  #only prints 0 !!
>       }
>       else {
>         print "Error opening file for write: $!\n";
>       }
>     }
>     else {
>       print "Error opening file for read: $!\n";
>     }
>   }
> }

I'm not complaining about how you indent each level of nesting... I'm
complaining about how many levels of nesting you have, when it's easy to
rewrite the code so they aren't necessary.

-- 
    "Just how stupid are you Kuno?"
    "Verily, Tatewaki Kuno knows no limits."


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

Date: Mon, 8 Oct 2001 13:48:15 +1000
From: mgjv@tradingpost.com.au (Martien Verbruggen)
Subject: Re: Apply Regex In Place
Message-Id: <slrn9s28fv.d6o.mgjv@martien.heliotrope.home>

On Sun, 07 Oct 2001 23:00:13 -0400,
	Benjamin Goldberg <goldbb2@earthlink.net> wrote:
> Linda Turner wrote:
>> 
>> sub each_file {
>>   return unless /\.sql$/;
>>   if ( -T $_ ) {
> 
> Your code would be slightly easier to read, if instead of:
>   if( -T $_ ) {
>     ...do stuff...
>   }
> you changed it to:
>   return if !-T $_;
>   ...do stuff...

I'd probably write that as 

return unless -T $_;

which IMO is much more readable.

Martien
-- 
Martien Verbruggen              | 
Interactive Media Division      | You can't have everything, where
Commercial Dynamics Pty. Ltd.   | would you put it?
NSW, Australia                  | 


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

Date: 7 Oct 2001 20:23:38 -0700
From: johnlin@chttl.com.tw (John Lin)
Subject: Re: binmode with "perl -p" doesn't work
Message-Id: <a73bcad1.0110071923.280bb9b@posting.google.com>

Malcolm Dew-Jones wrote
> : John Lin wrote:
> : >So, do you think my proposal of "perl -b" switch for binmode is considerable?
> This identical problem and the identical suggested solution have been
> discussed in the past, so maybe work has already been done and could be
> found if you search in the right place.  (I have no idea where the "right
> place"  would be.)

In addition, I would also propose a "perl -g" switch for "glob pre-processing".
For example, in UNIX platforms:

perl -e "print @ARGV" *.pl *.txt *.cpp

The OS will do globbing first then pass the list to perl.
But some platforms (such as Win32) won't.  On Windows, people have to write

perl -e "BEGIN { @ARGV = map {glob} @ARGV } print @ARGV" *.pl *.txt *.cpp

If we have "-g" option, which is a short hand for

BEGIN { @ARGV = map {glob} @ARGV }

then the orginal script can still apply

perl -ge "print @ARGV" *.pl *.txt *.cpp

thus, helps the portability of scripts on those non-UNIX platforms.
What do you think about it?
Has this problem and suggested solution also been discussed in the past?
If not, I am willing to work on it.

Thank you & best regards.
John Lin


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

Date: Mon, 8 Oct 2001 08:14:21 +1000
From: mgjv@tradingpost.com.au (Martien Verbruggen)
Subject: Re: Grafikeinbettung
Message-Id: <slrn9s1ktt.d6o.mgjv@martien.heliotrope.home>

On Sun, 07 Oct 2001 16:13:19 +0200,
	AndreasWielke <AndreasWielke@gmx.de> wrote:
> Hallo
> 
> ich will eine html seite erzeugen, auf der ein Bild ist (Barcode)
> striche. Ich hab den Eindruck bei Drucken drucken die Browser

Ask this question in a group that talks about web browsers, because
that's what it is about. Somewhere in the comp.infosystems.www.*
hierarchy would be ok, in English. If you want to post in German,
then use a group that starts with de., since they are specifically for
German language communications.

Martien
-- 
Martien Verbruggen              | 
Interactive Media Division      | For heaven's sake, don't TRY to be
Commercial Dynamics Pty. Ltd.   | cynical. It's perfectly easy to be
NSW, Australia                  | cynical.


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

Date: Sun, 07 Oct 2001 22:01:05 -0400
From: Zimmen Gnauh <yah00204052@yahoo.com>
Subject: integer division
Message-Id: <3BC108E1.736EB0CB@yahoo.com>


--------------84D573AFB25678AD0A513E80
Content-Type: text/plain; charset=us-ascii
Content-Transfer-Encoding: 7bit

  $a1=1150
  $a2=100
  $quotient=$a1/$a2
      the result is 11.50. What change has to be made to obtain 11?

--------------84D573AFB25678AD0A513E80
Content-Type: text/html; charset=us-ascii
Content-Transfer-Encoding: 7bit

<!doctype html public "-//w3c//dtd html 4.0 transitional//en">
<html>
&nbsp; $a1=1150
<br>&nbsp; $a2=100
<br>&nbsp; $quotient=$a1/$a2
<center>the result is 11.50. What change has to be made to obtain 11?</center>
</html>

--------------84D573AFB25678AD0A513E80--



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

Date: Mon, 08 Oct 2001 02:41:14 -0000
From: eric+u@taedium.com
Subject: Re: integer division
Message-Id: <ts24iaavkeeg5b@corp.supernews.com>

Zimmen Gnauh <yah00204052@yahoo.com> wrote:
>   $a1=1150
>   $a2=100
>   $quotient=$a1/$a2
>       the result is 11.50. What change has to be made to obtain 11?
>

If you want to use integer arithmatic everywhere, the easiest thing to
do is to 'use integer' (see the integer perldoc).  Otherwise, you
can use the int() function (perldoc -f int).

[cc'd]

-- 
Eric Wong
eric+pgp@taedium.com                        http://www.taedium.com/pgp.txt


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

Date: Sun, 07 Oct 2001 23:29:58 -0400
From: Benjamin Goldberg <goldbb2@earthlink.net>
Subject: Re: integer division
Message-Id: <3BC11DB6.BBBCCD92@earthlink.net>

Zimmen Gnauh wrote:
> 
>   $a1=1150
>   $a2=100
>   $quotient=$a1/$a2
>      the result is 11.50. What change has to be made to obtain 11?

Either add "use integer;" before the calculation, or truncate it
afterwards, using the "int" operator.  Or use sprintf.

-- 
    "Just how stupid are you Kuno?"
    "Verily, Tatewaki Kuno knows no limits."


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

Date: 7 Oct 2001 22:13:12 GMT
From: fxn@retemail.es (F. Xavier Noria)
Subject: Re: join two hashrefs
Message-Id: <9pqk1o$5ispv5@news1s.iddeo2.es>

On Sun, 07 Oct 2001 23:47:32 +0200, Jens Luedicke <jens@irs-net.com> wrote:

: can I join two hashrefs like:
: 
: $one = {};
: $two = {};
: $one->{'test1'} = "bla1";
: $two->{'test2'} = "bla2";
:
: $one .= $two

For instance like this

    %$one = (%$one, %$two);

or like this

    while (my ($key, $value) = each %$two) {
        $one->{$key} = $value;
    }

I suppose the second one is more efficient, but I am not sure.

-- fxn


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

Date: Sun, 07 Oct 2001 23:17:17 -0400
From: Benjamin Goldberg <goldbb2@earthlink.net>
Subject: Re: join two hashrefs
Message-Id: <3BC11ABD.5E245DC3@earthlink.net>

Jens Luedicke wrote:
> 
> hi ...
> 
> can I join two hashrefs like:
> 
> $one = {};
> $two = {};
> $one->{'test1'} = "bla1";
> $two->{'test2'} = "bla2";
> 
> $one .= $two

You want something like:
    @$one{keys %$two} = values %$two;
or:
    $one->{$_} = $two->{$_} for keys %$two;
or:
    $one->{$_} = $two->{$_} if !exists $one->{$_} for keys %$two;
or:
    $one->{$_} = $two->{$_} while defined $_ = each %$two;
or:
    $one->{$_} = $two->{$_} if !exists $one->{$_}
        while defined $_ = each %$two;
or ..... TIMTOWTDI
NB: none of these are tested.

-- 
    "Just how stupid are you Kuno?"
    "Verily, Tatewaki Kuno knows no limits."


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

Date: 7 Oct 2001 23:48:13 -0700
From: tadermann@hotmail.com (Tony)
Subject: pattern matching
Message-Id: <6db8eeaf.0110072248.5a91700@posting.google.com>

Hi All,

Need a little nudge in the right direction please (NEWBIE). I am
trying to build a list of groups that a user is a member of, however
the bright sparks have logins like fred,fred1,fred2 etc so if I use

if ($memberList =~ /$LoginId/)

and I'm lookin for fred, and fred is not a member of group test, but
fred1 is then I end up with fred listed as being in test group.

Any suggestions would be appreciated, and yes I have read FAQ's and
look through the list but need a little prompting in the right
direction.

Thanks,
Tony


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

Date: Mon, 08 Oct 2001 16:32:55 GMT
From: linderd@ses.curtin.edu.au (Doug)
Subject: Re: Perl 5.6.0 chmod bug?
Message-Id: <3bc1d249.388248@news.m.iinet.net.au>

On Sun, 07 Oct 2001 12:37:23 GMT, mjd@plover.com (Mark Jason Dominus)
wrote:

Back again. :P
Woa. Lots of posts. Ok...

<...Much reading...>

 ...! Ahhhhhhhhhh! Many thanks! I understand.
I was confused; I was (mistakenly) under the impression the numeric
value 0700 was exactly the same as 700; not that it was an octal
value. 

Hence, If I had a string "0700" and wanted to interpret it as an octal
value it would be oct("0700") which is equivalent of 0700, not "0700"
+ 0; which is 700.

The thing which got me is I was actually doing:

$p1 = 700;
$p2 = "700" + 0;

p1 must be equivalent of p2 at this point. However, I was thinking
that it was -also- equivlant to $p3 = 0700; which it isn't.

You can see the obvious problem here:

Using $p3 as a permission to chmod works. Using $p2 and $p1 doesn't.
But if $p1 equiv $p2 equiv $p3... ? Weird inconsistancy. 

>That would be a much bigger pain in the ass than making people write
>oct() in the chmod()'s once in a while.

 ...yeah. I see what you mean.

>Well, that was a lot of yak, but I hope some of it was helpful.

No no. My thanks. That greatly clarified things for me.
:)

Ciao,
Doug.


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

Date: Mon, 08 Oct 2001 16:33:47 GMT
From: linderd@ses.curtin.edu.au (Doug)
Subject: Re: Perl 5.6.0 chmod bug?
Message-Id: <3bc1d54d.1160281@news.m.iinet.net.au>

On Sun, 7 Oct 2001 21:40:33 +1000, mgjv@tradingpost.com.au (Martien
Verbruggen) wrote:

>What about doing an actual oct("0700") to get the correct integer?

Yes, that works. Thanks. :)
ciao,
Doug.


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

Date: Mon, 08 Oct 2001 01:53:50 GMT
From: "What A Man !" <whataman@home.com>
Subject: Stop Transversal of a Directory... the dot dot problem
Message-Id: <3BC10741.44644D5C@home.com>

How can I stop directory transversal with perl? I want to list all of my
files and directories off of a sub-directory named "wkdir". and delete
any files or directories that begin with ".." or "~" (since the shell
can expand a "~"). The purpose is to stop people from writing in my main
directory or other directories; and only allow them to write in "wkdir".
This is running on a FreeBSD server.

After an extensive search of Google, here is what I have. I am doing
(print "$filename") first to see what I get in $filename. Later I will
change (print "$filename") to unlink "$filename"; but print "$filename"
is not working below as intended. It lists "." files such as .htaccess.,
and subdirectories that don't even match my regex. Why?

use File::Find;
sub eachFile {
  $filename = $_;
  $fullpath = $File::Find::name;
# remember that File::Find changes your CWD, 
#so you can call open with just $_
if ($filename =~ "~|.." ) { print "$filename <BR>\n"; }
}
find (\&eachFile, "wkdir/");

Kind Regards,
--Dennis


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

Date: Mon, 08 Oct 2001 03:06:44 GMT
From: Dave Tweed <dtweed@acm.org>
Subject: Re: Stop Transversal of a Directory... the dot dot problem
Message-Id: <3BC116EB.E52C5D7A@acm.org>

"What A Man !" (Dennis) wrote:
> if ($filename =~ "~|.." ) { print "$filename <BR>\n"; }

First of all, "~|.." isn't a regex, it's just a string. I'm not even
sure what the binding operator =~ does with a string, but it's probably
always returning a true value, and so everything gets printed.

Second of all, "." is a special character in a regex, so you need to
escape it.

Thirdly, you probably want to anchor the regex so that it only works
at the beginning of the $filename.

Try this:

    if ($filename =~ /^~|\.\./) {print "$filename<br>\n";}

Finally, you don't really want to unlink ".." even if you do find it.

Also, think about the difference between a filename starting with "~",
and a shell argument starting with "~". Two different things altogether.

-- Dave Tweed


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

Date: Sun, 07 Oct 2001 23:28:43 -0400
From: Benjamin Goldberg <goldbb2@earthlink.net>
Subject: Re: Stop Transversal of a Directory... the dot dot problem
Message-Id: <3BC11D6B.641D7DA3@earthlink.net>

What A Man ! wrote:
> 
> How can I stop directory transversal with perl? I want to list all of
> my files and directories off of a sub-directory named "wkdir".

find sub { print $_, "\n" }, "wkdir";

> and delete any files or directories that begin with ".." or "~" (since
> the shell can expand a "~").

use File::Path;
find sub {
  return unless /^\.\..+|^~/s;
  if( -d ) {
    rmtree( [$_], 1, 1 );
  } else {
    print "Unlinking file '$_'.\n";
    unlink $_ warn $!;
  }
}


> The purpose is to stop people from writing in my main directory or
> other directories;

Removing files will not prevent them from writing in your main
directory.  Only setting permissions properly will.

> and only allow them to write in "wkdir". This is running on a FreeBSD
> server.

You should set permissions on your main directory such that people won't
be able to write in it, and permissions on wkdir so they can.

Removing files after the fact will not solve any security problem you
might have.
 
> After an extensive search of Google, here is what I have. I am doing
> (print "$filename") first to see what I get in $filename. Later I will
> change (print "$filename") to unlink "$filename"; but print
> "$filename" is not working below as intended. It lists "." files such
> as .htaccess., and subdirectories that don't even match my regex. Why?
> 
> use File::Find;
> sub eachFile {
>   $filename = $_;
>   $fullpath = $File::Find::name;
> # remember that File::Find changes your CWD,
> #so you can call open with just $_
> if ($filename =~ "~|.." ) { print "$filename <BR>\n"; }

The character . is special inside a regex.  It means any character
except newline.  To make it match a literal .., you need to write it as
\.\.  Also, your regex is not anchored -- even supposing ".." were
properly escaped, the ~ part will match things like foo~bar.

> }
> find (\&eachFile, "wkdir/");

-- 
    "Just how stupid are you Kuno?"
    "Verily, Tatewaki Kuno knows no limits."


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

Date: Mon, 08 Oct 2001 03:36:20 GMT
From: "What A Man !" <whataman@home.com>
Subject: Re: Stop Transversal of a Directory... the dot dot problem
Message-Id: <3BC11F47.E623B809@home.com>

Dave Tweed wrote:
> 
> "What A Man !" (Dennis) wrote:
> > if ($filename =~ "~|.." ) { print "$filename <BR>\n"; }
> 
> First of all, "~|.." isn't a regex, it's just a string. I'm not even
> sure what the binding operator =~ does with a string, but it's probably
> always returning a true value, and so everything gets printed.
> 
> Second of all, "." is a special character in a regex, so you need to
> escape it.
> 
> Thirdly, you probably want to anchor the regex so that it only works
> at the beginning of the $filename.
> 
> Try this:
> 
>     if ($filename =~ /^~|\.\./) {print "$filename<br>\n";}
> 
> Finally, you don't really want to unlink ".." even if you do find it.
> 
> Also, think about the difference between a filename starting with "~",
> and a shell argument starting with "~". Two different things altogether.
> 
> -- Dave Tweed


Thanks Dave, I realized right after I posted that it was a string, not a
regex. You're other suggestions were also helpful. I'm mostly using this
method to to stop directory transversing while using GNU UnZip and Tar
(a known security hole for Unzip and Tar), though it will come in handy
for other things too. Anyhow, the below appears to work to block out any
files with ".", "..", or "~". I wasn't sure what you meant about the
differences between "~" in the shell, so I escaped one "~" hoping that
will take care of it.

use File::Find;
sub eachFile {
$par = FH, ".";
 $filename = $_;
  $fullpath = $File::Find::name;
# remember that File::Find changes your CWD, 
#so you can call open with just $_

unless ($filename =~ /^~|\~|\.|\.\./) {unlink "$filename<br>\n";}

}
find (\&eachFile, "wkdir/");


Thanks a bunch!
--Dennis


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

Date: Mon, 08 Oct 2001 05:00:47 GMT
From: Dave Tweed <dtweed@acm.org>
Subject: Re: Stop Transversal of a Directory... the dot dot problem
Message-Id: <3BC131A8.52B3BE72@acm.org>

"What A Man !" (Dennis) wrote:
> I wasn't sure what you meant about the
> differences between "~" in the shell, so I escaped one "~" hoping that
> will take care of it.

What I meant was, if you type "~user/" or "~/" in most shells, it gets
substituted with the home directory of a particular user, but if you have
a filename that actually starts with a "~" it doesn't have that special
meaning. The latter is what File::Find is going to give you.

> unless ($filename =~ /^~|\~|\.|\.\./) {unlink "$filename<br>\n";}

With the extra stuff in there ("<br>\n"), unlink isn't going to be very
successful. And you should check for success in any case.

Overall, it looks like you are letting people do pretty much anything
in your directory, and then planning on having this script clean up
after them. With the fragment of HTML in there, it also looks like this
is some sort of Web interface. I think you need to think the whole thing
through a little more carefully before you deploy it.

-- Dave Tweed


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

Date: Mon, 08 Oct 2001 01:26:00 -0400
From: Benjamin Goldberg <goldbb2@earthlink.net>
Subject: Re: Stop Transversal of a Directory... the dot dot problem
Message-Id: <3BC138E8.D7755D59@earthlink.net>

What A Man ! wrote:
[snip]
> Thanks Dave, I realized right after I posted that it was a string, not
> a regex. You're other suggestions were also helpful. I'm mostly using
> this method to to stop directory transversing while using GNU UnZip
> and Tar (a known security hole for Unzip and Tar), though it will come
> in handy for other things too.

If this is the case, then what you want is *not* to go through the
directory after unzipping.  You want ask the archive for a list of files
in it, filter that list for whatever criteria you have, and then extract
from the archive those files which remain in your list after filtering.

If you unzip first, then the user's files will end up going wherever
[including to your home directory, possibly], and only those files whose
names were 'ok' will end up in wkdir... the 'bad' ones will escape!

> Anyhow, the below appears to work to block out any
> files with ".", "..", or "~". I wasn't sure what you meant about the
> differences between "~" in the shell, so I escaped one "~" hoping that
> will take care of it.

It is perfectly possible to have a file named "./wkdir/~foobar" ...
escaping ~ is not the solution you want.

Anyway, since checking the directory contents *after* you have unzipped
leaves a security hole in place, consider the following code instead:

#!/usr/local/bin/perl -w
use strict;
use Archive::Zip ();
use Carp ();
Archive::Zip::setErrorHandler( \&Carp::croak );
my $zip = Archive::Zip->new($ARGV[0]);
print "Zip file $ARGV[0] has comment:\n" .
    $zip->zipfileComment . "\n" if $zip->zipfileComment;
foreach my $member ($zip->members) {
    local $_ = my $name = $member->fileName;
    if( tr[~/][] || m[^\.\./] || m[/\.\./] ) {
        warn "Member '$_' has cooties.  Skipping it.\n";
        next;
    }
    print "Zip file member $name has comment:\n" .
        $member->fileComment . "\n" if $member->fileComment;
    print "Extracting '$name' to 'wkdir/$name'\n";
    $member->extractToFileNamed( "wkdir/$name" );
}
__END__

-- 
    "Just how stupid are you Kuno?"
    "Verily, Tatewaki Kuno knows no limits."


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

Date: Sun, 07 Oct 2001 23:45:32 GMT
From: Dave Tweed <dtweed@acm.org>
Subject: Re: time transformation
Message-Id: <3BC0E7C4.876EB592@acm.org>

Tim Hammerquist wrote:
> I tested this with the times the OP posted originally, but it occurred
> to me while driving last night that this would break on if AM/PM were
> stated in caps.  Try:
> 
> if ($time =~ /^(1?\d):([0-5]\d)([ap])m$/i) {
>     ($h, $m) = ($1, $2);
>     $h += 12 if lc $3 eq 'p' and $h < 12;
>     $time = sprintf "%02d:%02d", $h, $m;
> }

You still have the problem that 12:xx am or pm both map to 12:xx in 
24-hour notation.

-- Dave Tweed


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

Date: Mon, 08 Oct 2001 00:31:35 GMT
From: Bob Walton <bwalton@rochester.rr.com>
Subject: Re: time transformation
Message-Id: <3BC0F42F.9A46BD16@rochester.rr.com>

Zimmen Gnauh wrote:
> 
>     What's the simplest way to tranform 12 hour format time into 24 hour
> format, i.e.
>            9:20am   ->9:20
>          12:30pm   ->12:30
>            4:30pm  ->16:30

Try:

use Date::Manip;
$ENV{TZ}='EDT';
while(1){
   print "Enter a time: ";
   chomp($t=<STDIN>);
   last unless $t;
   $d=ParseDateString($t);
   print UnixDate($d,"%H:%M\n");
}

-- 
Bob Walton


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

Date: Mon, 08 Oct 2001 05:07:49 GMT
From: tim@vegeta.ath.cx (Tim Hammerquist)
Subject: Re: time transformation
Message-Id: <slrn9s2dvq.m06.tim@vegeta.ath.cx>

Me parece que Dave Tweed <dtweed@acm.org> dijo:
> Tim Hammerquist wrote:
> > I tested this with the times the OP posted originally, but it occurred
> > to me while driving last night that this would break on if AM/PM were
> > stated in caps.  Try:
> > 
> > if ($time =~ /^(1?\d):([0-5]\d)([ap])m$/i) {
> >     ($h, $m) = ($1, $2);
> >     $h += 12 if lc $3 eq 'p' and $h < 12;
> >     $time = sprintf "%02d:%02d", $h, $m;
> > }
> 
> You still have the problem that 12:xx am or pm both map to 12:xx in 
> 24-hour notation.
> 
> -- Dave Tweed

Thanks. Missed that.

-- 
In 1750 Issac Newton became discouraged when he fell up a flight of stairs.


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

Date: Mon, 08 Oct 2001 02:49:33 -0000
From: blah@blah.blah.invalid
Subject: Re: unix comm perl style
Message-Id: <ts251tr5d685f7@corp.supernews.com>

vbrammer <vbrammer@home.com> wrote:
> hi,
> 
> Im trying to do with perl what the unix comm command can do.
[ cut ]

You might check out mjd's effort for the defunct(?) perl power tools
project:
  http://language.perl.com/ppt/src/comm/comm.mjd

[cc'd]
-- 
Eric Wong
eric+pgp@taedium.com                        http://www.taedium.com/pgp.txt


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

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


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