[10181] in Perl-Users-Digest

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

Perl-Users Digest, Issue: 3774 Volume: 8

daemon@ATHENA.MIT.EDU (Perl-Users Digest)
Mon Sep 21 05:07:15 1998

Date: Mon, 21 Sep 98 02:00:17 -0700
From: Perl-Users Digest <Perl-Users-Request@ruby.OCE.ORST.EDU>
To: Perl-Users@ruby.OCE.ORST.EDU (Perl-Users Digest)

Perl-Users Digest           Mon, 21 Sep 1998     Volume: 8 Number: 3774

Today's topics:
        <a href"http//www.x.com>y</a>----->perl script <webmaster@keynet.be>
    Re: CGI dave@mag-sol.com
    Re: disable inharitance from parent dow.jones@home.se
    Re: Each %HASH question (Sam Holden)
    Re: Help with perl hashes of hashes and arrays of hashe <burry@nmt.edu>
    Re: Help with perl hashes of hashes and arrays of hashe (Sam Holden)
        Help! - Perl & win95 IE 4.0. Run perls program from IE. <wpa@opens.simbir.ru>
        how do I create a new process and then exit the existin <rebelvideo@hotmail.com>
        linking libgcc.a into an XS-extension <anatol@ml.com>
    Re: Perl & Java - differences and uses <ajohnson@gpu.srv.ualberta.ca>
    Re: Perl & Java - differences and uses <antony@fabric8.nospam.com>
        regdecl <dgris@rand.dimensional.com>
    Re: Runtime evaluation of required modules <amarden@ibm.net>
    Re: Runtime evaluation of required modules (Sam Holden)
    Re: where is Date::Parse (CPAN.pm)? (Honza Pazdziora)
    Re: where is Date::Parse (CPAN.pm)? (Honza Pazdziora)
        Special: Digest Administrivia (Last modified: 12 Mar 98 (Perl-Users-Digest Admin)

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

Date: Mon, 21 Sep 1998 08:54:24 +0200
From: "webmaster" <webmaster@keynet.be>
Subject: <a href"http//www.x.com>y</a>----->perl script
Message-Id: <6u4t7r$eqa$1@news3.Belgium.EU.net>

Hello,

I want to replace the html tag <a href:"http//www.something.com">name</a>
by a perl script. This must give me the opportunity within the same script
counting how many times a certain icon is clicked on within a html page.
Thanks in advance.

webmaster@keynet.be





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

Date: Mon, 21 Sep 1998 08:34:35 GMT
From: dave@mag-sol.com
Subject: Re: CGI
Message-Id: <6u532r$7go$1@nnrp1.dejanews.com>

In article <6u3kj2$mmc$2@mendelevium.btinternet.com>,
  Jonathan Stowe <gellyfish@btinternet.com> wrote:
> On Sun, 20 Sep 1998 13:49:26 -0400 Drew Simonis - US Internet Support
<Care227@ibm.net> wrote:
> > Anyone know a good reference book for CGI programming?
>
> I have by my side here CGI Programming on the WWW by Shishir Gundavaram.
> However this now is a little old and not perl specific and has one or two
things
> in that some people here would disagree with.  I would suggest reading the
> documentation for the CGI module that comes with most recent distributions
> of Perl and probably the CGI specification available from:
>  <URL:http://hoohoo.ncsa.uiuc.edu>
>
> In the end there is no real reference book for CGI - you should find an
> implementation you like and then look at the reference for that.

I hear from O'Reilly that a new edition of Shishir's book will be out in
January. It will be renamed 'CGI Programming using Perl' because of a subtle
change in focus.

The other book I'd recommend is Lincoln Stein's 'Official Guide to Programming
With CGI.pm' which is published by Wiley. Of course the second edition of the
llama also has a chapter on CGI progrmamming.

hth,

Dave...

--
dave@mag-sol.com
London Perl M[ou]ngers: <http://www.mag-sol.com/London.pm/>

-----== Posted via Deja News, The Leader in Internet Discussion ==-----
http://www.dejanews.com/rg_mkgrp.xp   Create Your Own Free Member Forum


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

Date: Mon, 21 Sep 1998 08:42:14 GMT
From: dow.jones@home.se
Subject: Re: disable inharitance from parent
Message-Id: <6u53h5$842$1@nnrp1.dejanews.com>

In the beginning of my program I say 'use CGI;'. Later in the same program
I'm doing lots of forking. But, at that time I don't have any use of CGI.pm
anymore. I want my forks to me as small as possible. I'm not sure exactly
what happens when I say use CGI except that I can create a CGI object and use
it. What I'm worried about is that if the expression 'use CGI;' means that my
program allocates memory even if I don't create a object... In that case, all
my children will allocate the same amount of memory.. right?

// Daniel

In article <6u3dna$h7l$1@plutonium.btinternet.com>,
  Jonathan Stowe <gellyfish@btinternet.com> wrote:
> On Sun, 20 Sep 1998 14:48:24 GMT dwiesel@my-dejanews.com wrote:
> > Hi,
>
> > In my main program I do alot of forking. Each fork inharitates from the
> > parent. I don't want that. Is there anyway to 'disable' inharitance?
>
> Um, no. but you can release any resources that are not required by the
> child process - IE closing filehandles etc.  Also by clever use of
> scoping you you can limit what your child process thinks its environment is.
>
> Show us some code that doesnt work.
>
> /J\
>
> --
> Some of your questions answered:
> <URL:http://www.btinternet.com/~gellyfish/resources/wwwfaq.htm>
>

-----== Posted via Deja News, The Leader in Internet Discussion ==-----
http://www.dejanews.com/rg_mkgrp.xp   Create Your Own Free Member Forum


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

Date: 21 Sep 1998 07:03:10 GMT
From: sholden@pgrad.cs.usyd.edu.au (Sam Holden)
Subject: Re: Each %HASH question
Message-Id: <slrn70buhe.d8b.sholden@pgrad.cs.usyd.edu.au>

On Mon, 21 Sep 1998 00:30:51 +0200, Millioud Martial <alby@iprolink.ch> wrote:
>Hello,
>
>I've got some problems with this code :
>
>while(($key,$value) = each %input) {
>print "Yes" if $key eq 'True';
>print "No" if $value eq 'False';
>}
>
>We assume that $Key = 'True' and $value = 'False'
>It seems like the if doesn't work with $value. "Yes" is print but the
>"No" is not print though $value does equal 'False'. Someone could
>explain to me why ?
>Thanks for your help.

It works for me :
%input =  ( 'True' => 'False',
		'False' => 'True',
	);
while(($key,$value) = each %input) {
	print "Yes" if $key eq 'True';
	print "No\n" if $value eq 'False';
}

produces :
YesNo

So post some code that demonstrates the problem and I'll try and help... I'm 
guessing $value doesn't contain what you think it does... remember hashes can
only have 1 value for each distinct key string (ignoring references).

-- 
Sam

Even if you aren't in doubt, consider the mental welfare of the person
who has to maintain the code after you, and who will probably put parens
in the wrong place.	--Larry Wall


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

Date: Mon, 21 Sep 1998 02:17:01 -0600
From: Brent Perschbacher <burry@nmt.edu>
Subject: Re: Help with perl hashes of hashes and arrays of hashes etc
Message-Id: <Pine.SUN.3.96.980921015511.3604A-100000@rainbow>


> well, at least you spelled 'Randal' with only one 'l' 
> :-)
whoops! it's late, and my mail program doesn't have a spellchecker worth
mentioning.

