[18318] in Perl-Users-Digest

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

Perl-Users Digest, Issue: 486 Volume: 10

daemon@ATHENA.MIT.EDU (Perl-Users Digest)
Wed Mar 14 11:05:51 2001

Date: Wed, 14 Mar 2001 08:05:16 -0800 (PST)
From: Perl-Users Digest <Perl-Users-Request@ruby.OCE.ORST.EDU>
To: Perl-Users@ruby.OCE.ORST.EDU (Perl-Users Digest)
Message-Id: <984585915-v10-i486@ruby.oce.orst.edu>
Content-Type: text

Perl-Users Digest           Wed, 14 Mar 2001     Volume: 10 Number: 486

Today's topics:
    Re: Formatting HTML using Perl <mm@are.ltd.uk>
    Re: Help to Install Perl (Bob Dilworth)
        Is there a shorter way for this? (Zeljko Vrba)
    Re: Is there a shorter way for this? (Randal L. Schwartz)
    Re: Is there a shorter way for this? (Anno Siegel)
    Re: Is there a shorter way for this? (Zeljko Vrba)
    Re: Is there a shorter way for this? (Anno Siegel)
    Re: Is there a shorter way for this? (Zeljko Vrba)
    Re: Is there a shorter way for this? (Glyndwr)
    Re: Is there a shorter way for this? (Randal L. Schwartz)
        JUMPING <Waarddebon@chello.nl>
    Re: JUMPING <shanem@ll.mit.edu>
        LWP and HTTP Cookies <dsagnell@junglesoft.com>
    Re: recursive subroutine call (Abigail)
    Re: recursive subroutine call <decio.clix.@clix.pt>
    Re: recursive subroutine call <decio.clix.@clix.pt>
        Sorting multiple fields in a file. <mflaherty2@earthlink.net>
        Unix trap command in Perl on Win? <dlheim@collins.rockwell.com>
        want better way to extract file name from full path fil dsedrich@yahoo.com
    Re: want better way to extract file name from full path (Anno Siegel)
    Re: want better way to extract file name from full path <peter.s@tjgroup.dk>
    Re: want better way to extract file name from full path <peter.s@tjgroup.dk>
    Re: want better way to extract file name from full path <thunderbear@bigfoot.com>
    Re: want create `my' arrays whose names are stored in a (Walter Tautz [MFCF])
        Digest Administrivia (Last modified: 16 Sep 99) (Perl-Users-Digest Admin)

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

Date: Wed, 14 Mar 2001 12:12:59 +0000
From: Mark Mitchell <mm@are.ltd.uk>
Subject: Re: Formatting HTML using Perl
Message-Id: <3AAF604B.25ABD7F1@are.ltd.uk>

This is a multi-part message in MIME format.
--------------78A02267B800A6EB5FACBCA1
Content-Type: text/plain; charset=us-ascii
Content-Transfer-Encoding: 7bit

Why not use a cascading style sheet?

Nuet Lareton wrote:

> Hi! I'm somewhat new to perl and I'm a little lost on something I
> wanted to do. I want to format all the HTML documents in a folder the
> same way. Mostly for neatness and to creat a template file. I've
> already stripped out most of the beginning whitespace between the tags
> using AWK, but I was thinking of doing something more with perl.
> Here is something like a what I have
> <HTML>
> <Head>
> <script></scrip>
> </head>
> <body>
> <tag><Tagswithintags></tagswithintags></tag>
> <Tag tagname="name"></tag>
> </body>
> </html>
> and I want to format it so that it looks like this:
> <HTML>
>   <HEAD>
>     <SCRIPT>
>     </SCRIPT>
>   </HEAD>
>   <BODY>
>     <TAG>
>     </TAG>
>     <TAG>
>       <TAGSWITHINTAGS>
>       </TAGSWITHINTAGS>
>     </TAG>
>     <TAG TAGNAME="name">
>     </TAG>
>   </BODY>
> </HTML>
>
> In other words I want to strip out all of the text within the document
> so I can see just the tags formatted with a variable spacing like
> $space="  "; or $space="\t"; and that every time it finds a tag that
> doesn't match the one found /<([^>]*)>/ != $prevmatch then it would
> recursively go into a new subroutine and keep going until it matched
> up and so on and so forth till it matched HTML.
>
> I thought about it and said, "heh... someone must have already made
> this." I then did a quick look at HTMLTree and was unable to get it to
> work print $a->as_html; only gave me <HTML></HTML>
>
> I tried working with it and am a bit lost. Like I said, I'm somewhat
> new to perl so I'm unsure as to whether or not I even used HTMLTree
> correctly.
>
> Should I just make the recursive proggy I started on or is there a
> module that will do what I am looking for?
>
> Thanks guys.
> Nuety

--
__________________________________________________________________________

A.R.E. Limited              Tel: 01252 711777
East Street                 Fax: 01252 723918
Farnham                     Email: mailto:sales@are.ltd.uk
Surrey    GU9 7XU           WWW: http://www.are.ltd.uk

Distributors of Quality Automotive Parts and Accessories

The views expressed herein are those of the author of this document and do
not necessarily represent the views of this company.This transmission may
be confidential, if you are not the intended recipient you should notify
us.


--------------78A02267B800A6EB5FACBCA1
Content-Type: text/x-vcard; charset=us-ascii;
 name="mm.vcf"
Content-Transfer-Encoding: 7bit
Content-Description: Card for Mark Mitchell
Content-Disposition: attachment;
 filename="mm.vcf"

begin:vcard 
n:Mitchell;Mark
tel;fax:01252 723918
tel;work:01252 711777 Ext:228
x-mozilla-html:TRUE
url:http://www.are.ltd.uk
org:A.R.E. Limited;Purchasing
adr:;;East Street;Farnham;Surrey;GU12 6LX;UK
version:2.1
email;internet:mark.mitchell@are.ltd.uk
title:IT Co-ordinator
fn:Mark Mitchell
end:vcard

--------------78A02267B800A6EB5FACBCA1--



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

Date: Wed, 14 Mar 2001 14:12:20 GMT
From: avast@hortonsbay.com (Bob Dilworth)
Subject: Re: Help to Install Perl
Message-Id: <3aaf7aec.2656518@news.mco.edu>

On 13 Mar 2001 19:00:50 GMT, "Scott R. Godin"
<webmaster@webdragon.munge.net> wrote:

>Personally I think neither of you has a clue as to the actual tone and 
>spirit and intent of the reply I made. Oh well. Smoke another one, it 
>might help... :)

I assume you mean the tone and spirit of ridicule over something as
innane and innocuous as violating the clpm Taliban's Jeopardy Posting
rule?  When in Afghanistan .... etc., etc.

Bob D.


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

Date: 14 Mar 2001 13:54:03 GMT
From: zvrba@inje.iskon.hr (Zeljko Vrba)
Subject: Is there a shorter way for this?
Message-Id: <slrn9autvq.o0u.zvrba@inje.iskon.hr>

Is there a shorter way to write this expression:

@data = ($time, $1, $2, $3, $4, $5, $6, $7, $8, $9, $10, $11, $12, $13, $14,
$15, $16, $17, $18, $19, $20, $21, $22, $23, $24, $25, $26, $27, $28, $29, $30,
$31, $32);

$1 .. $32 result from parsing a regexp.. It can be really tedious to list all
needed regexp variables.



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

Date: 14 Mar 2001 06:22:55 -0800
From: merlyn@stonehenge.com (Randal L. Schwartz)
Subject: Re: Is there a shorter way for this?
Message-Id: <m1snkgl9a8.fsf@halfdome.holdit.com>

>>>>> "Zeljko" == Zeljko Vrba <zvrba@inje.iskon.hr> writes:

Zeljko> Is there a shorter way to write this expression:
Zeljko> @data = ($time, $1, $2, $3, $4, $5, $6, $7, $8, $9, $10, $11, $12, $13, $14,
Zeljko> $15, $16, $17, $18, $19, $20, $21, $22, $23, $24, $25, $26, $27, $28, $29, $30,
Zeljko> $31, $32);


@data = ($time, /() () () () put your match here () () ()/);

But any regex match that has 32 paren-pairs is suspect.  Are you sure
you wouldn't rather split(), or perhaps use a //g match in a list
context?

-- 
Randal L. Schwartz - Stonehenge Consulting Services, Inc. - +1 503 777 0095
<merlyn@stonehenge.com> <URL:http://www.stonehenge.com/merlyn/>
Perl/Unix/security consulting, Technical writing, Comedy, etc. etc.
See PerlTraining.Stonehenge.com for onsite and open-enrollment Perl training!


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

Date: 14 Mar 2001 14:43:16 GMT
From: anno4000@lublin.zrz.tu-berlin.de (Anno Siegel)
Subject: Re: Is there a shorter way for this?
Message-Id: <98o024$61s$1@mamenchi.zrz.TU-Berlin.DE>

According to Zeljko Vrba <zvrba@inje.iskon.hr>:
> Is there a shorter way to write this expression:
> 
> @data = ($time, $1, $2, $3, $4, $5, $6, $7, $8, $9, $10, $11, $12, $13, $14,
> $15, $16, $17, $18, $19, $20, $21, $22, $23, $24, $25, $26, $27, $28, $29, $30,
> $31, $32);
> 
> $1 .. $32 result from parsing a regexp.. It can be really tedious to list all
> needed regexp variables.

Well, a shorter expression wouldn't be this expression, would it.

You can probably achieve the same effect by assigning the match directly
to @data.  A match in list context returns the array of captured bits
of string.  Since you don't show the matching code, I can only hint at
how to do it.  For simplicity assuming your string in $_, you could do

  @data = m/<pattern with 32 parens>/;
  unshift $time, @data;

or even

  @data = ( $time, m/<pattern with 32 parens>/);

Somehow I don't like to think about what <pattern with 32 parens> might
look like.  Perhaps a variant of split can simplify the job.  It's
hard to say, since the relevant part of your code is missing.

Anno


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

Date: 14 Mar 2001 14:46:46 GMT
From: zvrba@inje.iskon.hr (Zeljko Vrba)
Subject: Re: Is there a shorter way for this?
Message-Id: <slrn9av12m.j87.zvrba@inje.iskon.hr>

On 14 Mar 2001 06:22:55 -0800, Randal L. Schwartz <merlyn@stonehenge.com> wrote:
> >>>>> "Zeljko" == Zeljko Vrba <zvrba@inje.iskon.hr> writes:
> 
> @data = ($time, /() () () () put your match here () () ()/);
> 
> But any regex match that has 32 paren-pairs is suspect.  Are you sure
> you wouldn't rather split(), or perhaps use a //g match in a list
> context?
> 
Yes I am. I'm using that regexp for parsing log files. Although individual
entries are separated by comma, the entries themselves have highly irregular
structure and need parsing by regexp... 

Anyway, someone suggested using eval:

for(my $i = 1; $i <= 32; $i++) { eval 'push(@data, ' . '$' . "$i);"; }

and it works fine.



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

Date: 14 Mar 2001 15:09:48 GMT
From: anno4000@lublin.zrz.tu-berlin.de (Anno Siegel)
Subject: Re: Is there a shorter way for this?
Message-Id: <98o1js$72f$1@mamenchi.zrz.TU-Berlin.DE>

According to Zeljko Vrba <zvrba@inje.iskon.hr>:
> On 14 Mar 2001 06:22:55 -0800, Randal L. Schwartz <merlyn@stonehenge.com> wrote:
> > >>>>> "Zeljko" == Zeljko Vrba <zvrba@inje.iskon.hr> writes:
> > 
> > @data = ($time, /() () () () put your match here () () ()/);
> > 
> > But any regex match that has 32 paren-pairs is suspect.  Are you sure
> > you wouldn't rather split(), or perhaps use a //g match in a list
> > context?
> > 
> Yes I am. I'm using that regexp for parsing log files. Although individual
> entries are separated by comma, the entries themselves have highly irregular
> structure and need parsing by regexp... 
> 
> Anyway, someone suggested using eval:
> 
> for(my $i = 1; $i <= 32; $i++) { eval 'push(@data, ' . '$' . "$i);"; }

Ugh.  That's bound to be pretty inefficient, which may or may not
be a reason not to use it.  It's also ugly as hell, with which one
may or may not agree.

Why don't you use the match in list context, as Randal and myself
suggested?

Anno


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

Date: 14 Mar 2001 14:59:52 GMT
From: zvrba@inje.iskon.hr (Zeljko Vrba)
Subject: Re: Is there a shorter way for this?
Message-Id: <slrn9av1r8.p8d.zvrba@inje.iskon.hr>

On 14 Mar 2001 14:43:16 GMT, Anno Siegel wrote:
> 
> Somehow I don't like to think about what <pattern with 32 parens> might
> look like.  Perhaps a variant of split can simplify the job.  It's
> hard to say, since the relevant part of your code is missing.
> 
Well, you asked for it :)

        if(m<CALLRECORD-3-MICA_TERSE_CALL_REC: DS0 slot/contr/chan=(\d+)/(\d+)/(
\d+), slot/port=(\d+)/(\d+), call_id=([0-9A-F]+), userid=(.+?), ip=(.+?), callin
g=(\d+), called=(\d+), std=(.+?), prot=(.+?), comp=(.+?), init-rx/tx b-rate=(\d+
)/(\d+), finl-rx/tx b-rate=(\d+)/(\d+), rbs=(\d+), d-pad=(.+?), retr=(\d+), sq=(
\d+), snr=(\d+), rx/tx chars=(\d+)/(\d+), p/w info=(.+?), rx/tx ec=(\d+)/(\d+), 
bad=(\d+), time=(\d+), finl-state=(.+?), disc\(radius\)=(.+?), disc\(modem\)=(.+
)$>)

I'm parsing syslog from access server and inserting it into database.



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

Date: Wed, 14 Mar 2001 15:25:49 GMT
From: glynFOOdwr@FSCKdeleteEmeD.co.uk (Glyndwr)
Subject: Re: Is there a shorter way for this?
Message-Id: <slrn9av3cd.173.glynFOOdwr@glyndwr.dyndns.org>

On 14 Mar 2001 14:59:52 GMT, Zeljko Vrba scribbled:
>Well, you asked for it :)
>
>        if(m<CALLRECORD-3-MICA_TERSE_CALL_REC: DS0 slot/contr/chan=(\d+)/(\d+)/(
>\d+), slot/port=(\d+)/(\d+), call_id=([0-9A-F]+), userid=(.+?), ip=(.+?), callin
>g=(\d+), called=(\d+), std=(.+?), prot=(.+?), comp=(.+?), init-rx/tx b-rate=(\d+
>)/(\d+), finl-rx/tx b-rate=(\d+)/(\d+), rbs=(\d+), d-pad=(.+?), retr=(\d+), sq=(
>\d+), snr=(\d+), rx/tx chars=(\d+)/(\d+), p/w info=(.+?), rx/tx ec=(\d+)/(\d+), 
>bad=(\d+), time=(\d+), finl-state=(.+?), disc\(radius\)=(.+?), disc\(modem\)=(.+
>)$>)

Uurgh.

Still, that looks to me like comma-seperated name=value pairs. Can't you
do something like:

  my @output;
  my @foo = split (/,/,$data);
  foreach (@foo) {
    next unless (/[\w\/ -]+=(.*)/);
    push @output,$1;
  }
  
DISCLAIMER: untested code, I'm just trying to suggest a strategy, not a
solution ;o) If any gurus want to rip this to shreds I promise to pay
attention and learn from my mistakes!

In particular, the character class in the m// probably needs a few extra
characters adding, as I probably missed some when reading your code
snippet. And of course, you might be better off using a hash, rather
than an array (generic advice, I know).

-- 
                                          -=G=-
Web: http://www.fscked.co.uk                           ICQ: 66545073


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

Date: 14 Mar 2001 07:53:34 -0800
From: merlyn@stonehenge.com (Randal L. Schwartz)
Subject: Re: Is there a shorter way for this?
Message-Id: <m1lmq8jqip.fsf@halfdome.holdit.com>

>>>>> "Zeljko" == Zeljko Vrba <zvrba@inje.iskon.hr> writes:

Zeljko> On 14 Mar 2001 14:43:16 GMT, Anno Siegel wrote:
>> 
>> Somehow I don't like to think about what <pattern with 32 parens> might
>> look like.  Perhaps a variant of split can simplify the job.  It's
>> hard to say, since the relevant part of your code is missing.
>> 
Zeljko> Well, you asked for it :)

Zeljko>         if(m<CALLRECORD-3-MICA_TERSE_CALL_REC: DS0 slot/contr/chan=(\d+)/(\d+)/(
Zeljko> \d+), slot/port=(\d+)/(\d+), call_id=([0-9A-F]+), userid=(.+?), ip=(.+?), callin
Zeljko> g=(\d+), called=(\d+), std=(.+?), prot=(.+?), comp=(.+?), init-rx/tx b-rate=(\d+
Zeljko> )/(\d+), finl-rx/tx b-rate=(\d+)/(\d+), rbs=(\d+), d-pad=(.+?), retr=(\d+), sq=(
Zeljko> \d+), snr=(\d+), rx/tx chars=(\d+)/(\d+), p/w info=(.+?), rx/tx ec=(\d+)/(\d+), 
Zeljko> bad=(\d+), time=(\d+), finl-state=(.+?), disc\(radius\)=(.+?), disc\(modem\)=(.+
Zeljko> )$>)

Zeljko> I'm parsing syslog from access server and inserting it into database.

Looks to me like

        @result = /\S+?=(\S+), /g;

gets you 90% of the way there, except you have to split apart a few of
the subentries.  Easy enough with splice.

-- 
Randal L. Schwartz - Stonehenge Consulting Services, Inc. - +1 503 777 0095
<merlyn@stonehenge.com> <URL:http://www.stonehenge.com/merlyn/>
Perl/Unix/security consulting, Technical writing, Comedy, etc. etc.
See PerlTraining.Stonehenge.com for onsite and open-enrollment Perl training!


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

Date: Wed, 14 Mar 2001 15:26:13 GMT
From: "Waarddebon" <Waarddebon@chello.nl>
Subject: JUMPING
Message-Id: <p4Mr6.2004176$%C1.26239451@Flipper>

In my script I use a check on a variable. If this variable contains a
certain value an other cgi-script must be loaded. How can I accomplish this
?

for example:
if ($xx eq '2') {
#### Load the other script ####
}




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

Date: Wed, 14 Mar 2001 10:57:37 -0500
From: Shane McDaniel <shanem@ll.mit.edu>
Subject: Re: JUMPING
Message-Id: <3AAF94F1.22603D5B@ll.mit.edu>

By load do you mean that the web browser needs to be redirected to
another CGI or that another perl script needs to be run on the server
from the current script?

Waarddebon wrote:
> 
> In my script I use a check on a variable. If this variable contains a
> certain value an other cgi-script must be loaded. How can I accomplish this
> ?
> 
> for example:
> if ($xx eq '2') {
> #### Load the other script ####
> }


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

Date: Wed, 14 Mar 2001 10:51:38 -0500
From: "D. Sagnella" <dsagnell@junglesoft.com>
Subject: LWP and HTTP Cookies
Message-Id: <3AAF9389.6567C4A5@junglesoft.com>

I have sent a request to a server
and I am sent back an html file.

From that I would like to get the Set-Cookie.
Unfortunately when I use the

$cookie_jar->extract_cookies($req)  I get the following error

Can't call method "extract_cookies" on an undefined value at test.pl
line 46.

Why do I get this error?  The value of res is defined at that point.
 is  'HTTP::Response=HASH(0x869b48)'

If I print out $res->content the contents of the file html.pl are
printed out.

Thanks
ds

The file I am calling (html.pl) is
#!/Perl/bin/perl

print "content-type:text/html\n\n";
print "Content-type: text/html\n";
print "Set-Cookie: Name=cookie.txt","\n\n";

print << "html"

<html>
  <head>
</head>
<body>

</body>
</html>


html

The Script sending the request is:

#!/Perl/bin/perl

use LWP::UserAgent;
use HTTP::Cookies;

{
  my $ctype = 'text/html';
  my $URL = "http://$MYIP//html.pl";
  &Get($URL,$ctype);
}
sub Get{
    my $url = shift;
    my $contentype=shift;

    my $ua = new LWP::UserAgent;
    $ua->agent("Mozilla/5.0");

   my $req =  new HTTP::Request POST=>"$url";
   $req->content_type("$contentype");

#create cookie jar
    my $cookie_jar=>HTTP::Cookies->new;
#get response
  $res = $ua->request($req);

  $cookie_jar->extract_cookies($res);
}
1;





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

Date: 14 Mar 2001 11:56:34 GMT
From: abigail@foad.org (Abigail)
Subject: Re: recursive subroutine call
Message-Id: <slrn9aun3i.roj.abigail@tsathoggua.rlyeh.net>

Hsien-Hsin Lee (linear@eecs.umich.edu) wrote on MMDCCLII September
MCMXCIII in <URL:news:Pine.LNX.4.10.10103140057020.12183-100000@token.eecs.umich.edu>:
!! 
!! Hi experts,
!! 
!! does perl allow recursive subroutine calls in the script ?

Yes.

!!                                                            and how ? I

By calling the sub. (How else?)

!! tried to recursively change into unix directories, but it seems my local
!! values in the subroutine are lost when it returns from recursion.

You have a bug.


Abigail
-- 
 :;$:=~s:
-:;another Perl Hacker
 :;chop
$:;$:=~y:;::d;print+Just.$:


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

Date: Wed, 14 Mar 2001 12:56:43 +0000
From: the balbord <decio.clix.@clix.pt>
Subject: Re: recursive subroutine call
Message-Id: <3AAF6A8B.7070801@clix.pt>

Hsien-Hsin Lee wrote:

> Hi experts,
> 
> does perl allow recursive subroutine calls in the script ? and how ? 

Hi, Sean.
I'm no expert but yes, Perl does allow recursive calls.

> I tried to recursively change into unix directories, but it seems my local
> values in the subroutine are lost when it returns from recursion.

It's hard to figure it out w/o seeing your code but maybe you're 
forgeting to pass
the values onto the function?
Don't know if this helps but...

Décio Quintas


######## Sample Code #######

#!/usr/bin/perl -w

use strict;

sub _fact{
  my $number = shift;
  return ($number>1)?$number * fact($number - 1):1;#here you can see the 
recursive call
}

print "Insert a number:";
my $i = <STDIN>;
chomp($i);
print $i."! = "._fact($i);



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

Date: Wed, 14 Mar 2001 14:57:05 +0000
From: the balbord <decio.clix.@clix.pt>
Subject: Re: recursive subroutine call
Message-Id: <3AAF86C1.60405@clix.pt>

Sorry.... the correct code should be: (notice I forgot '_' in the 
function call)

######## Sample Code #######

#!/usr/bin/perl -w

use strict;

sub _fact{
 my $number = shift;
return ($number>1)?$number * _fact($number - 1):1;#here you can see the  
recursive call <- where I forgot '_'
}

print "Insert a number:";
my $i = <STDIN>;
chomp($i);
print $i."! = "._fact($i);



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

Date: Wed, 14 Mar 2001 15:46:44 GMT
From: "Mike Flaherty" <mflaherty2@earthlink.net>
Subject: Sorting multiple fields in a file.
Message-Id: <EnMr6.13602$R_6.1414722@newsread2.prod.itd.earthlink.net>

I am trying to write a web front end to our script that adds users to our
systems (multiple platforms).  I have example data below.  The problem is
that I need to sort this file by 2 fields - the second (usename = XXNNNN
i.e. JB9876) and the last (training or production).

This needs to be done via perl only - no shell scripts please.  I have
attached an excerpt of some code suggested to me but it only works for 2
fields.  How can I sort data in a file that has more than 2 fields.  Any
help would be greatly appreciated since all we can seem to hire is a bunch
of drunks.

Thanks in Advance,

Mike
Westwood, MA.

***************************************

datafile.csv

Jim Beam,JB9876,jb9876,mf4350,flatts1,training
Jack Daniels,JD1234,jd1234,bg1234,flatts1,training
Johnny Walker,JW5678,jw5678,rr1234,jd7427,production
Paul Masson,PM3456,pm3456,rr5555,,jd7427,training

***************************************

use strict;

my %data;

# Read the data
while (<DATA>) {
    chomp;
    my ($value, $key) = split /\,/, $_;
    $data{$key} = $value;
}

# Print the sorted values
foreach (sort {$b <=> $a} keys %data) {
    print "$data{$_},$_\n";
}






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

Date: Wed, 14 Mar 2001 07:59:41 -0600
From: "David L. Heim" <dlheim@collins.rockwell.com>
Subject: Unix trap command in Perl on Win?
Message-Id: <3AAF794D.BA15DF42@collins.rockwell.com>

This is a multi-part message in MIME format.
--------------56251D74BC0A7C4BB1CD24E3
Content-Type: text/plain; charset=us-ascii
Content-Transfer-Encoding: 7bit

Is there a way to mimic the behavior of the Unix "trap" command in
Perl on a windows platform?

I have a Unix shell script that I use as a helper app for a web browser.
The web site sends a tar file that contains multiple cals
raster files and a binding text file that contains their names.
My Unix shell script creates a unique subdirectory in the browser's
temp directory; untars the file there; creates a temp shell script that
launches a viewer against the binding text file/cals files. 
The trap command allows me to insure that the temp dir and its contents
will be removed upon the event of a kill, interrupt, normal exit, of
the viewer application. 

echo "trap \"cd ${tmpdir}; rm -f -r ${tempdirinstance} >/dev/null 2>&1;
exit\" 0 1 2 15" >> ${viewerlaunch}
Where:
( ${tmpdir} is the browser default temp dir)
( ${tempdirinstance} is the unique dir created that contains the images
  and the binding text file)
( ${viewerlaunch} is the temporary script file that contains this 
  line and contains a line that launches the viewer.)

I have attached the entire shell script.

The challenge is to mimic this behaviour using Perl on a Windows
platform. 

Dave
-- 
=======================================================================
David L. Heim              phone:  (319)295-8616
Mechanical Design Support  page:  (319)490-0933
Rockwell Collins, Inc.     fax:  (319)295-4182 (Include M/S 106-186)
400 Collins Road NE        email:  dlheim@collins.rockwell.com
Cedar Rapids, IA 52498
M/S 106-186
=======================================================================
--------------56251D74BC0A7C4BB1CD24E3
Content-Type: text/plain; charset=us-ascii;
 name="pdmviewer"
Content-Transfer-Encoding: 7bit
Content-Disposition: inline;
 filename="pdmviewer"

#!/bin/sh
#
# Unix script to run up Viewer (SwiftView) on any Unix WorkStation
# in any Domain against the contents of a browser supplied tar file
#
# This program used as a browser helper app for PDM Doc viewing
#
# Author: Jim Sedlacek
#         David L. Heim x58616
#
# Syntax: pdmviewer $filename
# filename is a tar file and may be called anything
#
# Helper app should be set up as follows: 
#Description File        MIME        Application to Use: (Unix users)
#            Extension   Type
#--------------------------------------------------------------------------
# PDM         pdm        image/targz /usr/remote/bin/pdmviewer %s - CACD Users
# PDM         pdm        image/targz /usr/local/bin/pdmviewer %s - CCA Users
# PDM         pdm        image/targz /rfs/apps/bin/pdmviewer %s - CUE Users

thisprog=`basename $0`
numargs="$#"
prog_user=${USER}


if [ ${numargs} -ne 1 ]
 then
   echo ""
   echo " ERROR"
   echo " ${thisprog} was not called with an argument."
   echo " Helper app must be set up with argument %s"
   echo " /rfs/apps/bin/pdmviewer %s"
   echo " Please log a HelpDesk call."
   echo ""
   exit 0
fi
#
# Verify what Domain we're dealing with
#

domain=''
case `domainname` in
   cacd )
           domain='cacd'
   ;;
   cca )
           domain='cca'
   ;;
   collins )
           domain='collins'
   ;;
esac
#
# See if Domain is one that's supported
#
if [ "$domain" != "cacd" -a "$domain" != "cca" -a "$domain" != "collins" ]
 then
   echo ""
   echo " `domainname`: Unsupported Domain. Please log a HelpDesk call."
   echo ""
   exit 0
fi

#
# Verify what OS we're dealing with
#
machine=''
platform=''
case `uname -r` in
   B.10* )
           machine='hp'
   ;;
   5.* )
           machine='solaris'
   ;;
   V4* )
           machine='dec'
   ;;
esac
#
# See if OS is one that's supported
#
if [ "$machine" != "hp" -a "$machine" != "solaris" -a "$machine" != "dec" ]
then
   echo ""
   echo " `uname -sr`: Unsupported OS. Please log a HelpDesk call."
   echo ""
   exit 0
fi



tmpdir=`dirname ${1}`
#
# The browser has placed the tar file in the temp directory
# The name of the file is ${random}.cgi or anything!
#
# Determine and create a temp subdir for this instance of viewing
tempdirinstance=${tmpdir}/pdmviewer${prog_user}$$
mkdir ${tempdirinstance}

  #Copy the temp file from the browser to the new temp subdir
  #as getsht.tar - tar extension necessary for extracting archives
  #(Tried to move the file but browser tried to delete the file
  #and raised an error)
  cp ${1} ${tempdirinstance}/getsht.tar
  
  cd ${tempdirinstance}
  
  #Change permissions to revent unauthorized browseing of the document
  chmod 700 getsht.tar
  
  #Extract the contents of the tar file
  tar -xf getsht.tar
  
  #remove the tar file - no longer needed
  rm -f getsht.tar > /dev/null 2>&1



#
#   See if "bound_doc.svp" or bound_doc.pvl is in temp directory
#
bounddoc=''
if [ -r "${tempdirinstance}/bound_doc.svp" ]
then
   bounddoc=${tempdirinstance}/bound_doc.svp
elif [ -r "${tempdirinstance}/bound_doc.pvl" ]
then
   bounddoc=${tempdirinstance}/bound_doc.pvl
fi
if [ "$bounddoc" = "" ]
then
   echo ""
   echo "Unable to determine viewer preference. Please log a HelpDesk call."
   echo ""
   exit 0
fi


#
#   Determine desired viewer's location
#
viewerpath=''
if [ "$domain" = "cacd" -a "$machine" = "hp" ]
then
   if [ "$bounddoc" = "${tempdirinstance}/bound_doc.svp" ]
   then
      viewerpath=/usr/apps/aspect/HPUX_10.x/current/sview_app/client/sview.sh
   else
      viewerpath=/usr/apps/aspect/HPUX_10.x/current/sview_app/client/sview.sh
   fi
fi

if [ "$domain" = "cacd" -a "$machine" = "solaris" ]
then
   if [ "$bounddoc" = "${tempdirinstance}/bound_doc.svp" ]
   then
      viewerpath=/usr/apps/aspect/Solaris2.5/current/sview_app/client/sview.sh
   else
      viewerpath=/usr/apps/aspect/Solaris2.5/current/sview_app/client/sview.sh
   fi
fi

if [ "$domain" = "collins" -a "$machine" = "hp" ]
then
   if [ "$bounddoc" = "${tempdirinstance}/bound_doc.svp" ]
   then
      if [ -r "/usr/apps/aspect/HPUX_10.x/current/sview_app/client/sview.sh" ]
      then
         viewerpath=/usr/apps/aspect/HPUX_10.x/current/sview_app/client/sview.sh
      else
         viewerpath=/tools/aspect/current_version/sview_app/client/sview.sh
      fi
   else
      viewerpath=/usr/apps/aspect/HPUX_10.x/current/sview_app/client/sview.sh
   fi
fi

if [ "$domain" = "collins" -a "$machine" = "solaris" ]
then
  viewerpath=/tools/aspect/current_version/sview_app/client/sview.sh
fi

if [ "$domain" = "collins" -a "$machine" = "dec" ]
then
   if [ "$bounddoc" = "${tempdirinstance}/bound_doc.svp" ]
   then
      viewerpath=/tools/aspect/current_version/sview_app/client/sview.sh
   else
      viewerpath=/tools/aspect/current_version/sview_app/client/sview.sh
   fi
fi

if [ "$domain" = "cca" ]
then
   if [ "$bounddoc" = "${tempdirinstance}/bound_doc.svp" ]
   then
      viewerpath=/tools/aspect/current_version/sview_app/client/sview.sh
   else
      viewerpath=/tools/aspect/current_version/sview_app/client/sview.sh
   fi
fi

#
#Set permissions on the contents of the temporary instance sub directory
#Only the user can read the document files
chmod -R 700 ${tempdirinstance} > /dev/null 2>&1
#
#
#Create a temporary viewer launch script for this instance with unique name
viewerlaunch=${tmpdir}/pdmviewscript${prog_user}$$
touch ${viewerlaunch}

#Create the contents of the temp viewer launch script
echo "cd ${tempdirinstance}" >> ${viewerlaunch}
  #Trap command insures that the entire subtemp dir for this viewing
  #instance will be removed when viewing application is complete or 
  #interrupted or the window closed by the window manager
  #or the user killed the process with a kill -9
  #Unix Signal numbers handled by the following line:
  # 0  = exit command or normal exit
  # 1  = Session disconnected
  # 2  = Interrupt - often CTRL-c
  # 15 = From the kill command
echo "trap \"cd ${tmpdir}; rm -f -r ${tempdirinstance} >/dev/null 2>&1; exit\" 0 1 2 15" >> ${viewerlaunch}
echo "${viewerpath} ${bounddoc}" >> ${viewerlaunch}
echo " " >> ${viewerlaunch}

#Change permissions on the completed script
chmod 700 ${viewerlaunch} > /dev/null 2>&1

#Execute the temporary viewer launch script in the background to return
#control to the calling user / browser
exec ${viewerlaunch} &

#Sleep for 2 seconds - then remove the
#temporary viewer launch script that was just executed
# - not needed after launch
sleep 2
rm -f ${viewerlaunch} > /dev/null 2>&1

#This program complete.
#Control now reverts back to browser
#All temp files and the tmp sub directory will be
#removed upon interrupt or exit of the viewer application spawned
#by the temporary program that launched it

--------------56251D74BC0A7C4BB1CD24E3--



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

Date: Wed, 14 Mar 2001 11:32:34 GMT
From: dsedrich@yahoo.com
Subject: want better way to extract file name from full path file name
Message-Id: <3aaf534f.55209980@news>

I was look for a better way to get the end file name from a full-path
file name. The example below seems to work (it extracts the text
whatever.txt from a path name under many directories) but can someone
take a look at this and tell me the best way to do this? It was pretty
difficult to handle both the forward and back slash possibilities, but
there's gotta be a better way. 


#!c:/perl/bin/perl.exe

$string=q(c:/a/b/c/d/e/f/g\1\2\3\4\5\whatever.txt);
my $a,$b,$c;

foreach (split('[:]', $string)) {
$a = $_;
print "$_\n";
}

foreach (split(/\\/, $a)) {
$b=$_;
print "$_\n";
}

print "\nThe file name is: $b";


There's easy to fix bugs in the code (if there is no : or \ in the
full path file name) but that is not the point. I feel I should be
able to do it with one split command but [:\\] just doesn't seem to
work whether I surround it with single quotes or forward slashes. And
I can't seem to find enough about these expressions in my book. 

- Thanks for any help


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

Date: 14 Mar 2001 12:06:25 GMT
From: anno4000@lublin.zrz.tu-berlin.de (Anno Siegel)
Subject: Re: want better way to extract file name from full path file name
Message-Id: <98nms1$p40$1@mamenchi.zrz.TU-Berlin.DE>

According to  <dsedrich@yahoo.com>:
> I was look for a better way to get the end file name from a full-path
> file name. The example below seems to work (it extracts the text
> whatever.txt from a path name under many directories) but can someone
> take a look at this and tell me the best way to do this? It was pretty
> difficult to handle both the forward and back slash possibilities, but
> there's gotta be a better way. 

There's also ":" to consider, for MacOS.

The module File::Basename is designed to do this in a portable way.
If you just need to get the job done, use it.  If you want to see
how it's done, study it.

[code snipped]

Anno


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

Date: Wed, 14 Mar 2001 13:15:11 +0100
From: "Peter Søgaard" <peter.s@tjgroup.dk>
Subject: Re: want better way to extract file name from full path file name
Message-Id: <98nn57$mqq$1@news.inet.tele.dk>

There are probably some modules to do it...but you could also use a simpler
regexp:

$string=q(c:/a/b/c/d/e/f/g\1\2\3\4\5\whatever.txt);
$string =~ /([^\\]*?)$/;
$fileName = $1;

<dsedrich@yahoo.com> skrev i en meddelelse news:3aaf534f.55209980@news...
> I was look for a better way to get the end file name from a full-path
> file name. The example below seems to work (it extracts the text
> whatever.txt from a path name under many directories) but can someone
> take a look at this and tell me the best way to do this? It was pretty
> difficult to handle both the forward and back slash possibilities, but
> there's gotta be a better way.
>
>
> #!c:/perl/bin/perl.exe
>
> $string=q(c:/a/b/c/d/e/f/g\1\2\3\4\5\whatever.txt);
> my $a,$b,$c;
>
> foreach (split('[:]', $string)) {
> $a = $_;
> print "$_\n";
> }
>
> foreach (split(/\\/, $a)) {
> $b=$_;
> print "$_\n";
> }
>
> print "\nThe file name is: $b";
>
>
> There's easy to fix bugs in the code (if there is no : or \ in the
> full path file name) but that is not the point. I feel I should be
> able to do it with one split command but [:\\] just doesn't seem to
> work whether I surround it with single quotes or forward slashes. And
> I can't seem to find enough about these expressions in my book.
>
> - Thanks for any help




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

Date: Wed, 14 Mar 2001 13:20:25 +0100
From: "Peter Søgaard" <peter.s@tjgroup.dk>
Subject: Re: want better way to extract file name from full path file name
Message-Id: <98nnf6$nin$1@news.inet.tele.dk>

If you can have both /'s and \'s before the filename, change the regexp to:

$string =~ /([^\\\/]*?)$/;





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

Date: Wed, 14 Mar 2001 13:46:49 +0100
From: =?iso-8859-1?Q?Thorbj=F8rn?= Ravn Andersen <thunderbear@bigfoot.com>
Subject: Re: want better way to extract file name from full path file name
Message-Id: <3AAF6839.842EBC4B@bigfoot.com>

"Peter Søgaard" wrote:
> 
> There are probably some modules to do it...but you could also use a simpler
> regexp:

Don't.  

use File::BaseName;

-- 
  Thorbjørn Ravn Andersen              "...sound of...Tubular Bells!"
  http://bigfoot.com/~thunderbear


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

Date: 14 Mar 2001 13:16:34 GMT
From: wtautz@math.uwaterloo.ca (Walter Tautz [MFCF])
Subject: Re: want create `my' arrays whose names are stored in an array reference passed to my subroutine...
Message-Id: <slrn9aurpi.3hv.wtautz@pythagoras.math.uwaterloo.ca>

