[17427] in Perl-Users-Digest

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

Perl-Users Digest, Issue: 4847 Volume: 9

daemon@ATHENA.MIT.EDU (Perl-Users Digest)
Wed Nov 8 18:06:27 2000

Date: Wed, 8 Nov 2000 15:05:15 -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: <973724715-v9-i4847@ruby.oce.orst.edu>
Content-Type: text

Perl-Users Digest           Wed, 8 Nov 2000     Volume: 9 Number: 4847

Today's topics:
    Re: -e file tester bug <donv@webimpact.com>
    Re: -e file tester bug (Clay Irving)
        [ANNOUNCE] Tie::Scalar::Timeout 1.2 (Marcel Grunauer)
        [mod_perl] Flakey [Named]VirtualHost support, should Ti azilber@ccgxm.com
    Re: [Way OT] Re: OOP and information hiding (Jerome O'Neil)
    Re: [Way OT] Re: OOP and information hiding (Gwyn Judd)
        ANNOUNCE: ex::override 1.81 <crt@kiski.net>
    Re: Anonymous Data (probably very easy) <ren.maddox@tivoli.com>
    Re: atoi for Perl (Ilya Zakharevich)
    Re: atoi for Perl <thamus@my-deja.com>
    Re: Emailing formatted <peter.sundstrom@eds.com>
    Re: file upload, determining file type, size, format (Jon Ericson)
    Re: Files on NFS <ren.maddox@tivoli.com>
        Freshman parameter question <xarbosa@yahoo.com>
    Re: Freshman parameter question (Richard J. Rauenzahn)
    Re: Freshman parameter question <kstep@pepsdesign.com>
    Re: Freshman parameter question <mjcarman@home.com>
        help on improving code (pine2mutt-script ca 130 lines) (Jan Schaumann)
        Digest Administrivia (Last modified: 16 Sep 99) (Perl-Users-Digest Admin)

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

Date: Wed, 08 Nov 2000 17:06:54 -0500
From: Don Vaillancourt <donv@webimpact.com>
Subject: Re: -e file tester bug
Message-Id: <3A09CE7E.88734A67@webimpact.com>

<!doctype html public "-//w3c//dtd html 4.0 transitional//en">
<html>
&nbsp;
<br>>> I wrote a small script which uses the -e file test operator and
it works
<br>>> similarly on both machines.&nbsp; But when I use the code I wrote
which is a
<br>>
<br>>So then you know that it isn't the -e operator that is the problem,
right?
<br>>
<br>>> database library with 1656 lines of code, that's when I get the
<br>>> problem.&nbsp; Here is the offending function.
<br>>>
<br>>>&nbsp;&nbsp;&nbsp;&nbsp; $properties->{running}->{"running_size"}=0;
# this is a mock entry
<br>>
<br>>So, $properties->{running} is a reference to a hash, yes?
<br>>
<br>>>&nbsp;&nbsp;&nbsp;&nbsp; my $i;
<br>>>&nbsp;&nbsp;&nbsp;&nbsp; my $file = $properties->{running};
<br>>
<br>>Or is it the name of a file?
<p>This is a hash which contains name/values which I read from $file.
<p>>
<br>>Well, assuming you don't have strict refs enabled, then it can be
<br>>both.&nbsp; And if you do have it enabled, then the first line would
get an
<br>>error (unless) it isn't really set to a file name at that point.
<br>>
<br>>>&nbsp;&nbsp;&nbsp;&nbsp; if (-e "$file")&nbsp; # &lt;-- This is where
the problem occurs
<br>>
<br>>Perhaps you should print the value of $file and verify that it is
what
<br>>you expect.
<p>That I have done, and have verified that the filename is correct and
does or doesn't exist in the directory structure.</html>



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

Date: 8 Nov 2000 22:52:55 GMT
From: clay@panix.com (Clay Irving)
Subject: Re: -e file tester bug
Message-Id: <slrn90jma7.5hk.clay@panix2.panix.com>

On Wed, 08 Nov 2000 17:06:54 -0500, Don Vaillancourt <donv@webimpact.com> wrote:

><!doctype html public "-//w3c//dtd html 4.0 transitional//en">
><html>
>&nbsp;
><br>>> I wrote a small script which uses the -e file test operator and
>it works
[ snip ]

You also wrote a bunch of HTML garbage in this message.

-- 
Clay Irving <clay@panix.com>
Witchcraft always has a hard time, until it becomes respectable and
changes its name. 
- Charles Fort 


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

Date: 8 Nov 2000 17:59:24 GMT
From: marcel@codewerk.com (Marcel Grunauer)
Subject: [ANNOUNCE] Tie::Scalar::Timeout 1.2
Message-Id: <slrn90jc6m.62k.marcel@saruman.localhost>


The uploaded file
      
    Tie-Scalar-Timeout-1.2.tar.gz
       
has entered CPAN as
       
  file: $CPAN/authors/id/M/MA/MARCEL/Tie-Scalar-Timeout-1.2.tar.gz
  size: 3919 bytes
   md5: 494eb852e6fb4ef482d61c1b3a9fa55f


NAME
    Tie::Scalar::Timeout - Scalar variables that time out

SYNOPSIS
      use Tie::Scalar::Timeout;
  
      tie my $k, 'Tie::Scalar::Timeout', EXPIRES => '+2s';
  
      $k = 123;
      sleep(3);
      # $k is now undef
  
      tie my $m, 'Tie::Scalar::Timeout', NUM_USES => 3, VALUE => 456;
  
      tie my $n, 'Tie::Scalar::Timeout', VALUE => 987, NUM_USES => 1,
          POLICY => 777;
  
      tie my $p, 'Tie::Scalar::Timeout', VALUE => 654, NUM_USES => 1,
          POLICY => \&expired;
      sub expired { $is_expired++ }

DESCRIPTION
    This module allows you to tie a scalar variable whose value will be
    reset (subject to an expiry policy) after a certain time and/or a
    certain number of uses. One possible application for this module might
    be to time out session variables in mod_perl programs.

    When tying, you can specify named arguments in the form of a hash. The
    following named parameters are supported:

    `EXPIRES'
        Use `EXPIRES' to specify an interval or absolute time after which
        the value will be reset. (Technically, the value will still be
        there, but the module's FETCH sub will return the value as dictated
        by the expiry policy.)

        Values for the `EXPIRES' field are modelled after Netscape's cookie
        expiration times. Except, of course, that negative values don't
        really make sense in a universe with linear, one-way time. The
        following forms are all valid for the `EXPIRES' field:

            +30s                    30 seconds from now
            +10m                    ten minutes from now
            +1h                     one hour from now
            +3M                     in three months
            +10y                    in ten years time
            25-Apr-2001 00:40:33    at the indicated time & date

        Assigning a value to the variable causes `EXPIRES' to be reset to
        the original value.

    `VALUE'
        Using the `VALUE' hash key, you can specify an initial value for the
        variable.

    `NUM_USES'
        Alternatively or in addition to `EXPIRES', you can also specify a
        maximum number of times the variable may be read from before it
        expires. If both `EXPIRES' and `NUM_USES' are set, the variable will
        expire when either condition becomes true. If `NUM_USES' isn't set
        or set to a negative value, it won't influence the expiry process.

        Assigning a value to the variable causes `NUM_USES' to be reset to
        the original value.

    `POLICY'
        The expiration policy determines what happens to the variable's
        value when it expires. If you don't specify a policy, the variable
        will be `undef' after it has expired. You can specify either a
        scalar value or a code reference as the value of the `POLICY'
        parameter. If you specify a scalar value, that value will be
        returned after the variable has expired. Thus, the default
        expiration policy is equivalent to

            POLICY => undef

        If you specify a code reference as the value of the `POLICY'
        parameter, that code will be called when the variable value is
        `FETCH()'ed after it has expired. This might be used to set some
        other variable, or reset the variable to a different value, for
        example.

BUGS
    None known so far. If you find any bugs or oddities, please do tell me
    about them.

AUTHOR
    Marcel Grünauer <marcel@codewerk.com>

COPYRIGHT
    Copyright 2000 Marcel Grünauer. All rights reserved.

    This library is free software; you can redistribute it and/or modify it
    under the same terms as Perl itself.

SEE ALSO
    perl(1), Tie::Scalar(3pm).


Marcel

-- 
We are Perl. Your table will be assimilated. Your waiter will adapt to
service us. Surrender your beer. Resistance is futile.
 -- London.pm strategy aka "embrace and extend" aka "mark and sweep"


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

Date: Wed, 08 Nov 2000 19:38:26 GMT
From: azilber@ccgxm.com
Subject: [mod_perl] Flakey [Named]VirtualHost support, should TieHash be used?
Message-Id: <3a09ab76.13814113@news.idt.net>

Hi All,

   I've been developing a little mod_perl Apache::Registery script
that builds VirtualHosts and NamedVirtualhost's based on pre-generated
text files.  The code works wonderfully... when it actually works.
For some reason I usually need to start Apache 4-5 times before it
actually "sticks" and starts.  There are no error messages, no
cores/segfaults, just a usualy httpd started.   I've read about using
TieHash in the O'Reilly book, but I'm hazy on implementing it, so I
haven't.  My gut feeling is that that is the problem.  If someone
would look at the code and tell me wtf is going wrong...  BTW: this is
my first Apache::Registry proggie. 
   What it does, is read in a text file (.domains) that's in the
following format:  <ip>:<domain name>:<port>:<quota>
And for subsequent namevirtualhosts <domain name>:<quota>

One other weirdness.. when I startup Apache, I get a bunch of
"unreferenced and undefined" warnings.  Those are evident in the
ServerConfig.pm below.

IF this is a TiexHash issue, could someone show me a good example of
using it with the following code? 

Thanks!
Alex

Brace yourselves (from httpd.conf):
-----
<Perl>
#!perl

use Apache::PerlSections();

my $clientdir = "/home/clients";
my $sslclientdir = "/home/clients-ssl";
my $logdir = "/data/logs";
my $ssllogdir = "/data/logs-ssl";
my $domainfile = "$clientdir" . "/" . ".domains";


        open DOMAINS, "$domainfile" || die "Cannot open $domainfile!";

my @maindoms;

        my $line;
        while($line=<DOMAINS>){
        chomp($line);
        if($line){ push @maindoms,$line; }
        }

        close DOMAINS;

my $locuser; my $crap;
my $ip; my $domain; my $port;
        foreach my $toplvl(@maindoms){
                ($ip,$domain,$port,$crap) = split(":",$toplvl,4);
                ($locuser,$crap) = split(/\./,$domain,2);
print STDERR "foreach: $ip:$domain:$port with user+group: $locuser
[$crap]\n";
                if($port eq "80"){
print STDERR "foreach: port = 80\n";
                        unless (-d "$logdir/$domain"){
                                mkdir "$logdir/$domain", 0755;
                                print STDERR "foreach: mkdir:
$logdir/$domain\n";
                        }
                        unless (-d "$clientdir/$domain"){
                         my $line="cp -Rf /home/defaults/
$clientdir/$domain/";
                                mkdir "$clientdir/$domain", 0755;
                                require File::NCopy;

File::NCopy::copy("/home/defaults/*","$clientdir/$domain");

File::NCopy::copy("/home/defaults/.*","$clientdir/$domain");
print STDERR "foreach: cp: $clientdir/$domain\n";
                        }
#                       chown -R "$uid:$gid" "$clientdir/$domain";
                } elsif($port eq "443"){
print STDERR "foreach: port = 443\n";
                        unless (-d "$ssllogdir/$domain"){
                                mkdir "$ssllogdir/$domain", 0755;
                                print STDERR "foreach: mkdir:
$ssllogdir/$domain\n";
                        }
                        unless (-d "$sslclientdir/$domain"){
                        my $line="cp -Rf /home/defaults/
$sslclientdir/$domain/";
                        #system($line);
                        mkdir "$sslclientdir/$domain", 0755;
                        require File::NCopy;

File::NCopy::copy("/home/defaults/*","$sslclientdir/$domain");

print STDERR "foreach: cp: $sslclientdir/$domain\n";
#                       chown -R "$uid:$gid" "$clientdir/$domain";
                        }
                } else {
                        print STDERR "No port specified in domains
file!\n";
                }

print STDERR "Building Virtual Host for $domain at $ip\n";
        $NameVirtualHost[++$#NameVirtualHost] = $ip;
        $VirtualHost{$ip}[++$#VirtualHost] = {

                ServerName => "$domain",
                ServerAdmin => "webmaster\@$domain",
                ServerAlias => "www.$domain",
                DocumentRoot => "$clientdir/$domain",
                CustomLog => "$logdir/$domain/access_log combined",
                ErrorLog => "$clientdir/$domain/error_log",
               Directory => {
                       "$clientdir/$domain" => {
                               Options => 'All ExecCGI',
                               AllowOverride => 'All',
                       },
                       "$clientdir/$domain/cgi-bin" => {
                               AllowOverride => 'None',
                               Options => 'ExecCGI',
                               SetHandler => 'cgi-script',
                       },
               },
                ScriptAlias => "/cgi-bin/
$clientdir/$domain/cgi-bin/",
        };  #End VirtualHost

print STDERR "VirtualHost $ip\n";

        if(-f "$clientdir/$domain/.domains"){
                open PIGGY, "$clientdir/$domain/.domains" || die
"Weird piggy error.";
                my $pline; my $lcrap;
                my @piggys;
                $crap = "";
                while($lcrap=<PIGGY>){
                        ($pline,$lcrap) = split(":",$lcrap,2);
                        chomp($pline);
                        push @piggys,$pline;
                }
                        close PIGGY;

                foreach $pline (@piggys){
print STDERR "Piggy: $pline @ $ip master: $domain\n";
                unless (-d "$clientdir/$domain/$pline"){
print STDERR "Piggy: mkdir: $clientdir/$domain/$pline\n";
                        mkdir "$clientdir/$domain/$pline", 0755;
                }

                unless (-d "$logdir/$domain/$pline"){
print STDERR "Piggy: mkdir: $logdir/$domain/$pline\n";
                        mkdir "$logdir/$domain/$pline", 0755;
                }
print STDERR "Piggy: Making virt $domain\n";
                        $VirtualHost{$ip}[++$#VirtualHost] = {

                                ServerName => "$pline",
                                ServerAdmin => "webmaster\@$pline",
                                ServerAlias => "www.$pline $pline",
                                ServerPath => "/$pline",
                                DocumentRoot =>
"$clientdir/$domain/$pline",
                                CustomLog =>
"$logdir/$domain/$pline/access_log combined",
                                ErrorLog =>
"$clientdir/$domain/$pline/error_log",
                               Directory => {
                                       "$clientdir/$domain/$pline" =>
{
                                               Options => 'All
ExecCGI',
                                               AllowOverride => 'All',
                                       },
                               "$clientdir/$domain/$pline/cgi-bin" =>
{
                                                AllowOverride =>
'None',
                                       Options => 'ExecCGI',
                                       SetHandler => 'cgi-script',
                               },
                               },
                               ScriptAlias => "/cgi-bin/
$clientdir/$domain/$pline/cgi-bin/",
                        };  #End VirtualHost

print STDERR "Piggy: Made virt for $pline\n";

print STDERR "Piggy: end foreach\n";
                } #End piggy foreach


print STDERR "Piggy: end.\n";
        } #End Piggy



print STDERR "foreach: end.\n";
        }  #End of foreach loop for main domains

close FTP;
print STDERR "Proftpd: closed.\n";

Apache::PerlSections->store("/opt/apache_1.3.12/conf/ServerConfig.pm");
#print STDERR Apache::PerlSections->dump();

print STDERR "Config Saved.\n";
__END__
</Perl>
----
ServerConfig.pm contains:

package Apache::ReadConfig;
#scalars:

#arrays:

@VirtualHost = (
  undef,
  undef,
  undef,
  undef,
  undef,
  undef,
  undef,
  undef,
  undef,
  undef,
  undef,
  undef,
  undef,
  undef,
  undef,
  undef,
  undef,
  undef,
  undef,
  undef
);

@NameVirtualHost = (
  '209.11.10.53'
);

#hashes:

%VirtualHost = (
  '209.11.10.53' => [
    {
      'ServerAdmin' => 'webmaster@surfvariety.com',
      'ServerName' => 'surfvariety.com',
      'ServerAlias' => 'www.surfvariety.com',
      'DocumentRoot' => '/home/clients/surfvariety.com',
      'ErrorLog' => '/home/clients/surfvariety.com/error_log',
      'CustomLog' => '/data/logs/surfvariety.com/access_log combined',
      'ScriptAlias' => '/cgi-bin/
/home/clients/surfvariety.com/cgi-bin/'
    },
    {
      'ServerAdmin' => 'webmaster@dlfnyc.com',
      'ServerAlias' => 'www.dlfnyc.com dlfnyc.com',
      'DocumentRoot' => '/home/clients/surfvariety.com/dlfnyc.com',
      'ServerPath' => '/dlfnyc.com',
      'ServerName' => 'dlfnyc.com',
      'ErrorLog' =>
'/home/clients/surfvariety.com/dlfnyc.com/error_log',
      'CustomLog' => '/data/logs/surfvariety.com/dlfnyc.com/access_log
combined',
      'ScriptAlias' => '/cgi-bin/
/home/clients/surfvariety.com/dlfnyc.com/cgi-bin/'
    },
    {
      'ServerAdmin' => 'webmaster@toxicpop.com',
      'ServerAlias' => 'www.toxicpop.com toxicpop.com',
      'DocumentRoot' => '/home/clients/surfvariety.com/toxicpop.com',
      'ServerPath' => '/toxicpop.com',
      'ServerName' => 'toxicpop.com',
      'ErrorLog' =>
'/home/clients/surfvariety.com/toxicpop.com/error_log',
      'CustomLog' =>
'/data/logs/surfvariety.com/toxicpop.com/access_log combined',
      'ScriptAlias' => '/cgi-bin/
/home/clients/surfvariety.com/toxicpop.com/cgi-bin/'
    }
 ]
);

1;
__END__


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

Date: Wed, 08 Nov 2000 20:25:48 GMT
From: jerome@activeindexing.com (Jerome O'Neil)
Subject: Re: [Way OT] Re: OOP and information hiding
Message-Id: <gFiO5.1208$qF.166301@news.uswest.net>

tjla@guvfybir.qlaqaf.bet (Gwyn Judd) elucidates:
> I was shocked! How could Abigail <abigail@foad.org>
> say such a terrible thing:
 
> Ah but what if you wrap the velcro straps around the lego blocks?

I don't like calling this thing off topic.

The dialoge between Abigail and Damian is exactly the kind of
thing that keeps me reading c.l.p.m. 

-- 
"Civilization rests on two things: the discovery that fermentation 
produces alcohol, and the voluntary ability to inhibit defecation.  
And I put it to you, where would this splendid civilization be without 
both?" --Robertson Davies "The Rebel Angels" 


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

Date: Wed, 08 Nov 2000 20:47:45 GMT
From: tjla@guvfybir.qlaqaf.bet (Gwyn Judd)
Subject: Re: [Way OT] Re: OOP and information hiding
Message-Id: <slrn90jevd.mk2.tjla@thislove.dyndns.org>

I was shocked! How could Jerome O'Neil <jerome@activeindexing.com>
say such a terrible thing:
>tjla@guvfybir.qlaqaf.bet (Gwyn Judd) elucidates:
>> I was shocked! How could Abigail <abigail@foad.org>
>> say such a terrible thing:
> 
>> Ah but what if you wrap the velcro straps around the lego blocks?
>
>I don't like calling this thing off topic.
>
>The dialoge between Abigail and Damian is exactly the kind of
>thing that keeps me reading c.l.p.m. 

Their's wasn't, mine was. Fair enough?

-- 
Gwyn Judd (print `echo 'tjla@guvfybir.qlaqaf.bet' | rot13`)
Every person is responsible for all the good within the scope of his
abilities, and for no more, and none can tell whose sphere is the largest.
-Gail Hamilton


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

Date: Wed, 8 Nov 2000 11:54:16 -0500
From: "Casey R. Tweten" <crt@kiski.net>
Subject: ANNOUNCE: ex::override 1.81
Message-Id: <Pine.OSF.4.21.0011081144180.17508-100000@home.kiski.net>


Uploaded to CPAN, or you can get it here:

  http://home.kiski.net/~crt/perl/modules/ex-override-1.01.tar.gz

from pod:

NAME
    ex::override - Perl pragma to override core functions

SYNOPSIS
      use ex::override ucfirst => sub {
                                       # make sure only the first
                                       # letter is uppercased
                                       ucfirst( lc( shift ) );
                                      };

      ucfirst( 'MAKE THIS RIGHT' );
      # Make this right

      no ex::override 'ucfirst';

      ucfirst( 'MAKE THIS RIGHT' );
      # MAKE THIS RIGHT

DESCRIPTION
    "ex::override" is an easy way to override core perl functions.

  Overriding a function

      use ex::override
        length => \&mylength,
        open   => \&myopen;

    Overriding a core function happens at compile time. Arguments are
    passed to "ex::override" in a name based, or hash style. The key
    is the name of the core function to override, the value is your
    subroutine to replace the core's.

  Using an overriden funtion

    Nothing changes on the surface. If you override "stat", then you
    still use "stat" the same way.

    NOTE: This is only true if you are keeping the same prototype as
    the function you've overriden. To do this, you must define your
    prototype:

      use ex::override values => sub (\%) { values %{+shift} };

    If you don't use this same prototype or force yourself to use the
    function the same, you can extend the functionality of a core
    function:

      # length of all arguments passed to length()
      use ex::override length => sub { length join '', @_ };

  Overriding a function globaly

    Don't do this without a very good reason!

    "ex::override" allows you the ability to override core functions
    globaly. Any packages that inherit from yours will use your
    function override. There are good reasons for doing this, if you
    think you need to, make sure you have a good reason.

      use ex::override
        GLOBAL_length => sub {
                              # prevent someone from passing a list
                              croak "Don't do that!" if @_ > 1;
                              length shift
                             };

    NOTE: If you globaly override a function in a package, only that
    package can remove it.

  Removing your override

    This works the same way that "no strict" works.

      no ex::override; # remove _all_ overrides

      no ex::override 'values';

      no ex::override 'GLOABL_length';

TIPS
    Get a list of overrideable functions
        If you have the Perl source laying around, go to it's root dir
        and try this:

          perl -lne 'print /_(\w+)/ if /return -K/' toke.c

        You'll have to weed out which ones are functions
        ( vs. operators, etc. ).

    Get a functions prototype
          perl -lwe 'print prototype "CORE::length"'

        This prints the prototype, or "Use of uninitialized
        variable..." if there isn't one.

TODO
    Find a way to preserve prototypes so the user doesn't have to know
    them.

AUTHOR
    Casey R. Tweten, crt@kiski.net

COPYRIGHT
    Copyright (c) 2000 Casey R. Tweten <crt@kiski.net>. All rights
    reserved. This program is free software; you can redistribute it
    and/or modify it under the same terms as Perl itself.


print(join(' ', qw(Casey R. Tweten)));my $sig={mail=>'crt@kiski.net',site=>
'http://home.kiski.net/~crt'};print "\n",'.'x(length($sig->{site})+6),"\n";
print map{$_.': '.$sig->{$_}."\n"}sort{$sig->{$a}cmp$sig->{$b}}keys%{$sig};
my $VERSION = '0.01'; #'patched' by Jerrad Pierce <belg4mit at MIT dot EDU>


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

Date: 08 Nov 2000 15:20:38 -0600
From: Ren Maddox <ren.maddox@tivoli.com>
Subject: Re: Anonymous Data (probably very easy)
Message-Id: <m3u29ikvo9.fsf@dhcp11-177.support.tivoli.com>

dottiebrooks@my-deja.com writes:

> use List::Permutor;
> use strict;
> 
> my @result;
> 
> getemall('A', 'B', 'C', 'D');
> my $perm = new List::Permutor @result;

@result is an array of array refs.  I doubt List::Permutor::new is
expecting this.

> while (my @set = $perm->next) {
>     print "One order is @set.\n";
> }
> 
> sub getemall {
> 
>     for my $i (1 .. 1<<@_) {
>         push @result, [ map { ($i & 1<<$_)?$_[$_]:() } 0..$#_];
>     }
>     return @result;
> }

Just for fun, here's another solution that might be a little more
compatible with getemall's data:

#!/usr/local/bin/perl -w
use strict;
sub getemall {
  my @result;
  for my $i (1 .. 1<<@_) {
    push @result, [ map { ($i & 1<<$_) ? $_[$_] : () } 0..$#_];
  }
  return @result;
}
sub permute {
  return [] unless @_;
  my @result;
  for my $i ( 0 .. $#_ ) {
    push @result, map { [ $_[$i], @$_ ] } permute(@_[0..$i-1,$i+1..$#_]);
  }
  return @result;
}

print "@$_\n" for map { permute @$_ } getemall qw/A B C D/;
__END__


Being recursive, and not even efficiently so, this can get pretty
slow.  It shouldn't be too difficult to convert to an iterative
solution, or you could just Memoize it.  My quick testing showed that
8 elements is where it really starts to get slow... memoizing it
improved that from about 41 seconds to about 5 seconds.

-- 
Ren Maddox
ren@tivoli.com


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

Date: 8 Nov 2000 21:02:20 GMT
From: ilya@math.ohio-state.edu (Ilya Zakharevich)
Subject: Re: atoi for Perl
Message-Id: <8ucf0s$pt0$1@charm.magnus.acs.ohio-state.edu>

[A complimentary Cc of this posting was sent to Ilmari Karonen 
<usenet11269@itz.pp.sci.fi>],
who wrote in article <973672289.9127@itz.pp.sci.fi>:
> >>   dd> Does anyone know the "atoi()" function (from C) equivalent in Perl?
> >> 
> >> $x = $x ;
> >
> >Sorry, but this was atold()...
> 
> Oh well.  $x = int($x), then.

Wrong again...

perl -wle 'print int shift' 0.999999999999999999999999999
1

Ilya


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

Date: Wed, 08 Nov 2000 22:08:53 GMT
From: thamus <thamus@my-deja.com>
Subject: Re: atoi for Perl
Message-Id: <8ucite$ctv$1@nnrp1.deja.com>

In article <8ucf0s$pt0$1@charm.magnus.acs.ohio-state.edu>,
  ilya@math.ohio-state.edu (Ilya Zakharevich) wrote:
> [A complimentary Cc of this posting was sent to Ilmari Karonen
> <usenet11269@itz.pp.sci.fi>],
> who wrote in article <973672289.9127@itz.pp.sci.fi>:
> > >>   dd> Does anyone know the "atoi()" function (from C) equivalent
in Perl?
> > >>
> > >> $x = $x ;
> > >
> > >Sorry, but this was atold()...
> >
> > Oh well.  $x = int($x), then.
>
> Wrong again...
>
> perl -wle 'print int shift' 0.999999999999999999999999999
> 1

Hmmm, I've always used
perl -we "print pack 'B*', join '', reverse (1,0,0,0,1,1,0,0)"

It seems so much clearer and easier to understand! :)

--
Tom Kliethermes     90% of people give the rest of us a bad name.


Sent via Deja.com http://www.deja.com/
Before you buy.


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

Date: Thu, 9 Nov 2000 10:18:59 +1300
From: "Peter Sundstrom" <peter.sundstrom@eds.com>
Subject: Re: Emailing formatted
Message-Id: <8ucg5t$fjf$1@hermes.nz.eds.com>


abaltd <abaltd@ntlworld.com> wrote in message
news:mUyN5.80123$hk2.158083@news6-win.server.ntlworld.com...
> I'm trying to email an HTML-formatted message  to a list of folks - via
Perl
> script using Unix sendmail (on a hosted service).
>
> I know I can get sendmail to interpret To:  and CC: lines ok (using -t
> option)
> But how can I get it to process Content-type: multipart/alternative;
lines,
> so that I can send formatted emails?
>
> I found a comprehensive send_mail script on the web (re: extract from
> CGI/Perl Cookbook)
> Do I need to install this and/or have special SMTP server privileges?
>
> Any suggestions as to the simplest way forward appreciated.

Don't try to handle MIME by yourself.  It gets too messy and is easy to get
wrong.

Use MIME::Lite and optionally the pretty recent MIME::Lite::HTML modules

use MIME::Lite;
use MIME::Lite::HTML;


my $mailHTML = new MIME::Lite::HTML
From => 'MIME-Lite@alianwebserver.com',
To   => 'alian@jupiter',
Subject => 'Mail in HTML with images';


$MIMEmail = $mailHTML->parse('http://www.alianwebserver.com');
$MIMEmail->send; # or for win user : $mail->send_by_smtp('smtp.fai.com');







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

Date: 8 Nov 2000 21:37:03 GMT
From: Jonathan.L.Ericson@jpl.nasa.gov (Jon Ericson)
Subject: Re: file upload, determining file type, size, format
Message-Id: <8FE6896B1JonathanLEricsonjpln@137.78.50.25>

On 07 Nov 2000, ritche@san.rr.com (Ritche Macalaguim) wrote:

>Is there a way to determine a file's properties in Perl?

Have you read 'perldoc -f -X'?

>For example, what is the file's type? Text? Image? JPG? GIF? EXE? How
>about file size? 2k? 3Mb? Or image size? 120x10 px?

This problem has been solved many different ways.  It all depends on what 
context your in.  In HTTP for instance, you can use Content-Type to 
determine the file type.  But this ceases to be a perl question.

>Is there binary information in a file's header that reveals this
>information?

Once again, this depends on context and is not a perl question.

>Just wondering if anyone has figured this out or if it is in some module
>out there.

Have you tried http://search.cpan.org?

Jon


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

Date: 08 Nov 2000 14:13:07 -0600
From: Ren Maddox <ren.maddox@tivoli.com>
Subject: Re: Files on NFS
Message-Id: <m37l6emdd8.fsf@dhcp11-177.support.tivoli.com>

"Ildar Gabdullin" <ildar@mera.ru> writes:

> How I can determine from perl script whether the file reside on NFS or not ?

Use the stat function.  The first returned field is the device number
of the filesystem, which is (usually[1]) negative for NFS filesystems.
In fact, the documentation for the stat function even has an example
of this.

[1] Apparently this is OS-specific.  I have no idea what OSes do not
support this, nor what you should do instead on such an OS.

-- 
Ren Maddox
ren@tivoli.com


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

Date: Wed, 8 Nov 2000 21:10:04 +0100
From: "xarbosa" <xarbosa@yahoo.com>
Subject: Freshman parameter question
Message-Id: <973714038.213017@perla.rotterdam.luna.net>

First of all, Perl is cool.
I just started Perl 2 days ago and find it amazing that my 53K Visual Basic
app is now about 8 lines of pure Perl pleasure.

Anyway, here's the question:

App1 runs the .PL script so that it can generate some things.
However, variable %VOLUME% is defined in App1 and I want to send this
variable to the .PL script so that I can use it as say $volume.

How ?!?

I have looked all over (the book, Perl.com, CPAN.org) but all I can find are
the switches and they don't make a lot of sense to me.

Please help and TIA.
                                 Xarbos.




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

Date: 8 Nov 2000 20:56:04 GMT
From: nospam@hairball.cup.hp.com (Richard J. Rauenzahn)
Subject: Re: Freshman parameter question
Message-Id: <973716963.731919@hpvablab.cup.hp.com>

"xarbosa" <xarbosa@yahoo.com> writes:
>First of all, Perl is cool.
>I just started Perl 2 days ago and find it amazing that my 53K Visual Basic
>app is now about 8 lines of pure Perl pleasure.
>
>Anyway, here's the question:
>
>App1 runs the .PL script so that it can generate some things.
>However, variable %VOLUME% is defined in App1 and I want to send this
          ^
          ^ I think the keyword you're missing is 'environment variable'.  
	  See the perlvar manpage and the %ENV variable.

Rich
-- 
Rich Rauenzahn ----------+xrrauenza@cup.hp.comx+ Hewlett-Packard Company
Technical Consultant     | I speak for me,     |   19055 Pruneridge Ave. 
Development Alliances Lab|            *not* HP |                MS 46TU2
ESPD / E-Serv. Partner Division +--------------+---- Cupertino, CA 95014


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

Date: Wed, 8 Nov 2000 16:17:43 -0500
From: "Kurt Stephens" <kstep@pepsdesign.com>
Subject: Re: Freshman parameter question
Message-Id: <8ucfte$8q1$1@slb7.atl.mindspring.net>

"xarbosa" <xarbosa@yahoo.com> wrote in message
news:973714038.213017@perla.rotterdam.luna.net...

> App1 runs the .PL script so that it can generate some things.
> However, variable %VOLUME% is defined in App1 and I want to send this
> variable to the .PL script so that I can use it as say $volume.
>
> How ?!?

Hi Xarbos,

It sounds like you are looking for a way to serialize  %VOLUME% and pass it
to your perl script, however you have not described what %VOLUME% is - a VB
integer value, a Windows environment variable, a COM object, etc.

If the variable is a simple numeric or string value, you can pass it to the
script using command line parameters accessed through the @ARGV array.  You
refer to the command line parameters as $ARGV[0], $ARGV[1]....  See the
perlvar manpage for details.  Note that if you are passing a string that may
contain spaces, you need to put quotes around it.  If you need to pass a
string that contains both quotes and spaces, you're on your own.

A simple example is shown below:

<< show_arg.pl code >>
print "You entered \"$ARGV[0]\"\n";

<< Called from VB >>
Dim strMyArg As String,
Dim strMyScript As String
Dim strCmd As String

strMyScript = "show_arg.pl"
strMyArg = "For argument's sake..."
strCmd = "perl " & strMyScript & """" & strMyArg & """"

Shell strCmd

<< Called from perl >>
use strict;
use warnings;

my $my_script = 'show_arg.pl';
my $my_arg = "For argument's sake...";

system "perl $my_script \"$my_arg\"";

<< End code samples >>

If the variable that you are trying to pass is more complex than a simple
numeric or string value, you have several choices.  One is to serialize the
data to a file, and read the file in the perl script.  Other options would
require some sort of interprocess communication, such as opening a socket
(see IO::Socket on the perl end), using Windows DDE (see Win32::DDE) or
creating a COM object and accessing the objects data and methods using
Win32::OLE.

Hopefully this helps...

Kurt Stephens





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

Date: Wed, 08 Nov 2000 14:35:39 -0600
From: Michael Carman <mjcarman@home.com>
Subject: Re: Freshman parameter question
Message-Id: <3A09B91B.F6E76973@home.com>

xarbosa wrote:
> 
> App1 runs the .PL script so that it can generate some things.
> However, variable %VOLUME% is defined in App1 and I want to send this
> variable to the .PL script so that I can use it as say $volume.
> 
> How ?!?

The generic syntax is:
perl [switches] scriptname.pl [arg1 arg2 ... argn]

arg1 .. argn will then be placed into the special Perl variable @ARGV
which contains all the command line arguments. It's up to you to get
them out of there and do something useful with them.

Looks like you're calling perl from a batch file on Win*, so you would
say something like this:

perl myscript.pl %VOLUME%

and then, inside myscript.pl:

my $volume = $ARGV[0];

> I have looked all over (the book, Perl.com, CPAN.org) but all I can
> find are the switches and they don't make a lot of sense to me.

Make yourself familiar with the documentation that comes with Perl. For
most platforms, all you need to do is type "perldoc perldoc" at a
command prompt to get started.

[Tom Christiansen is cringing right now.]

The docs are also available online in various places. www.perldoc.com is
one of them. Makes searching more painful, IMHO, but some people prefer
that to learning a command-line tool.

-mjc


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

Date: Wed, 08 Nov 2000 22:08:38 GMT
From: jschauma@www.netmeister.org (Jan Schaumann)
Subject: help on improving code (pine2mutt-script ca 130 lines)
Message-Id: <slrn90jjrg.u37.jschauma@www.netmeister.org>

Hi all,

having just changed from pine to mutt I decided to write a little script that
converts the .addressbook into a mutt-alias-file. Here's what I have come up
with - it does the job, but I'd like to learn Perl in more depths and would
appreciate any feedback on how to improve the code, how to make it more
"perlish" etc.

TIA

-Jan

----- begin pine2mutt -----

#!/usr/bin/perl -w
use strict;

#declaration of variables used up here
my $PINE =  $ENV{HOME} . "/.addressbook";
my $MUTT =  $ENV{HOME} . "/.aliases";
my $VERSION = "0.1";
my $NAME = "pine2mutt";

#declaration of varibales we use lateron
my $nick = "";
my $name = "";
my $email = "";
my $tmp = "";

###
### command-line arguments handling

if (($ARGV[0]) && ($ARGV[0] ne "-h") && ($ARGV[0] ne "-v"))
{
    $PINE = $ARGV[0];
}

if ($ARGV[1])
{
    $MUTT = $ARGV[1];
}

if ($ARGV[2] || ($ARGV[0] && ($ARGV[0] eq "-h")))
{
    print "$NAME - a little script to convert a pine-addressbook to a
mutt-aliases-file\n";
    print "Usage: $NAME [-h] [from] [to]\n";
    print "from:\tpine-addressbook (default is ~/.address.book)\n";
    print "to:\tmutt-aliases-file (default is ~/.aliases)\n";
    exit(0);
}

if ($ARGV[0] && ($ARGV[0] eq "-v"))
{
    print "$NAME $VERSION\n";
    exit(0);
}

### end command line arguments handling
###



###
### begin main

open(PINE, "$PINE") or die "Cannot open pine's addressbook \"$PINE\"!\n";
open(MUTT, ">$MUTT") or die "Cannot open mutt's \"$MUTT\"!\n";

while (<PINE>)
{
    unless(/^#DELETED/) # pine keeps deleted email-addresses for a while
    {
        if (/\(/)
        {
            # pine has email-lists in parentheses
            s/\(//;
            /(.*?)\t(.*?)\t(.*?)$/;
            $nick = $1;
            $name = $2;
            $tmp = $3;
        }
        else
        {
            unless (/^\s/)  # ^\s means an email-list continues 
            {
              /(.*?)\t(.*?)\t(.*?)$/; # a normal entry is nick\tname\temail
                $nick = $1;
                $name = $2;
                $email = $3;
                $email =~ s/(.*?)\s(.*?)$/$1/;  # sometimes additional
												#information is appended to the email in $4
                print MUTT "alias $nick $email ($name)\n";
            }
        }

        if (($tmp) and (/^\s/)) # we have an email-list
        {
            s/\n|\s//;
            if (/\)/)       # end of the email-list
            {
                s/\)//;
                $tmp = $tmp . $_;
                $tmp =~ s/\s//g;
                $email = $tmp;
                print MUTT "alias $nick $email ($name)\n";
            }
            else
            {
                $tmp = $tmp . $_;
            }
        }
    }
}

close (PINE);
close (MUTT);

### end main
###

###
### now tell .muttrc where to look for aliases

my $found = 0;

open(MUTTRC, "$ENV{HOME}/.muttrc");
while(<MUTTRC>)
{
    if (/source (\~\/.aliases)|($MUTT)/)
    {
        $found = 1;
    }
}

close(MUTTRC);

if (!$found)
{
    open(MUTTRC, ">>$ENV{HOME}/.muttrc") or die "Can't open
$ENV{HOME}/.muttrc!\n";
    print MUTTRC "\n# aliases\n";
    print MUTTRC "source $MUTT\n";
    close(MUTTRC);
}

### we're done - bye bye
###

---- end pine2mutt ----           

If you're reading this, then I thank you again for going through the code :)

-Jan

-- 
Jan Schaumann <http://www.netmeister.org>

Now, son, you don't want to drink beer.  That's for daddys, and kids with
fake IDs.	-- Homer Simpson


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

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 V9 Issue 4847
**************************************


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