> You would do better to tell us what 'error' is occuring, what you've
> tried, and importantly, a small but complete snippet of code and data
> that exhibits the actual problem.
I thought I had stated the problem, but maybe not. anyway the problem that
I am having is that I can input data into an array of hashes(or a hash of
hashes or an array of arrays), but when I go to print them(or access the
data in anyway shape or form I get nothing, absolutely nothing(I would
like to say NULL but I haven't acctually tested it. I know that the data
disappears whenever I try to put more data into the "structure"(I don't
know what perl calls it, but it is darn close to a C struct). And before
you ask yes I am changing the keys. :)

here is a version of the code that I am having problems with. this version
uses arrays of hashes, but I have tried other ways with the same results:
note, I just tried a static hash of hashes and it worked using this
method, so my dynamic declaration of this program must be broken, but I
still don't see where.

#! /usr/bin/perl

$current = 0;
getdata();
getdata();
getdata();
printdata();

sub getdata{
print "current is $current\n";

print "Please input a user name.\n";
chomp($user = <STDIN>);

print "Please input a first name.\n";
chomp($first = <STDIN>);

print "Please input a last name.\n";
chomp($last = <STDIN>);

print "Please input an age.\n";
chomp($age = <STDIN>);

print "Please input an e-mail address\n";
chomp($address = <STDIN>);


@database = ();
$database[$current]{user   } = $user;
$database[$current]{first  } = $first;
$database[$current]{last   } = $last;
$database[$current]{age    } = $age;
$database[$current]{address} = $address;
$current++;

}#end getdata

sub printdata{
 for $i (0 .. $#database){
  print "$i is i\n";
  print "User is: ${database[$i]{user}}\n";
  print "First is: ${database[$i]{first}}\n";
  print "last is: ${database[$i]{last}}\n";
  print "age is: ${database[$i]{age}}\n";
  print "address is: ${database[$i]{address}}\n";
 }
} 


any help with this will be greatly appreciated.
thanx
Brent




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

Date: 21 Sep 1998 08:49:38 GMT
From: sholden@pgrad.cs.usyd.edu.au (Sam Holden)
Subject: Re: Help with perl hashes of hashes and arrays of hashes etc
Message-Id: <slrn70c4p2.gbv.sholden@pgrad.cs.usyd.edu.au>

On Mon, 21 Sep 1998 02:17:01 -0600, Brent Perschbacher <burry@nmt.edu> wrote:

<snip>

>#! /usr/bin/perl
>
>$current = 0;
>getdata();
>getdata();
>getdata();
>printdata();
>
>sub getdata{
>print "current is $current\n";
>
>print "Please input a user name.\n";
>chomp($user = <STDIN>);
>
>print "Please input a first name.\n";
>chomp($first = <STDIN>);
>
>print "Please input a last name.\n";
>chomp($last = <STDIN>);
>
>print "Please input an age.\n";
>chomp($age = <STDIN>);
>
>print "Please input an e-mail address\n";
>chomp($address = <STDIN>);
>
>
>@database = ();
 ^^^^^^^^^^^^^^^
You are setting @database to be empty every time you try to
fill it up thus, it will only have the last user entered...


>$database[$current]{user   } = $user;
>$database[$current]{first  } = $first;
>$database[$current]{last   } = $last;
>$database[$current]{age    } = $age;
>$database[$current]{address} = $address;
>$current++;
>
>}#end getdata

-- 
Sam

People get annoyed when you try to debug them.
	--Larry Wall


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

Date: Mon, 21 Sep 1998 10:18:04 +0400
From: "wpa" <wpa@opens.simbir.ru>
Subject: Help! - Perl & win95 IE 4.0. Run perls program from IE.
Message-Id: <3605f27d.0@ns.link-ul.ru>

Hi, All!
Sorry, my english is very bad.

How working Perl in Windows 95?

I make file associate  *.pl  to perl.exe
>From Internet Explorer 4.0 run programm xxxx.pl,
Starting "Perl.exe xxxx.pl" in new window like msdos-mode,
and Perl working with  STDIN-STDOUT in this window, Perls environments
variables are zero.
May be must use DDE, but I don't know how.

---
P.W.




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

Date: Mon, 21 Sep 1998 17:42:19 +0930
From: rebel <rebelvideo@hotmail.com>
Subject: how do I create a new process and then exit the existing?
Message-Id: <36060A63.DE60D5D3@hotmail.com>

Hi

How do I call another script from my running script and then exit the
existing script, Without waiting for the other script to finish.


I want to be able to process input from a user form (wwweb), send a
response back to the user, then launch a script that does some
processing in the background which may take a little while.

It seems both exec and system effectivally sit and wait for child
process to complete, is this correct or am I misreading something??

I am trying to decrease the response times in my user form, and I have
tried setting flushing output immediately, it doesnt seem to help
response times are still slow.

So I thought I'd try taking the load off the script by starting another
script to do time consuming part of the process and e-mail my client the
results (which I do anyway).

Hope someone can help

Regards
Chris
Rebel@rebel.com.au
Rebel Software


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

Date: Mon, 21 Sep 1998 15:58:09 +0900
From: Anatol Filin <anatol@ml.com>
Subject: linking libgcc.a into an XS-extension
Message-Id: <3605F901.9B5010B@ml.com>

Hello,

I made an XS-extension from a library which happened to
reference a function defined in libgcc.a (and not in libc.a)

If I don't link libgcc.a explicitly, my program
dies on an undefined symbol.

I don't see shared version of the libgcc in my installation
either.

It works OK when full path to the libgcc.a passed to
the WriteMakefile() in Makefile.PL, but it's ugly.

Is there better way to handle this?

Thanks,
Anatol


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

Date: Mon, 21 Sep 1998 02:09:19 -0500
From: Andrew Johnson <ajohnson@gpu.srv.ualberta.ca>
Subject: Re: Perl & Java - differences and uses
Message-Id: <3605FB9F.20993FD6@gpu.srv.ualberta.ca>

George Reese wrote:
!
! Andrew Johnson wrote in message <3605CE4A.6BD6BF3C@gpu.srv.ualberta.ca>...
! >George Reese wrote:
! >!
! >[snip]
! >
! >! * In order to get quality software, you need a method of guaranteeing
! >!   results given a problem.
! >
! >do you? ...you need to be a great deal more specific if you wish your
! >sweeping statements to be taken as any kind of premise while building
! >an argument...
! 
! You have done nothing here to suggest my statement is sweeping other than
! state it is sweeping.  I probably should have used 'guaranntee' instead of
! 'get', but that is a small technical difference and not worthy of your
! blanket condemnation.

I meant a) you did not define your terms
        b) there are many methods of guaranteeing results given
           a problem, that do not result in quality software

