[7613] in Perl-Users-Digest
Perl-Users Digest, Issue: 1239 Volume: 8
daemon@ATHENA.MIT.EDU (Perl-Users Digest)
Tue Oct 28 14:37:25 1997
Date: Tue, 28 Oct 97 11:00:38 -0800
From: Perl-Users Digest <Perl-Users-Request@ruby.OCE.ORST.EDU>
To: Perl-Users@ruby.OCE.ORST.EDU (Perl-Users Digest)
Perl-Users Digest Tue, 28 Oct 1997 Volume: 8 Number: 1239
Today's topics:
ADVANCED: Clearing a namespace/package? <bsd@ameritech.net>
Re: Better ways to... (Tom Grydeland)
Re: Better ways to... <usenet-tag@qz.little-neck.ny.us>
Re: File name available in -n loops? (Colin Kuskie)
Filehandles and nested-if-loops <jjune@midway.uchicago.edu>
Re: fork() makes me wait (?) <seay@absyss.fr>
getting email address's from a file.. <Sales@Geko.COM>
help with suid and insecure dependency error (Randy Rokosz)
Re: help with suid and insecure dependency error (brian d foy)
Re: Help with this error? <usenet-tag@qz.little-neck.ny.us>
Re: How to send keystrokes from Perl to Win95 app (Ronald L. Parker)
Launching Perl <figuro@sprintmail.com>
object callbacks - a first attempt and call for discuss <sr@pc-plus.de>
Parsing with MIME Modules (Mitch Kutzko)
Please Help getting keystrokes. <Aaron@landru.com>
Re: Please Help getting keystrokes. (Matthew Cravit)
Re: Using ? in URL <mosse@infoseek.com>
Re: Using Perl Modules (Mike Stok)
Re: Using Perl Modules (Steven W McDougall)
Digest Administrivia (Last modified: 8 Mar 97) (Perl-Users-Digest Admin)
----------------------------------------------------------------------
Date: Tue, 28 Oct 1997 09:56:52 -0600
From: Brad Daugherty <bsd@ameritech.net>
Subject: ADVANCED: Clearing a namespace/package?
Message-Id: <34560B44.B1B4A8DF@ameritech.net>
Hello,
Does anybody know how I can clear an entire namespace/package
without knowing the variables. In theory I want to "undef($Q::*)".
Some of the leads I have had that don't work are:
undef %{$Q::};
Thanks,
Brad
------------------------------
Date: 28 Oct 1997 16:30:54 GMT
From: Tom.Grydeland@phys.uit.no (Tom Grydeland)
Subject: Re: Better ways to...
Message-Id: <slrn65c4pu.du5.Tom.Grydeland@mitra.phys.uit.no>
On Tue, 28 Oct 1997 10:27:36 -0400,
brian d foy <comdog@computerdog.com> wrote:
> the solution of the FAQ still works [...]
I didn't say it wouldn't. I just said it was overkill.
> brian d foy <comdog@computerdog.com>
--
//Tom Grydeland <Tom.Grydeland@phys.uit.no>
------------------------------
Date: 28 Oct 1997 17:05:22 GMT
From: Eli the Bearded <usenet-tag@qz.little-neck.ny.us>
Subject: Re: Better ways to...
Message-Id: <eli$9710281200@qz.little-neck.ny.us>
Eike Grote <eike.grote@theo.phy.uni-bayreuth.de> wrote:
> > I'm looking for other ways to add colons to a MAC address.
> > $fmac="123456789abc";
> > @fmac=($fmac=~/(\S\S)(\S\S)(\S\S)(\S\S)(\S\S)(\S\S)/);
> > $fmac=join(":",@fmac);
> Maybe you like this one:
>
> $fmac =~ s/(\S{2})(?!$)/$1:/g;
$fmac =~ s/(\S\S)\B/$1:/g;
Fewer keystrokes required; backwards compatible to perl 4.
Elijah
------
perl -e 's Y Yreverse q N ny pm ,srekcah lrep kroy wen emosNYex and s Pmp ynP
P and s MsMjust sMx and print and s NYPM MPYN Nis or reverse and print q q q'
------------------------------
Date: 28 Oct 1997 08:22:20 -0800
From: colink@latticesemi.com (Colin Kuskie)
Subject: Re: File name available in -n loops?
Message-Id: <6353fs$iau@sarek.latticesemi.com>
In article <633fme$gcl@news-central.tiac.net>,
Mike Stok <mike@stok.co.uk> wrote:
>
>That's a dumb example as $. doesn't get reset each script unless you use
>eof e.g.
>
>bash$ perl -ne 'print "$ARGV ($.): $_" if /and/; close ARGV if eof' *.pl
Wouldn't it be great if there was a switch to do that automagically?
Something on the lines of:
perl -gne 'print "$ARGV ($.): $_" if /and/;' *.pl
where -g causes perl to do the reset of $. for you at each eof.
Colin Kuskie
------------------------------
Date: Tue, 28 Oct 1997 16:30:45 GMT
From: Joseph June <jjune@midway.uchicago.edu>
Subject: Filehandles and nested-if-loops
Message-Id: <Pine.GSO.3.95.971028101541.23797A-100000@harper.uchicago.edu>
Hello,
If anyone can help me solve this problem, it will be GREATLY appreciated.
Currently I'm reading in a file to an filehandle via
while ($rulefile_line = <RULEFILE> ...
because i need to insert a generated potion into an file.
I am writing to the file by using syswrite...
if ($syswrite_hidden == 1) {
syswrite(ADDRX, $rulefile_line, length($rulefile_line));
copying line by line into the new file. The script knows where to insert
the file by reading the file to be inserted into...
using a series of nested if loops... via something like this:
if ($rulefile_line =~ m/\s+:rule_adtr\s+\(/ && $repeat != 1 )
{ $rulefile_buffer = <RULEFILE>;
if ($rulefile_buffer =~ m/\s+:src_adtr\s+\(/
{
$rulefile_buffer = <RULEFILE>;
# ^
# |
# Because I'm reading the next filehandle...
# syswrite does not "see" this line
# to write to the new file
if ($rulefile_buffer =~m/\s+:\s+$current_addtrx/ )
{
$rulefile_buffer = <RULEFILE>;
if ($rulefile_buffer =~ m/\s+\)/ )
<---snip--->
When the series of if loops are matched.. a variable value is changed
($syswrite_hidden) and syswrite stops... allowing the script to generate
and write in the new portion to be inserted.
The problem I am having is that because the nested if loop reads the next
<RULEFILE>, the syswrite does not write that particular line into the new
file. So the new file generated has blank lines... which were basically
the lines that were "read" by the nest if loop.
If anyone can suggest a way to solve this problem, i will forever be
greatful.
Thanks in advance for your kind help!
Regards
------------------------------
Date: Tue, 28 Oct 1997 16:32:21 +0100
From: Doug Seay <seay@absyss.fr>
To: Peter Tiemann <peter@preview.org>
Subject: Re: fork() makes me wait (?)
Message-Id: <34560585.FEE14D8@absyss.fr>
[posted and mailed]
comp.lang.perl is as dead as Perl4 (perhaps even more so). It hasn't
existed in several years. Ask your news admin to clean up her group
list.
Peter Tiemann wrote:
>
> Q: How do I fork a process without waiting for the child?
fork() doesn't wait for the child, at least not in Unix.
> I try to call a slow perl script from a HTML page. I do currently call the
> script, and use fork() as shown below to create a child process. I have the
> child process do the long-time taking work and expected to return directly
> back to the HTML document. (The child process will not create output.)
>
> But:
> The HTML document does not appear before the child process has finished.
>
> Why?
>
> ------------------------------
> #!/usr/bin/perl
^^^
where is the -w
I also recommend a "use strict;" up here
> $pid = fork();
> if ($pid)
> {
> # parent process
> print "Content-type: text/html\n\n";
> print "<html><BODY>Start-Stop</BODY></html>";
^^^
do you want/need a \n here?
> }
> elsif (defined $pid)
excellent, not enough people check for errors with fork()
> {
> # child process
> # .. some slow stuff ..
> }
I don't see any obvious problems with this other than sharing file
descriptors between the two processes. Maybe the system is buffereing
something until all references to the file are closed. Dunno for sure,
but my standard recomendations are
- the parent should flush all output buffers before the fork()
- the child should close unneeded file handles
- the child should explicitly exit (not die)
- doug
------------------------------
Date: Tue, 28 Oct 1997 03:20:15 +0000
From: Geko - Australian Marketing Division <Sales@Geko.COM>
Subject: getting email address's from a file..
Message-Id: <345559EC.2664@Geko.COM>
/*
* @(#) rip.c v1.0 (c) Dez Blanchfield 1997 Geko Pty Limited
(dez@geko.net.au)
*/
#include <stdio.h>
#define TRUE 1
#define FALSE 0
main() {
char *c,line[4096];
while( gets(line) ) {
c = &line[1];
while( *c != '\0' ) {
if ( * c == '<' ) {
*c++;
while ( *c != '>' ) {
if ( *c == '\0' )
break;
putc(*c,stdout);
*c++;
}
putc('\n',stdout);
break;
} else
*c++;
}
line[1] = '\0';
}
}a file..
------------------------------
Date: 28 Oct 1997 10:12:43 -0700
From: rokosz@ug2.plk.af.mil (Randy Rokosz)
Subject: help with suid and insecure dependency error
Message-Id: <6356eb$d1s$1@ug2.plk.af.mil>
Hi,
I have a suid perl script to add Unix accounts that used to work fine with
SunOS 4.1.x, but now breaks when creating the user's home directory under
Solaris 2.x with the following:
Insecure dependency in mkdir while running setuid at /home/useradm/.add_user
line 264.
This currently results from the following line:
mkdir ($home_dir, 0755);
Running these following commands also resulted in the same error:
system "/usr/bin/mkdir $homedir";
or:
exec "/usr/bin/mkdir $homedir";
The account that runs this script even has group permission to create this
directory and can modify the passwd file just fine.
I do the usual cleansing of my script and running it thru suidscript:
$ENV{'PATH'} = '/usr/ucb:/bin:/usr/bin';
$ENV{'SHELL'} = '/bin/sh' if $ENV{'SHELL'} ne '';
$ENV{'IFS'} = '' if $ENV{'IFS'} ne '';
$path = $ENV{'PATH'};
Thanks in advance!!
Randy Rokosz
------------------------------
Date: Tue, 28 Oct 1997 13:23:35 -0500
From: comdog@computerdog.com (brian d foy)
Subject: Re: help with suid and insecure dependency error
Message-Id: <comdog-ya02408000R2810971323350001@news.panix.com>
In article <6356eb$d1s$1@ug2.plk.af.mil>, rokosz@ug2.plk.af.mil (Randy Rokosz) wrote:
>Insecure dependency in mkdir while running setuid at /home/useradm/.add_user
>line 264.
>
>This currently results from the following line:
>mkdir ($home_dir, 0755);
have you untainted $homedir?
--
brian d foy <comdog@computerdog.com>
NY.pm - New York Perl M((o|u)ngers|aniacs)* <URL:http://ny.pm.org/>
CGI Meta FAQ <URL:http://computerdog.com/CGI_MetaFAQ.html>
------------------------------
Date: 28 Oct 1997 17:07:16 GMT
From: Eli the Bearded <usenet-tag@qz.little-neck.ny.us>
Subject: Re: Help with this error?
Message-Id: <eli$9710281154@qz.little-neck.ny.us>
Henry Hwangbo <skooky@primenet.com> wrote:
>
>
> --
>
Hmmm. Offhand my best guess is that you have a line in your post that
matches /^[.]$/ and your newsreader is not clever enough to escape it
before sending the post off to the newsserver. Not sure why you had your
whole post after the the signature tear line though.
Elijah
------
perl -e 's Y Yreverse q N ny pm ,srekcah lrep kroy wen emosNYex and s Pmp ynP
P and s MsMjust sMx and print and s NYPM MPYN Nis or reverse and print q q q'
------------------------------
Date: Tue, 28 Oct 1997 17:59:53 GMT
From: ron@farmworks.com (Ronald L. Parker)
Subject: Re: How to send keystrokes from Perl to Win95 app
Message-Id: <345627ca.11444626@news.supernews.com>
On 27 Oct 1997 14:00:45 GMT, "L. Dwynn Lafleur" <lafleur@usl.edu>
wrote:
>Is it possible to send keystrokes from a running Perl script to a Win95
>application that the script has opened? For example, from a Perl script,
>can I open Notepad and then issue a command in the script to insert a text
>string into the Notepad document?
Try using Win32::API and use the SendMessage or PostMessage function.
You might need to get your hands on an SDK reference, and the whole
thing might be a bit of work, but it can be done.
------------------------------
Date: Tue, 28 Oct 1997 10:55:02 -0700
From: Robert Collins <figuro@sprintmail.com>
Subject: Launching Perl
Message-Id: <345626F6.6B1A390D@sprintmail.com>
Hi there: Now that I installed and tested perl on this
Linux machine how do I get output or launch it ??
Or, where do I get the instructions ?? Thanks
Bob C
------------------------------
Date: Tue, 28 Oct 1997 18:59:34 +0100
From: Stephen Riehm <sr@pc-plus.de>
Subject: object callbacks - a first attempt and call for discussion
Message-Id: <34562805.41C6@pc-plus.de>
This is a multi-part message in MIME format.
--------------167E2781446B
Content-Type: text/plain; charset=us-ascii
Content-Transfer-Encoding: 7bit
Hi Perl Hackers,
For the program I'm writing at the moment, I had the idea that it would
be really cool to have the backed define, when, and what, gets updated
in the GUI. In the Tk stuff there's the very nice "after" routine,
which triggers a Tk object after a certain number of milliseconds -
but I couldn't get it to work on normal perl objects, so I kludged
up the following module which does. It only has a resolution of seconds,
and its use means that your application isn't allowed to use sleep()
any more, but perhaps someone finds it useful.
I would also greatly appreciate any comments regarding its robustness,
usefulness or other features. If I get enough feedback, I'll try to
put it up on CPAN for all to abuse - er, I meant admire of course :-)
Usage:
the file included below is essentially the module, with a more
or less complete test suite tacked on the bottom (commented out).
Essentially, you can "register" any object you like to be triggered
either after a delay (given in seconds) or at a given time (see the
comments for formatting details).
You also have to specify a method to be used to trigger the object,
The same object may only be registered once (thus an object can
re-register itself in the trigger method, without fears of it being
multiply registered)
to try it out, simply uncomment the test stuff at the bottom, and
do a perl ./ObjectTimer.pm
Thanks in advance for any feedback, (even if you are forced to tell
me that there's a simpler wait to do it, ie: object->after(10) :-)
Steve
--
// __________________________ ._ o ________________________________
\\\\ Stephen Riehm / //\. Stephen.Riehm@pc-plus.de
//// pc-plus ' \>> | Phone: +49 89 45566 148
\\ 81675 Munich, Germany \\ ` Fax: +49 89 45566 113
--------------167E2781446B
Content-Type: text/plain; charset=us-ascii; name="ObjectTimer.pm"
Content-Transfer-Encoding: 7bit
Content-Disposition: inline; filename="ObjectTimer.pm"
########################################################################
#
# Description:
#
# ObjectTimer.pm
# This module is used to allow objects to send
# themselves messages after a self-deturmined amount of
# time.
# If two objects register for an alarm at the same time,
# both will get a callback.
# If an object tries to register itself twice for the
# same time, the first entry will be overwritten, and
# the callback method will only be called once.
# If an object sets the alarm for a delay of 0 seconds,
# then all entries for that object will be removed, if a
# method is also specified, then only entries for that
# object / method pair are removed.
#
# RESTRICTION: The rest of the script using this module may NOT
# use the alarm() call (or the ALARM signal), however,
# any object can register itself to have an alarm set
#
########################################################################
#
# Attributes:
# %callbacks a table of object and function
# references, indexed by the time of day.
# @callbackqueue a sorted list of registered callback
# times
#
########################################################################
#
# Methods:
# objectAlarm( object => $objectRef, method => $methodRef,
# delay => $delayInSeconds, time => $timeStamp )
# register an object to be triggered at some time in the
# future. The objectRef, and the methodRef are mandatory
#
# alarmHandler [internal]
# this is the routine which is triggered by the alarm,
# which sets up the next alarm and calls the methods of
# the waiting objects. Multiple objects may be triggered
# by the same alarm event
#
########################################################################
#
# Administration:
#
# Author: Stephen Riehm, PC-Plus Computing, Germany
# Maintainer: Author
# Creation date: 07.10.97
# Version date: %E% %U%
#
########################################################################
# "@(#) %W%, %I%"
package ObjectTimer;
use Exporter;
use Time::Local;
use Carp;
use strict;
use vars qw( $VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS );
@ISA = qw( Exporter );
@EXPORT = qw( &objectAlarm );
#
# class variables
#
my @events;
BEGIN
{
$SIG{'ALRM'} = \&alarmHandler; # what to do when an alarm occurs
@events = (); # array, sorted by time, of events to handle
}
#
# routine to register an object and method to call back at some time
# in the future
# If the time specified has already passed, then the object will be
# called back in 1 second.
#
sub objectAlarm
{
my %parameters = @_;
my $key;
my $value;
my $alarmTime;
my $event;
# ensure that the parameters have been properly specified
while( ( $key, $value ) = each( %parameters ) )
{
$key =~ s/^-//;
$parameters{$key} = $value;
if( $key !~ /(object|method|delay|time)/ )
{
carp "objectAlarm: $key is not a supported option\n";
}
}
# check individual options. an object reference must be specified
unless( ref( $parameters{"object"} ) )
{
carp "objectAlarm: no object specified, no new alarm set";
return( 0 );
}
# if a method has been given, make sure that it is a reference to
# a method.
if( $parameters{"method"} && ( ref( $parameters{"method"} ) ne "CODE" ) )
{
carp "objectAlarm: method parameter is not a reference to a method. No new alarm set\n";
return( 0 );
}
# at least one of the time related options must be set, even if it
# has been set to 0.
if( ( $parameters{"time"} ne "" ) == ( $parameters{"delay"} ne "" ) )
{
carp "objectAlarm: no time specified, no new alarm set";
return( 0 );
}
else
{
#
# convert the delay into a timestamp, or cleanup the timestamp
# if a timestamp was given.
# Timestamp is used as the index to the table of coming events
#
if( $parameters{"time"} )
{
#
# parse a time string, and turn it into a unix time stamp,
# which is used as the key to the table of alarm events
#
# time string must look like this:
# [[cc]yy-mm-dd ]hh:mm[:ss]
#
@_ = ();
@_ = ( $parameters{"time"} =~
/^\s*((\d{2})?(\d{2})-(\d{1,2})-(\d{1,2})\s+)?(\d{1,2}):(\d{2})(:(\d{2}))?\s*$/ );
my ( $cent, $year, $mon, $mday, $hour, $min, $sec );
( $cent, $year, $mon, $mday, $hour, $min, $sec )
= @_[1,2,3,4,5,6,8];
$mon -= 1 if $mon; # valid range from 0-11
# printf "time now: %d-%d-%d %d:%d:%d\n", $year, $mon, $mday, $hour, $min, $sec;
# ||= doesn't work on lists!
( $year, $mon, $mday, $hour, $min, $sec )
= set_list_defaults( [ $year, $mon, $mday, $hour, $min, $sec ],
[ (localtime( time() ))[5,4,3,2,1,0] ] );
# ( $year, $mon, $mday, $hour, $min, $sec )
# ||= (localtime( time() ))[5,4,3,2,1,0];
# printf "time then: %d-%d-%d %d:%d:%d\n", $year, $mon, $mday, $hour, $min, $sec;
$year += $cent * 100;
$year -= 1900 if $year > 1900;
$alarmTime = timelocal( $sec, $min, $hour, $mday, $mon, $year );
}
if( $parameters{"delay"} )
{
# convert the delay (in seconds) to a time stamp
$alarmTime = time() + $parameters{"delay"};
}
#
# using the alarm time, register the object in the table of
# events
#
$event = {
"object" => $parameters{"object"},
"method" => $parameters{"method"},
"time" => $alarmTime,
};
# print "object ", ${$event}{object}, "scheduled for: ", $alarmTime, "\n";
@events = sort { ${$a}{"time"} <=> ${$b}{"time"} } ( @events, $event );
#
# this is not so pretty, but duplications need to be handled somehow
#
my $index = 0;
my %seen = ();
while( $index <= $#events )
{
my $obj = ${$events[$index]}{object};
if( $seen{$obj}++ || ( ${$events[$index]}{method} eq "" ) )
{
splice( @events, $index, 1 );
}
else
{
$index++;
}
}
#
# set the alarm to go off
#
setAlarm();
}
}
sub setAlarm
{
#
# set the alarm to go off in time for the next alarm in the
# list.
#
return unless @events;
my $nextAlarmTime = ${$events[0]}{"time"};
my $nowTime = time();
# print "alarmTime is $nextAlarmTime\n";
# print "nowTime is $nowTime\n";
my $delay = $nextAlarmTime - $nowTime;
$delay = 1 if $delay < 1;
# print "delay would appear to be $delay seconds\n";
alarm( $delay );
# print out the list of waiting events
# for debugging only
# print "waiting objects:\n";
# foreach( @events )
# {
# print " ", ${${$_}{"object"}}{"name"}, "\n";
# }
}
#
# without making any assumptions about the way alarm signals are
# handled, this routine triggers all the objects which were waiting
# for this alarm, and then sets up the next alarm time.
#
sub alarmHandler
{
my $now = time();
#
# there may be a delay in processing of signals - so process all
# the alarms up to the current time
#
while( $events[0] && ( ${$events[0]}{"time"} <= $now ) )
{
my $object = ${$events[0]}{"object"};
# print "object name: ", $object->{name}, "\n";
my $method = ${$events[0]}{"method"};
# print "alarm triggered for ${object}->${method}\n";
&{$method}( $object ); # call the method, giving the object
# as the first argument
shift( @events );
}
setAlarm;
}
sub set_list_defaults
{
my $list1 = shift;
my $list2 = shift;
my @result = ();
# print "list1: ", join( " ", @{$list1} ), "\n";
# print "list2: ", join( " ", @{$list2} ), "\n";
while( $a = shift( @{$list1} ) , $b = shift( @{$list2} ) )
{
push( @result, $a || $b );
}
# print "default list: @result\n";
return( @result );
}
1;
# #
# # test cases
# #
package testClass;
my $object_number = 1;
sub new
{
my $class = shift;
my $name = shift;
my $self = {};
$self->{name} = $name || "Test Object " . $object_number++;
return bless $self, $class;
}
sub my_name
{
# print "args: @_\n";
my $self = shift;
print "my name is ", $self->{name}, "\n";
};
package ObjectTimer;
print "testing ObjectTimer module\n";
print "You should see 7 carps, and a bunch of 'my name is' messages\n";
print "Test Object 4 shuold be the last object\n";
print "press return to continue, and then again to exit!\n";
$_ = <STDIN>;
# should give an error
objectAlarm( );
# should give an error
objectAlarm( object => new testClass );
objectAlarm( object => new testClass, delay => 5 );
# should give an error
objectAlarm( object => new testClass, method => \&testClass::my_name );
objectAlarm( object => new testClass, method => \&testClass::my_name, delay => 5 );
objectAlarm( object => new testClass, method => \&testClass::my_name, delay => 4 );
objectAlarm( object => new testClass, method => \&testClass::my_name, delay => 3 );
objectAlarm( object => new testClass, method => \&testClass::my_name, delay => 2 );
objectAlarm( object => new testClass, method => \&testClass::my_name, delay => 2 );
objectAlarm( object => new testClass, method => \&testClass::my_name, time => "17:57:20");
objectAlarm( object => new testClass, method => \&testClass::my_name, time => "1997-10-22 19:15" );
objectAlarm( object => new testClass, method => \&testClass::my_name, time => "97-10-22 19:15:13" );
objectAlarm( object => new testClass, method => \&testClass::my_name, time => "97-10-22 19:15" );
objectAlarm( object => new testClass, method => \&testClass::my_name, time => "12:45" );
objectAlarm( object => new testClass, method => \&testClass::my_name, time => 476 );
objectAlarm( object => new testClass, method => \&testClass::my_name, time => 1 );
# should give an error
objectAlarm( object => new testClass, method => \&testClass::my_name, time => 2, delay => 5 );
# should give an error
objectAlarm( object => new testClass, junk => "5" );
objectAlarm( object => new testClass, delay => 0 );
# should give an error
objectAlarm( time => 1, delay => 5 );
$_ = <STDIN>;
--------------167E2781446B--
------------------------------
Date: Tue, 28 Oct 1997 16:19:48 GMT
From: mitch@uiuc.edu (Mitch Kutzko)
Subject: Parsing with MIME Modules
Message-Id: <34560e4a.1392562@news.cso.uiuc.edu>
Hi, folks -- I posted at the beginning of the month with a problem
trying to parse MIME attachments. Here's a script that handles things
just fine, that I put together with help from Matthew Cravit.
(Thanks, Matthew!!)
Now I need to be able to generate a list of the suggested names for
all the attachmentsl, and write them out to a master index file. The
problem is that I can't figure out how dump_skeleton does it. (The
problem I had getting started with this is that I've never worked with
Objected Oriented code before, and have *no* clue what most of these
routines do... Are we having fun yet? ;-) )
Can someone lend a hand here? This script works fine, as far as it
goes -- It just doesn't do everything I need it to.
Thanks!!
Mitch
-----------------------------------------------------------------------
#!/usr/bin/perl -w
# This is the module that handles email stuff!!
use Mail::Internet;
# This module handles MIME attachments
use MIME::Parser;
# Establish our output file for testing purposes
# (Note that the leading ">" indicates that this file is to be opened
# in write mode, trashing any previous contents.)
$outfile = ">/usr/people/mitch/testout";
$stdinout = "/usr/people/mitch/stdinout";
$outputdir = "/usr/people/mitch/mimemail";
# open it
open(OUTFILE, $outfile) || die ("OUTFILE open failed" );
# leaving off the "\n" newline char
# in the text of the -die- causes
# it to print error info!
print STDERR ("Output file opened successfully.\n" );
# open file to hold contents of STDIN, so I can save it to pipe
# back into the multiple Perl Modules that each want to read STDIN....
open(STDINOUT, ">$stdinout") || die ("STDINOUT open failed" );
# leaving off the "\n" newline char
# in the text of the -die- causes
# it to print error info!
print STDERR ("STDIN Output file opened successfully.\n" );
# Now actually do the save to the file....
while (<STDIN>) {
print STDINOUT ($_);
}
# Close the file for write, and then open it for read.
close(STDINOUT);
open(STDINOUT, $stdinout) || die ("Second STDINOUT open failed" );
# leaving off the "\n" newline char
# in the text of the -die- causes
# it to print error info!
print STDERR ("Second STDIN Output file opened successfully.\n" );
# Once we get here, STDIN has been saved to STDINOUT. Woowoo!
# Get the current message from STDIN
$message = new Mail::Internet(\*STDINOUT);
# Just grab some basic info ....
$date = $message->head()->get('Date');
$from = $message->head()->get('From');
$to = $message->head()->get('To');
$subj = $message->head()->get('Subject');
$mid = $message->head()->get('Message-Id');
# grab the message ID up to the @ symbol, and print it out...
# "$mid" on the left must be in parens so Perl knows that it's an
# array, so it doesn't get confused and think I'm trying to be far
# more clever than I am, doing something with implicit arrays, etc...
# So, this splits $mid (on the right) at each "@" symbol, and returns
# stuff to the left of the "@" into $mid (on the left).
($mid) = split('@', $mid);
# This is the second pass, where we strip off the leading "<", which
# doesn't make mkdir very happy... "$one" is a dummy var just used
# to make the split work...
($one,$mid) = split('<', $mid);
# now generate the actual directory we'll be sending output to.
# It exists beneath "$outputdir" as directory "$mid".
# The "0" leading the 775 is *very* neccesary, since it let's perl
# know that I'm using OCTAL, not decimal for the file permissions!
mkdir "$outputdir/$mid", 0775;
# Now print it out to the output file.
print (OUTFILE "Date = $date\nFrom = $from\nTo = $to\nSubject =
$subj\nID = $mid\n");
# Print the body of the message out to file handle "OUTFILE"
$message->print_body(*OUTFILE);
# "rewind" the file so I can read STDINOUT again.
seek STDINOUT,0,0;
# Now check and see what the scoop is for any MIME attachments
# Create parser, and set the output directory:
my $parser = new MIME::Parser;
$parser->output_dir("$outputdir/$mid");
# With this line commented in, the file created for the actual textual
# body of the mail message that contains the MIME stuff will be
# prefaced with whatever's between the quotes...
#$parser->output_prefix("part");
# Parse input:
$entity = $parser->read(\*STDINOUT) or die "couldn't parse MIME
stream";
# This is way, way, way, hosed... Here's where I get lost...
#
# Added this in to try to grab the suggested name for the mime
attachment
#$filename = $head->recommended_filename;
#print (OUTFILE "Recommended Name= $filename\n");
# Take a look at the top-level entity (and any parts it has):
$entity->dump_skeleton;
# Whack the stdinout temp file, since we no longer need it.
unlink ($stdinout);
exit(0);
------------------------------
Date: Tue, 28 Oct 1997 10:17:39 -0500
From: Aaron Addison <Aaron@landru.com>
Subject: Please Help getting keystrokes.
Message-Id: <345601E5.41C6@landru.com>
Hello,
I hope someone can help me, I need to from within perl, check to see
if there is a keystroke waiting, and if not to go on with its tasks,
kinda like press any key to stop. A 'flowchart' of what I want to do
is.
Top of loop:
If there is keyboard activity -> Get command from user
Else -> Print new messages for user
return to Top of Loop:
This way, when you are typing commands you wont have new data showing
up (on top of what your writing).
I have Tryed.
sub key_ready {
local($rin, $nfd);
vec($rin, fileno(STDIN), 1) = 1;
return $nfd = select($rin,undef,undef,0);
}
From the FAQ, but it only reports when there is a data with a <CR> at
the end.
I have tryed.
$BSD = -f '/vmunix';
if ($BSD) {
system "stty cbreak </dev/tty >/dev/tty 2>&1";
}
else {
system "stty", 'cbreak',
system "stty", 'eol', '^A'; # note: real control A
}
$key = getc(STDIN);
if ($BSD) {
system "stty -cbreak </dev/tty >/dev/tty 2>&1";
}
else {
system "stty", 'icanon';
system "stty", 'eol', '^@'; # ascii null
}
print "\n";
But it stops and waits for the input.
Can someone help me? If you could post and email me any ideas you
have. Thanks.
Aaron Addison
Aaron@landru.com
------------------------------
Date: 28 Oct 1997 10:25:18 -0800
From: mcravit@best.com (Matthew Cravit)
Subject: Re: Please Help getting keystrokes.
Message-Id: <635ame$l18$1@shell3.ba.best.com>
In article <345601E5.41C6@landru.com>, Aaron Addison <Aaron@landru.com> wrote:
>Hello,
> I hope someone can help me, I need to from within perl, check to see
>if there is a keystroke waiting, and if not to go on with its tasks,
>kinda like press any key to stop.
Look into the Term::ReadKey module on CPAN, which I think will do what you
need.
/MC
--
Matthew Cravit, N9VWG | Experience is what allows you to
E-mail: mcravit@best.com (home) | recognize a mistake the second
mcravit@taos.com (work) | time you make it.
------------------------------
Date: Mon, 27 Oct 1997 16:14:30 -0800
From: Ed Moss <mosse@infoseek.com>
Subject: Re: Using ? in URL
Message-Id: <34552E66.6ECC@infoseek.com>
The web server will hand that value off to the CGI script in the form
of the environment variable: $ENV{'QUERY_STRING'}
So that $ENV{'QUERY_STRING'} would equal "position=quiz"...
ECSSPEAR@livjm.ac.uk wrote:
>
> I want to access a script but actually sending some info to the script
> using the ? in the URL Eg.
>
> /cgi-bin/access.cgi?position=quiz
>
> How do I get the script to pick up the value position?
>
> Any help greatfully received!
>
> Simon Pearce
--
Ed Moss
ph. (408) 543-6793
------------------
"There are two major products to come out of Berkeley:
LSD and UNIX. We don't believe this to be a coincidence."
------------------------------
Date: 28 Oct 1997 16:09:18 GMT
From: mike@stok.co.uk (Mike Stok)
Subject: Re: Using Perl Modules
Message-Id: <6352ne$3of@news-central.tiac.net>
In article <34560B35.5A7D@datahost.com>,
Michael Stearns <michael@datahost.com> wrote:
>Thanks for these suggestions.
>
>I am new to UNIx and I am unclear what MakeMaker is. Do you mean the
>utility called "make" or is it something else that I might need to
>install?
MakeMaker is a module that comes as standard with perl, and you should be
able to view its documentation by saying
perldoc MakeMaker
and the description includes
DESCRIPTION
This utility is designed to write a Makefile for an
extension module from a Makefile.PL. It is based on the
Makefile.SH model provided by Andy Dougherty and the
perl5-porters.
It helps the module writer write a generic recipie, Makefile.PL, which
generates the "right" Makefile because MakeMaker knows how to get hold of
various compile & installation options which are specific to your
installation (e.g. installation directories, special C compiler or plags
etc.)
If you have a reasonably recent perl (version 5.xxx) then you should get
familiar with perldoc as it's a useful tool for reading perl's
documentation and the documentation embedded in perl modules
perldoc perldoc
or
perldoc perl
should give you a some starting points.
Hope this helps,
Mike
--
mike@stok.co.uk | The "`Stok' disclaimers" apply.
http://www.stok.co.uk/~mike/ | PGP fingerprint FE 56 4D 7D 42 1A 4A 9C
http://www.tiac.net/users/stok/ | 65 F3 3F 1D 27 22 B7 41
stok@psa.pencom.com | Pencom Systems Administration (work)
------------------------------
Date: Tue, 28 Oct 1997 17:34:26 GMT
From: swmcd@world.std.com (Steven W McDougall)
Subject: Re: Using Perl Modules
Message-Id: <EIrvHF.50M@world.std.com>
Michael Stearns <michael@datahost.com> writes:
>Hello:
>Are there generic instructions available on installing and accessing
>Perl Modules? I searched but did not find any.
There is some overview at
http://world.std.com/~swmcd/steven/perl/
- SWM
------------------------------
Date: 8 Mar 97 21:33:47 GMT (Last modified)
From: Perl-Request@ruby.oce.orst.edu (Perl-Users-Digest Admin)
Subject: Digest Administrivia (Last modified: 8 Mar 97)
Message-Id: <null>
Administrivia:
The Perl-Users Digest is a retransmission of the USENET newsgroup
comp.lang.perl.misc. For subscription or unsubscription requests, send
the single line:
subscribe perl-users
or:
unsubscribe perl-users
to almanac@ruby.oce.orst.edu.
To submit articles to comp.lang.perl.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 1239
**************************************