On 13 Mar 2001 16:39:54 GMT, Walter Tautz [MFCF] <wtautz@math.uwaterloo.ca> wrote:
|
|specifically
|foreach $attribute_name (@$print_queue_entries){# is there an easy way to my the entries of an array 
|                   if (/^$attribute=(.*)/){
|                        my $$attribute[$countprinters] = $1;  
|				   }
|is inside an if block and so I can't return it at the end of the subroutine. One way I suppose
|is to use foreach loop at the beginning of the subroutine to create the arrays whose names
|are stored in the array reference $queue_attributes but seems repetitive and wasteful...
|
|I guess to put it another way is there a way to declare a my variable in an inner block
|of  subroutine and yet have it persist for the scope of the whole subroutine...
|
|
|
Ok I believe I can solve it by declaring an array for the scope of the subroutine
and then push array references to arrays that are created in the if block... at least this way
the arrays won't be discarded by perl...indeed reading the PerlCookbook, page 339
we find...

When a lexical goes out of scope, its storage is freed unless a reference to its value's storage
space still exists

a further note is to use hashs and avoid these problems.




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

Date: 16 Sep 99 21:33:47 GMT (Last modified)
From: Perl-Users-Request@ruby.oce.orst.edu (Perl-Users-Digest Admin) 
Subject: Digest Administrivia (Last modified: 16 Sep 99)
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: The mail to news gateway, and thus the ability to submit articles
| through this service to the newsgroup, has been removed. I do not have
| time to individually vet each article to make sure that someone isn't
| abusing the service, and I no longer have any desire to waste my time
| dealing with the campus admins when some fool complains to them about an
| article that has come through the gateway instead of complaining
| to the source.

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


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