if by 'results' you mean, as you say below, 'the production of
software' ... well, guaranteeing the production of software does
not guarantee its quality --- if by 'results' you mean the
'production of "quality" software', then your premise is merely
circular, and still is not a necessary condition for quality
software.
 
! >! * If you want to guarantee results, you need to be able to reduce a
! >!   process to a replicatable algorithm.
! >
! >do you? again, specificity is lacking here: what results? what
! >process? --- and aren't all algorithms replicable?
! 
! Results being the production of software.

if the results being guaranteed are "the production of software", what
*process* are you talking about ... I thought you were trying to make a
point about the 'process of software production' here, and that with
the statement below, you were attempting to equate (or partially
equate) the OO process of software production to an algorithmic
process ... but again, my point is that these ill-defined premises
can't hold much promise of leading to a logical conclusion.
 
! >! * OO is the closest thing to a replicatable algorithm we have in
! >!   software engineering today.
! >
! >OO is an algorithm? I thought you said it was a methodology --- do two
! >people with equal OO skill in an OO language produce the same
! >solutions to any given problem? (or might they be 'free' to choose
! >different but equally good (or bad) OO implementations of a solution
! >to a problem?) ---
! 
! No, I said it was the closest thing to an algorithm.
! 
! There is a difference.

indeed...

! >part of substrate neutrality is language neutrality...
! 
! Not in the least bit.  I challenge you to describe a piece of software to me
! in meows or Klingon.

we are talking about a piece of software are we? I thought we were
talking about properties of an algorithm --- if I knew Klingon I could
specify an algorithm, meows is no language I am familiar with, merely
an approximated english word for some sound a cat might make.
 
! >if you are calling OO an algorithm, what 'same results' can we expect?
! >everyone writes identical code? or merely that everyone writes OO code?
! 
! No, that everyone will write code that passes the proper tests for the
! system in question--i.e. does what the design prescribes.

but are they "free" to choose different implementation paths? (yes
that word again!) --- and are you implying that anyone using an OO
methodology will be guaranteed code that passes all tests 'out of the
box' or only after some debugging --- or are you making a statement
about relative debugging times?
 
! >And besides, if X is the closest thing to Y we have, this does not
! >confer upon X any of the necessary or sufficient properties of Y,
! >in particular, if Y is known to be reliable, the statement that X is
! >close to Y cannot be used to draw inferences on X's reliability ...
! >such properties of X must be demonstrated on their own.
! 
! If Y is known to be reliable and X is known to exhibit many of the
! properties that make Y reliable, it is a valid inference to say that X is
! likely to be mostly reliable.  It is certainly one worthy of testing.

indeed, it may certainly be worth testing --- if you can show that X
does exhibit many of properties of Y that make Y reliable (which
necessitates showing which properties of Y in fact make Y reliable),
and not just exhibits some or many properties of Y --- then you may
hypothesize such an inference and begin testing and searching for
limits and boundary conditions and so on ... I haven't seen such
testing yet for the "OO as the closest thing to an algorithm"
premise, nor any discussion of how OO is close to an algorithm...
 
! I screwed up in the editor.  It should have said:
! 
! "Therefore, it is the best solution for most software engineering tasks."
! 
! > none of
! >your premises or statements logically lead to your conclusion that
! >OO is 'the best solution' for anything...indeed,  they do not lead
! >(as given) to any sort of conclusion about OO whatsoever...
! 
! Yes, they do.

I still do not see properly defined premises resting on accepted
facts or at least supported by data --- and still, they do not
logically lead to such a conclusion.
 
! >! Now, if that is not a reasoned belief, I do not know what is.
! >
! >apparently so.
! 
! Nice personal attack there.

no, not nice ... a little cheap ... I apologize.

regards
andrew


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

Date: Mon, 21 Sep 1998 00:45:52 -0700
From: antony quintal <antony@fabric8.nospam.com>
Subject: Re: Perl & Java - differences and uses
Message-Id: <36060430.D71504A8@fabric8.nospam.com>

George Reese wrote:
> 
[snip]
> OO has not failed.
[snip]
> * OO is 
[snip]
> * OO does 

:)


the extremely kewl "Perl Cookbook" states [pp 447]:

"Perl's objects are not wrong; they're differently right."


anyone care to comment?

antony




-- 
   8888
 888  888   
888    888  :::::::::::::::::::::::
 888  888   http://www.fabric8.com
   8888     san francisco
 888  888   415.487.9702
888    888  :::::::::::::::::::::::
 888  888   
   8888


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

Date: Mon, 21 Sep 1998 08:05:22 GMT
From: Daniel Grisinger <dgris@rand.dimensional.com>
Subject: regdecl
Message-Id: <6u50f4$52i$1@rand.dimensional.com>

regdecl takes a regular expression (without delimiters) and
formats and comments it.

Usage-

$ regdecl 'a(?:$foosd)' '$foo'
a                   # The literal string `a' 
(?:                 # Start non-capturing group 
  $foo                # The contents of $foo 
  sd                  # The literal string `sd' 
)                   # End group 

Note the necessity to pass in your variable names as arguments.
Documentation is in pod format, pay special attention to the
Bugs and Caveats section.

Comments, criticisms, praise, flames, and patches all
cheerfully accepted :-).

dgris

#/usr/bin/perl

=pod

=head1 Name

regdecl

=head1 Synopsis

$ regdecl regular_expression [variables]

=head1 Description

regdecl takes a regular expression and a list of variable
names as input and produces a commented regular expression as 
output.

=head1 Options

No options at this point in time

=head1 Bugs and Caveats

If your regular expression includes variables you must
pass in the names of those variables on the command line.
I can't think of any way to easily get around that problem.
Note that this means that you must pass the exact string
that is the variable name.

Right now, the following are unsupported-

=over 4

=item *

Variables in {n,m} ranges

=item *

Codeblocks

=item *

Conditional expressions

=back

=head1 Todo

=over 4

=item *

use get_opts

=item *

get_comment needs to be almost completely rewritten.  All of the
lookups should be done through hash tables, rather than the
ugly string of if{...}'s (not to mention that that would make
it really easy to make the translation process bidirectional
(ugh.. but who would want to write regexes in English)).

=item *

Support for conditional expressions needs to be added 

=item *

Parsing code-blocks is going to be considerably
more difficult.  Enough more difficult that I'm not sure if this
program can be modified to do this.  Of course, if you're using
code-blocks in your regular expressions you probably don't need
this program

=back

=head1 Author and Copyright Information

Copyright 1998 Daniel Grisinger

This program may be used, modified, and distributed under the terms 
of the Artistic License (http://language.perl.com/misc/Artistic.html)

=cut

use strict;
use 5.005;
#use diagnostics;

# globals, look at init()
use vars qw/ %dispatch_parse 
             %quants 
             %single_escapes
             %multi_escapes
             %vars
             %quant_comment
             %modifiers /;



die <<EOUSAGE unless @ARGV;
Usage:  regdecl regular_expression [variables]
If your regular expression includes variables to
be interpolated, you must pass them in to regdecl
as arguments.  For example-
    \$ regdecl 'as\$foodf' '\$foo'
Don't forget to quote shell metachars.
EOUSAGE

my $regex    = shift @ARGV;
chomp $regex;

for(@ARGV) { $vars{$_} = $_ }

init();

my @chars          = split //, $regex;
my $indent         = 2;
my $comment_column = 20;
my $depth          = 0;

while(@chars) {
    my $token = get_token (@chars); 
    $depth-- if $token -> {ENDS_GROUP}; # decrement depth before we set
                                        # indent level

    my $cur_indent = $depth * $indent;
    my $value      = $token -> {VALUE};
    my $comment    = get_comment ($token);


    print ' ' x $cur_indent;
    print $value;
    print ' ' x ($comment_column - length($value));
    print "#$comment\n";


    splice @chars, 0, length ($value);
    $depth++ if $token -> {STARTS_GROUP};
}

exit();


sub get_token {
    my @chars = @_;
    my $chars = \@chars;

    my $token;

    if(exists ($dispatch_parse{$$chars[0]})) {
	$token = &{$dispatch_parse{$$chars[0]}}($chars);
    }

    $token ||= get_literal ($chars);

    if ( exists ( $quants{$$chars[0]})) {
	$token = get_quant($chars, $token);
    }

    return($token);
}

sub get_open_paren {
    my $chars = shift;
    my $value = shift @$chars;

    if( $$chars[0] ne '?' ) {
	return { VALUE           => $value, 
                 STARTS_GROUP    => 1,
                 IS_CAPTURING    => 1, };
    }

    $value .= shift @$chars;

    if ( $$chars[0] eq ':' ) {
	$value .= shift @$chars;
	return { VALUE         => $value, 
                 STARTS_GROUP  => 1,
                 NON_CAPTURING => 1 };
    }

    if ( $$chars[0] eq '#' ) {
	$value .= shift @$chars until $$chars[0] eq ')';
	$value .= shift @$chars;  # get the close paren

        return { VALUE      => $value,
                 IS_COMMENT => 1, };
    }

    if ( $$chars[0] =~ /[imsx-]/ ) {
	my $lookahead;

	$lookahead .= shift @$chars while (defined ($$chars[0])          &&
                                                    $$chars[0] ne ':'    &&
                                                    $$chars[0] ne ')'); 

	if (!defined ($$chars[0])) {
	    die "Modifier not terminated near $value: Bailing out\n";
	}

        $value .= $lookahead;

	my $is_group = $$chars[0] eq ':' ? 1 : 0; 
	$value .= shift @$chars;

        return { VALUE        => $value, 
		 STARTS_GROUP => $is_group,
		 IS_MODIFIER  => 1, };
    }

    if ( $$chars[0] eq '=' ) {
        $value .= shift @$chars;
        return { VALUE        => $value, 
                 STARTS_GROUP => 1,
                 LOOKAHEAD    => 'positive', }
    }

    if ( $$chars[0] eq '!' ) {
	$value .= shift @$chars;
	return { VALUE        => $value, 
                 STARTS_GROUP => 1,
                 LOOKAHEAD    => 'negative', };
    }

    if ( $$chars[0] eq '<' ) {
	$value .= shift @$chars;
	if ( $$chars[0] eq '=' ) {
	    $value .= shift @$chars;
	    return { VALUE        => $value, 
                     STARTS_GROUP => 1,
                     LOOKBEHIND   => 'positive', };
        }

        if ( $$chars[0] eq '!' ) {
            $value .= shift @$chars;
            return { VALUE        => $value,
                     STARTS_GROUP => 1,
                     LOOKBEHIND   => 'negative', };
	}

	die "Unexpected $$chars[0] after $value: bailing out\n";
    }

    if ( $$chars[0] eq '>' ) {
        $value .= shift @$chars;
	return { VALUE        => $value,
                 STARTS_GROUP => 1,
                 INDEPENDENT  => 1, };
    }

    if ( $$chars[0] eq '{' ) {
	die "Inline code not supported.\n";
    }

    if ( $$chars[0] eq '(' ) {
	die "Conditional expression not supported.\n";
    }

    die "Unexpected character $$chars[0] in (? construct.  Bailing out.\n";
}

sub get_close_paren {
    my $chars = shift;
    my $value = shift @$chars;
  
    return { VALUE      => $value,
             ENDS_GROUP => 1, }
}

sub get_class {
    my $chars = shift;
    my $value = shift @$chars;
    my $token = { VALUE    => $value,
                  IS_CLASS => 1, };

    if ( $$chars[0] eq '^' ) {
	$token -> {VALUE}  .= shift @$chars;
	$token -> {NEGATED} = 1;
    }

    $token -> {VALUE} .= shift @$chars while (defined ($$chars[0]) &&
                                                       $$chars[0] ne ']');

    if (! defined( $$chars[0])){
	die "Unterminated character class.  Bailing out.\n";
    }

    $token -> {VALUE} .= shift @$chars;
    return $token;
}

sub get_dot {
    my $chars = shift;
    my $value = shift @$chars;

    return { VALUE  => $value,
             IS_DOT => 1, };

}

sub get_or {
    my $chars = shift;
    my $value = shift @$chars;

    return { VALUE => $value,
             IS_OR => 1, };

}

sub get_quant {
    my $chars      = shift;
    my $orig_token = shift;
    my $token      = {%$orig_token};  # protect orig_token from changes 
                                      # in case this isn't isn't a valid call

    my $char           = shift @$chars;
    $token -> {QUANT}  = $char;
    $token -> {VALUE} .= $char;

    if ( $char ne '{' ) {
	if ( $$chars[0] eq '?' ) {
	    $token -> {NON_GREEDY} = 1;
	    $token -> {QUANT}     .= $$chars[0];
	    $token -> {VALUE}     .= $$chars[0];
	}

	if ( $char eq '+' ) {
	    $token -> {MIN} = 1;
	    $token -> {MAX} = 'inf';
	}
	elsif ( $char eq '*' ) {
	    $token -> {MIN} = 0;
	    $token -> {MAX} = 'inf';
	}
	elsif ( $char eq '?' ) {
	    $token -> {MIN} = 0;
	    $token -> {MAX} = 1;
	}

	return $token;
    }

    my ($seen_comma, $min, $max);

    while ($char = shift @$chars) {
	if ($char eq '}') {
	    $token -> {QUANT} .= $char;
	    $token -> {VALUE} .= $char;
	    $token -> {MIN}    = $min;
	    $token -> {MAX}    = $max;
	    return $token;
	}

	if ($char =~ /\d/) {
            $token -> {QUANT} .= $char;
	    $token -> {VALUE} .= $char;
	    $seen_comma ? $max .= $char : ($min .= $char);
            next;
	}

	if ($char eq ',') {
	    die "Illegal ',' in quantifier.  Bailing out.\n" if $seen_comma;
	    $seen_comma = 1;
	    $token -> {QUANT} .= $char;
	    $token -> {VALUE} .= $char;
	    next;
        }

	if ($char =~ m/[\@\$]/) { 
	    warn "I don't grok variables in {n,m} quantifiers yet.  Sorry :-(.\n";
	}

	return $orig_token;
    }
}
      
sub get_literal {
    my $chars = shift;
    my $value = shift @$chars;
    my $token = { VALUE      => $value,
                  IS_LITERAL => 1 };

    if (exists $quants{$$chars[0]}){
	return $token;
    }


    while(defined(my $char = shift @$chars)) {
	if (exists $quants{$$chars[0]}) {
	    unshift @$chars, $char;
	    return $token;
	}

	if (exists $dispatch_parse{$char}) {
            unshift @$chars, $char;
	    return $token;
	}

	$token -> {VALUE} .= $char;
    }

    return $token;
}

sub get_escape {
    my $chars = shift;
    my $value = shift @$chars;
    my $token = { IS_ESCAPE => 1, };

    if (exists $single_escapes{$$chars[0]}) {
	$value .= shift @$chars;
	$token -> {VALUE} = $value;
	return $token;
    }

    if (exists $multi_escapes{$$chars[0]}) {
	my $char = shift @$chars;
        $value .= $char;

	if ($char eq 'c') {
	    $value .= shift @$chars;
	    $token -> {IS_CONTROL} = 1;
	    $token -> {VALUE}      = $value;
	    return $token;
	}

	if ($char eq '0') {
	    $value .= shift @$chars while ($$chars[0] =~ /[0-8]/);
	    $token -> {IS_OCT} = 1;
	    $token -> {VALUE}  = $value;
	    return $token;
	}

	if ($char eq 'x') {
	    $value .= shift @$chars while ($$chars[0] =~ /[a-fA-F0-9]/);
	    $token -> {IS_HEX} = 1;
	    $token -> {VALUE}  = $value;
	    return $token;
	}
    }

    $token -> {VALUE}          = shift @$chars;
    $token -> {USELESS_ESCAPE} = 1;
}

sub get_meta {
    my $chars = shift;
    my $value = shift @$chars;

    my $token = { VALUE   => $value,
                  IS_META => 1, };

    if ($value eq '^') {
	$token -> {IS_ANCHOR} = 'beginning';
    }

    if ($value eq '$') {
        $token -> {IS_ANCHOR} = 'end';
    }

    return $token;
}
    
sub get_var {
    my $chars = shift;
    my $value = shift @$chars;

    if ($value eq '$'  && 
       (! defined ($$chars[0])   
       || $$chars[0] =~ /[)|]/))
    {
        unshift @$chars, $value;
        return get_meta($chars);
    }

    $value .= shift @$chars while (defined ($$chars[0]) &&
                                   !exists $vars {$value});

    unless($vars{$value}) {
        die "Variable $value unknown.  Bailing out.\n";
    }

    return { VALUE  => $value,
             IS_VAR => 1, };
}


sub init {

    %dispatch_parse = ( '('      => \&get_open_paren,
                        ')'      => \&get_close_paren,
                        '['      => \&get_class,
                        '.'      => \&get_dot,
                        '|'      => \&get_or,
                        '\\'     => \&get_escape,
                        '^'      => \&get_meta,
                        '$'      => \&get_var,
                        '@'      => \&get_var, );
     
    %quants         = ( '*'      => 1,
                        '+'      => 1,
                        '?'      => 1,
                        '{'      => 1, );

    %single_escapes = ( 'w'      => 'word character',
			'W'      => 'non-word character',
			's'      => 'space character',
			'S'      => 'non-space character',
			'd'      => 'digit character',
			'D'      => 'non-digit character',

			't'      => 'tab',
			'n'      => 'newline',
			'r'      => 'carriage return',
			'f'      => 'form feed',
			'a'      => 'alarm',
			'e'      => 'escape',
			   
			'b'      => 'word boundary',
			'B'      => 'non word-boundary',
			'A'      => 'beginning of string',
			'Z'      => 'end of string',
			'z'      => 'absolute end of string',
			'G'      => 'last pos()',

                        'l'      => 'lowercase next char',
                        'u'      => 'uppercase next char',
                        'L'      => 'lowercase until \E',
                        'U'      => 'uppercase until \E',
                        'Q'      => 'quotemeta until \E', );

    %multi_escapes  = ( 'c'      => 'control character',
			'0'      => 'octal digit',
			'x'      => 'hex digit',);

    %quant_comment  = ( '*'      => ' 0 or more times ',
                        '+'      => ' 1 or more times ',
                        '?'      => ' 0 or 1 time ',
                        '*?'     => ' 0 or more times, non-greedy ',
                        '+*'     => ' 1 or more times, non-greedy ', ); 

    %modifiers      = ( 'i'      => 'case insensitive',
                        's'      => 'dot matches newline',
                        'x'      => 'ignore whitespace',
                        'g'      => 'global match',
                        'm'      => 'multi-line',
                        'c'      => 'no reset', );
}



sub get_comment {
    my $token = shift;
    my $comment;

    my $value = $token -> {VALUE};

    # this is to make the formatting of {QUANT} work right
    my $junk  = quotemeta($token -> {QUANT});
    $value    =~ s/$junk//;


    # this is really yucky.  but i can't think of an
    # easy way to make this work through a dispatch
    # table.  after TOKETYPE is determined we jump
    # way down to check {QUANT}

 TOKETYPE: {
	if ($token -> {IS_LITERAL}) {
	    $comment = qq. The literal string `$value' .;  #'
	    last TOKETYPE;
	}
	
	if ($token -> {IS_META}) {
	    $comment = qq. The $token -> {IS_ANCHOR} of the string .;
	    last TOKETYPE;
	}
	
	if ($token -> {STARTS_GROUP} && $token -> {IS_CAPTURING}) {
	    $comment = qq. Start capturing group .;
	    last TOKETYPE;
	}
	
	if ($token -> {STARTS_GROUP} && $token -> {NON_CAPTURING}) {
	    $comment = qq. Start non-capturing group .;
	    last TOKETYPE;
	}

	if ($token -> {STARTS_GROUP} && $token -> {INDEPENDENT}) {
	    $comment = qq. Start independent group .;
	    last TOKETYPE;
	}
    
	if ($token -> {IS_COMMENT}) {
	    $comment = qq. An inline comment?  That seems silly! .;
	    last TOKETYPE;
	}

	if ($token -> {IS_MODIFIER}) {
	    $comment = modifier_comment($token);
	    last TOKETYPE;
        }
    
	if (defined $token -> {LOOKAHEAD}) {
	    $comment = qq. Positive lookahead .
	        if ($token -> {LOOKAHEAD} eq 'positive');
	
	    $comment = qq. Negative lookahead .
	        if ($token -> {LOOKAHEAD} eq 'negative');
             last TOKETYPE;
         }
    
	if (defined $token -> {LOOKBEHIND}) {
	    $comment = qq. Positive lookbehind .
		if ($token -> {LOOKBEHIND} eq 'positive');
	    $comment = qq. Negative lookbehind .
		if ($token -> {LOOKBEHIND} eq 'negative');
	    last TOKETYPE;
	}

	if ($token -> {INDEPENDENT}) {    
	    $comment = qq. Independent expression .;
	    last TOKETYPE;
        }

	if ($token -> {ENDS_GROUP}) {
	    $comment = qq. End group .;
	    last TOKETYPE;
	}

	if ($token -> {IS_CLASS}){
	    my $class_comment;
	
	    if ($token -> {NEGATED}) {
		$class_comment = qq. Anything except $token->{VALUE} .;
	    }
	    else {
		$class_comment = qq. Any of $token->{VALUE} .;
	    }
	
	    $class_comment =~ s/(?<!\\)\\(?!\\)//g;
	    $class_comment =~ s/\^|\[|\]//g;

	    $comment = $class_comment;
	    last TOKETYPE;
	}
	
	if ($token -> {IS_DOT}) {
	    $comment = qq. Any character .;
	    last TOKETYPE;
	}
	
	if ($token -> {IS_OR}) {
	    $comment = qq. Or .;
	    last TOKETYPE;
	}


	if ($token -> {IS_ESCAPE}) {
	    my $value = $token -> {VALUE};
	    $value =~ s/\\[cx0]//g;
	    
	    if (exists ($single_escapes{$value})){
		$comment = $single_escapes{$value};
		last TOKETYPE;
	    }

	    if (exists ($multi_escapes{$value})) {
		$comment = " $multi_escapes{$value} $value ";
		last TOKETYPE;
	    }

	    $comment = qq.A literal `$value'.; #'`
	    last TOKETYPE;
	}

	if ($token -> {IS_VAR}) {
	    $comment = qq. The contents of $token->{VALUE} .;
	    last TOKETYPE;
	}
    }

    if (!$token -> {QUANT}) {
	return $comment;
    }


    # this is a little better than TOKETYPE, but only because it's
    # shorter

 QUANT_COMMENT:
    {
	if (exists $quant_comment{ $token -> {QUANT}}) {
	    $comment .= $quant_comment{ $token -> {QUANT}};
	    last QUANT_COMMENT;
	}

	if (defined ($token -> {MIN}) && 
	    defined ($token -> {MAX})) 
	{
	    $comment .= $token -> {MIN} . " to " .
                        $token -> {MAX} . " (inclusive) times ";
	    last QUANT_COMMENT;
	}

	if ($token -> {MIN} && ! $token -> {MAX}) {
	    $comment .= qq( exactly ) .  $token -> {MIN} . qq( times );
	    last QUANT_COMMENT;
	}

	if ($token -> {MAX} && ! $token -> {MIN}) {
	    $comment .= qq( between 0 and ) . $token -> {MAX} . qq( times );
	    last QUANT_COMMENT;
	}
    }

    return $comment
}


sub modifier_comment {
    my $token   = shift;
    my $comment = " Start group, ";

    for(split //, $token -> {VALUE}) {
	next unless exists $modifiers{$_};
	$comment .= "$modifiers{$_}, ";
    }

    return $comment;
}

__END__

-- 
Daniel Grisinger          dgris@perrin.dimensional.com
`By about halfway through I was beginning to guess the 
ending, but it still kind of surprised me.'
      David Hatunen, talking about the movie Titanic


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

Date: Mon, 21 Sep 1998 09:39:58 +0100
From: Andy Marden <amarden@ibm.net>
To: MARTIN@RADIOGAGA.HARZ.DE
Subject: Re: Runtime evaluation of required modules
Message-Id: <360610DE.B2CC5E7E@ibm.net>

Doesn't this imply that using require followed by import should be OK?
But even then the require caused the contents of the module to be
evaluated at compile time, which is what I want to avoid.

Andy

Martin Vorlaender wrote:
> 
> Andy Marden (amarden@ibm.net) wrote:
> : What I didn't count on was that the contents of any module used are
> : evaluated at compile time, even if the use if in a conditional
> : statement. Hence, Platform_NT.pm is evaluated initially even under HPUX,
> : and of course it can't find the Win32:: modules which are used in
> : Platform_NT.pm
> :
> : Is there a way of deferring the checking of these modules until the use
> : statementis actually encountered at run time rather than compile time?
> : I've tried requiring them all first and then conditionally importing
> : them, but it fails with the same error at the require step.
> 
> Lets see what "perldoc -f use" has to say, shall we?
> 
>    use Module LIST
>    use Module
>    [...]
>    It is exactly equivalent to
> 
>        BEGIN { require Module; import Module LIST; }
> 
>    except that Module *must* be a bareword.
> 
> The "BEGIN" is where your troubles come from.
> 
> cu,
>   Martin
> --
>                           | Martin Vorlaender | VMS & WNT programmer
>  OpenVMS: Where do you    | work: mv@pdv-systeme.de
>  want to BE today?        |       http://www.pdv-systeme.de/users/martinv/
>                           | home: martin@radiogaga.harz.de


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

Date: 21 Sep 1998 08:52:02 GMT
From: sholden@pgrad.cs.usyd.edu.au (Sam Holden)
Subject: Re: Runtime evaluation of required modules
Message-Id: <slrn70c4ti.gbv.sholden@pgrad.cs.usyd.edu.au>

On Mon, 21 Sep 1998 09:39:58 +0100, Andy Marden <amarden@ibm.net> wrote:
>Doesn't this imply that using require followed by import should be OK?

Yes.

>But even then the require caused the contents of the module to be
>evaluated at compile time, which is what I want to avoid.

No it doesn't...

<snip>

-- 
Sam

There's no such thing as a simple cache bug.
	--Rob Pike


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

Date: Mon, 21 Sep 1998 08:18:55 GMT
From: adelton@fi.muni.cz (Honza Pazdziora)
Subject: Re: where is Date::Parse (CPAN.pm)?
Message-Id: <EzMKFJ.BG5@news.muni.cz>

On 20 Sep 1998 12:38:36 -0700, Russ Allbery <rra@stanford.edu> wrote:
> 
> Nothing's going to work perfectly with everything, and in fact nothing's
> likely to work as well across all Perl modules as CPAN.pm.  However,
> CPAN.pm fails miserably for anything that's *not* a Perl module, and I'm

But it's not CPAN.pm's fault, it's a problem with CPAN itself. The
non-module things are not indexed, and you cannot hope to solve the
problem before you have the primary data you can build on, isn't that
true?

-- 
------------------------------------------------------------------------
 Honza Pazdziora | adelton@fi.muni.cz | http://www.fi.muni.cz/~adelton/
                   I can take or leave it if I please
------------------------------------------------------------------------


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

Date: Mon, 21 Sep 1998 08:16:02 GMT
From: adelton@fi.muni.cz (Honza Pazdziora)
Subject: Re: where is Date::Parse (CPAN.pm)?
Message-Id: <EzMKAq.86z@news.muni.cz>

On 20 Sep 1998 14:27:53 -0500, Leslie Mikesell <les@MCS.COM> wrote:

>  o There should be an easy way to jump to interactive mode after the
>    source is expanded in the build directory to handle cases where
>    you need special options or testing before installing.

You mean look module?

-- 
------------------------------------------------------------------------
 Honza Pazdziora | adelton@fi.muni.cz | http://www.fi.muni.cz/~adelton/
                   I can take or leave it if I please
------------------------------------------------------------------------


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

Date: 12 Jul 98 21:33:47 GMT (Last modified)
From: Perl-Request@ruby.oce.orst.edu (Perl-Users-Digest Admin) 
Subject: Special: Digest Administrivia (Last modified: 12 Mar 98)
Message-Id: <null>


Administrivia:

Special notice: in a few days, the new group comp.lang.perl.moderated
should be formed. I would rather not support two different groups, and I
know of no other plans to create a digested moderated group. This leaves
me with two options: 1) keep on with this group 2) change to the
moderated one.

If you have opinions on this, send them to
perl-users-request@ruby.oce.orst.edu. 


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.misc (and this Digest), send your
article to perl-users@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.

The Meta-FAQ, an article containing information about the FAQ, is
available by requesting "send perl-users meta-faq". The real FAQ, as it
appeared last in the newsgroup, can be retrieved with the request "send
perl-users FAQ". Due to their sizes, neither the Meta-FAQ nor the FAQ
are included in the digest.

The "mini-FAQ", which is an updated version of the Meta-FAQ, is
available by requesting "send perl-users mini-faq". It appears twice
weekly in the group, but is not distributed in the digest.

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 V8 Issue 3774
**************************************

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