[9034] in Perl-Users-Digest

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

Perl-Users Digest, Issue: 2652 Volume: 8

daemon@ATHENA.MIT.EDU (Perl-Users Digest)
Wed May 20 21:07:26 1998

Date: Wed, 20 May 98 18:00:28 -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           Wed, 20 May 1998     Volume: 8 Number: 2652

Today's topics:
        A newbie question of some stringy dimensions... <qob@coffeenet.net>
    Re: Benchmark: local filehandle vs. Filehandle.pm <danboo@negia.net>
    Re: Cryptography in Perl? <rootbeer@teleport.com>
    Re: file locking question (Bryan Miller)
    Re: Flat-File db recommendation <bobbacola@pipeline.com>
        Help on stripping a string <aaa@dms2.com>
    Re: Inter-process file arbitration? <tchrist@mox.perl.com>
        Newbie needs help! <zygotech@*remove*.itsnet.com>
    Re: Newbie needs help! (Tina Marie Holmboe)
    Re: Newbie needs help! <ahdiii@webspan.net>
        Perl and C++, MFC. <ztsaba@iil.intel.com>
        Perl and C++, MFC. <ztsaba@iil.intel.com>
    Re: perl compiler for winnt <rootbeer@teleport.com>
    Re: Perl for Windows is important, and comments on COM  <rootbeer@teleport.com>
    Re: Perl Net::Telnet() (Martien Verbruggen)
    Re: perl variables <palincss@tidalwave.net>
    Re: Sockets and system() give segfault <rootbeer@teleport.com>
    Re: translate A-Z to 1-26 <ljz@asfast.com>
    Re: unpacking signed network ints <rootbeer@teleport.com>
        uploading but getting 0 bytes (chris chapman)
    Re: Where is warning about PERL 5.001? (Martien Verbruggen)
    Re: Why does "each" not go thru entire hash?? <palincss@tidalwave.net>
        writing image from http request to file <playinmantis@earthlink.net>
    Re: Year2000 compliant? <merlyn@stonehenge.com>
    Re: Year2000 compliant? (Michael J Gebis)
    Re: |more trouble and more... <rootbeer@teleport.com>
        Digest Administrivia (Last modified: 8 Mar 97) (Perl-Users-Digest Admin)

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

Date: Wed, 20 May 1998 17:22:53 -0700
From: Annalisa <qob@coffeenet.net>
Subject: A newbie question of some stringy dimensions...
Message-Id: <356373DD.5FD3F750@coffeenet.net>

Hi,

Sorry if this is one request of a long @strings indentical in nature(I
mean of the newbie module)...BUT here goes:

I'm using a script from Paul Helinski's book Website Automation Toolkit
and there's a central script that wraps html.middles to headers.

The code works beautifully if I have different headers and footers to go
with different middles.html files.  "Text.txt" files are fed by
index.cgi into the middles.html where $HEADER, $titlethispage, and
$FOOTER are called (from the middle.html file) and then these are
printed to screen.

The main code, which for simple purposes I am calling index.cgi (since
it is the first script called by default), anyway it also incorporates a
jumplist of links to other pages at the website. These are listed in a
config file by a combination of %arrays depending on the variables a
page requires. These %arrays are keyed by the filename.html:

%titlenames = 	("filename.html" => "Title of My Page",
		"filename2.html" => "Title of My Second Page",
		"filename3.html" => "Title of My Third Page");

and then headers and footers are in this format:

%headers = 	("filename.html" => "head1.txt",
		"filename2.html" => "head2.txt",
		"filename3.html" => "head1.txt");

%footers = 	("filename.html" => "foot1.txt",
		"filename2.html" => "foot2.txt",
		"filename3.html" => "foot3.txt");

Like I said these are listed in the config file.

So here's the script the DOESN't wrap the pages right... it DOES print
the forms properly but doesn't print the corresponding headers and
footers as index.cgi does. (both scripts feed off the same config file).

Before I list the code to tickler.cgi please note that I have altered it
to include the bit of code appearing between "&ReadParse" and the
subroutine "JumpGate".  I have also altered the subroutine
"print_to_file" appearing near the end of the script as my feeble
attempt to insert headers and footers if they appear in the called text
or html file.

But I haven't had any luck whatsoever.

You help is most humbly appreciated as I have worked on this script for
nearly a week with little success.

The other part I have has to do with the email that the script sends. 
It doesn't insert my value for $adminemail, but instead gives the
default email of "nobody@server.com" from sendmail.

So what's going on here? Oh great ones!


#! /usr/local/bin/perl5
#
############################################################################
## This code is part of Tickler
## both Trademarks of and Copyright (C) 1996, World Media Services.
## The toolkit from World Media is at http://www.world-media.com/toolkit
## All Rights Reserved.
## Authored by Barrett W. Nuzum and Paul Helinski
############################################################################

require "cgi-lib.pl";
require "config.cfg";

$| = 1;

&ReadParse;


@queryarray = keys (%in);
if ($queryarray[0] eq "") {
    $queryarray[0] = "form.html"; #if tickler is called default to
form.html
}
$document_filename = $queryarray[0];

$headerfile = $headers{"$document_filename"};
$thispagetitle = $titlenames{"$document_filename"};
$footerfile = $footers{"$document_filename"};




   
##########################################################################
sub JumpGate {
    ##################################################################
    ## This vital function takes a filename as it's sole parameter, and
    ## returns a string. It makes a small table/HTML form to allow your
    ## visitors to jump to any page on the site with a simple press of a
    ## button. It uses the hash %jumpnames from the configuration
    ## file, which you will need to set before using $JUMPLIST or
$TEXTLIST.

    local($fname) = $_[0];
    $TEXTLIST = " ";
    $JUMPLIST =<<END;
<br>
<FORM METHOD=POST ACTION=index.cgi>
<TABLE BORDER=0 CELLSPACING=0 CELLPADDING=0 ALIGN=center>\n<tr>
END
    $JUMPLIST .= "<TH><SELECT NAME=redirect>";
    foreach $item (sort keys(%jumpnames)) {
        if ($fname eq $item) {
            $JUMPLIST .= "<OPTION SELECTED VALUE=$file_number{$item}>";
            $JUMPLIST .= "$jumpnames{$item}\n";
        } else {
            $JUMPLIST .="<OPTION
VALUE=$file_number{$item}>$jumpnames{$item}\n";
        }
        $TEXTLIST .= "<a href=\"?$item\">$jumpnames{$item}</a><BR> ";
    }
    $JUMPLIST .= "</SELECT>\n<BR>";
    $JUMPLIST .= "<TH><INPUT TYPE=SUBMIT
VALUE=\"Jump!\">\n<BR></TABLE><BR>\n";
    $JUMPLIST .= "</FORM>";
    $TEXTLIST .= "<BR>";
}
&JumpGate(form.html);
open(STDERR, ">> errorfile");                    

$HEADER = &file_to_string($headerfile);       
$FOOTER = &file_to_string($footerfile);

if ($ENV{'REQUEST_METHOD'} eq "POST") {
        if ($in{'Completed'} eq "1") {
                &add_to_db;
                
        } elsif ($in{'Completed'} eq "nuke") {
                &remove_from_list;
                
        } elsif ($in{'send_update'} eq "yes") {
                &send_update;
                
        }
} else {
        $updatelist = "<SELECT MULTIPLE SIZE=10 NAME=\"groups\">\n";
        if ($ENV{'QUERY_STRING'} =~ /admin/) {
                foreach $key (keys(%ticklerpages)) {
                        $updatelist .= "<OPTION
VALUE=\"$key\">$ticklerpages{$key}\n";
                }
                $updatelist .="</SELECT>\n";
                        
                $adminform=<<END;
<FORM METHOD=POST ACTON="$ENV{'SCRIPT_NAME'}">
<INPUT TYPE=HIDDEN NAME="send_update" VALUE="yes">
<HR><BR><CENTER>
<TABLE BORDER=0>
<TR><TH ALIGN=left>Select the documents you have updated:
<TR><TH>$updatelist
<TR><TH>Enter your Password:<br><INPUT TYPE="Password" NAME="password"
size=20>
<TR><TH><INPUT TYPE="Submit" VALUE="Send Update Notification"><BR>
</TABLE><P><HR></FORM>
END

                &give_menu;
                
        } else {
                $updatelist .= "<OPTION VALUE=\"all\">All Registered
Pages\n";
                        
                foreach $key (keys(%ticklerpages)) {
                        $updatelist .= "<OPTION
VALUE=\"$key\">$ticklerpages{$key}\n";
                }
                        
                $updatelist .="</SELECT>\n";
                                
                $form=<<END;
<FORM METHOD=POST ACTION="$ENV{'SCRIPT_NAME'}">
<hr><br>
<table border=0 ALIGN=center>
<tr><th align=left>To receive updates when this site is updated, please
fill in the following information:
<tr><td>Email Address: <input name="Email" size=40><br>
<tr><td><input type=radio name=completed value="1">Add Me To Your
Mailing List
<tr><td>Select the documents you would like updates for:
<tr><td>$updatelist
<tr><td><input type=radio name=completed value="nuke">Remove Me From
Your List
<tr><th colspan=2><input type="Submit" value="Click Here When Done"><br>
</table><p><hr></form>
END
                &give_form;
        }
}

   
##########################################################################
sub give_menu {
   
##########################################################################
    &PrintHeader;
   &print_to_file("adminform.html");
}

   
##########################################################################
sub remove_from_list {
   
##########################################################################
        $Email = $in{'Email'};
        $Email =~ /([\w-.]+\@[\w-.]+)/;
        $untainted_address = $1;
        $Email = $untainted_address;

        $/ = "\n";
        if (open(DB, "$emaildbfile") == 1) {
                @emaildb = <DB>;
                close(DB);
        } else {
                @emaildb = "";
        }
        open(DB, "> $emaildbfile") || print "<!-- Couldn't open emaildb
for output  -->";
        foreach $line (@emaildb) {
                if ($line !~ /^$Email/) {
                        print(DB "$line");
                }
        }
        close(DB);
        print "Location: $response\n\n";
}

   
##########################################################################
sub give_form {
   
##########################################################################
     &PrintHeader;
    &print_to_file("form.html");
}

   
##########################################################################
sub union {
   
##########################################################################
        local(%one) = %ticklerpages;
        local(%two) = %groupnames;
        local(%union);
        
        foreach $key (keys(%one)) {
                $union{$key} = $one{$key};
        }
        
        foreach $key (keys(%two)) {
                $union{$key} = $two{$key};
        }
        return %union;
}
   
##########################################################################
sub send_email {
   
##########################################################################
        if ($in{groups} eq "all") {
                %temp = &union;
                @items = keys(%temp);
        } else {
                @items = split(/\*/, $in{groups});
        }
        $action = "You will receive updates on the following pages:\n";
        foreach $key (@items) {
                if ($ticklerpages{$key} ne "") {
                        $action .= "$ticklerpages{$key} - located at
\'$server/?$key\' .\n";
                } else {
                        $action .= "$groupnames{$key} - located at
\'$server/?$key.html\'.\n";
                }
        }

        open(MAIL, "| $sendmail_location -f \"$adminemail\" $Email");
        select(MAIL);
        print <<END;
TO: $email
FROM: $adminemail
SUBJECT: thank you!
REPLY_TO: $adminemail
\n\n
END

        select(MAIL);
        &print_to_file("confirm.txt");
        close(MAIL);
}

   
##########################################################################
sub send_update {
   
##########################################################################
        if (crypt($in{password}, substr($mail_password, 0, 2)) eq
$mail_password) {
                if (-e "$emaildbfile") {
                        $/ = "\n";
                        open(emails, "$emaildbfile");
                        @emails = <EMAILS>;
                        close(EMAILS);
                        foreach $record (@emails) {
                                ($addr, $groups) = split(/\t/, $record);
                                @groups_form = split(/\0/, $in{groups});
                                @groups_person = split(/\*/, $groups);
                                local(%mark);
                                grep($mark{$_}++, @groups_form);
                                @hits = grep($mark{$_}, @groups_person);
                                if ((@hits != 0) || ($groups =~
/all\*/)) {
                                        $action = "As per your request,
the following pages have been updated:\n";
                                        if ($groups =~ /all\*/) {
                                                foreach $key
(@groups_form) {
                                                        if
($ticklerpages{$key} ne "") {
                                                                $action
 .= "$ticklerpages{$key} - located at \'$server/?$key\' .\n";
                                                        } else {
                                                                       
$action .= "$groupnames{$key} - located at \'$server/?$key.html\'.\n";
                                                        }
                                                }
                                        } else {
                                        foreach $key (@hits) {
                                                if ($ticklerpages{$key}
ne "") {
                                                        $action .=
"$ticklerpages{$key} - located at \'$server/?$key\' .\n";
                                                } else {
                                                                $action
 .= "$groupnames{$key} - located at \'$server/?$key.html\'.\n";
                                                }
                                        }
                                }

                                open(MAIL, "| $sendmail_location -f
\"$adminemail\" $addr");
                                select(MAIL);
                                print <<END;
FROM: $adminemail
TO: $addr
SUBJECT: update
REPLY-TO: $adminemail
APPARENTLY-TO:
END

                                &print_to_file("update.txt");

                                close(MAIL);
                                select(STDOUT);
                        }
                }
                print("Location: $response\n\n");
                
        } else {
                &already_group;
        }
}

   
##########################################################################
sub already_group {
   
##########################################################################
        print("Location: $server/?$already_sub\n\n");
}

   
##########################################################################
sub add_to_db {##
   
##########################################################################
        $email = $in{'email'};
        $email =~ /([\w-.]+\@[\w-.]+)/;
        $untainted_address = $1;
        $email = $untainted_address;

        $in{groups} =~ s/\0/\*/g;

        $already_in_database = 0;

        if (open(DB, "$emaildbfile") == 1) {##
                @emaildb = <DB>;
                close(DB);
        } else {###
                @emaildb = "";
        }#
        $foo = grep(/$Email/, @emaildb);
        if ($foo == 0) {##
                open(DB, ">> $emaildbfile")|| print "<!-- Couldn't open
to append emaildb file -->";
                print(DB "$Email\t$in{groups}*\n");
                close(DB);
        } else {###
                open(DB, "> $emaildbfile") || print "<!-- Couldn't open
emaildb for output  -->";
                foreach $emailhash (@emaildb) {##
                        if ($emailhash !~ /^$Email/) {##
                                $emailhash =~ s/\n//g;
                                print(DB "$emailhash\n") || print "<!--
Couldn't print emailhash  -->";
                        } else {###
                        $emailhash =~ s/\n//g;
                        ($addr, $groups) = split(/\t/, $emailhash);
                                if ($groups !~ /^all/) {##
                                        @grouplist = split(/\*/,
$groups);
                                        $already = 0;
                                        foreach $group (@grouplist) {##
                                                foreach $group2
(split(/\0/, $in{'groups'})) {##
                                                        if ( $group =~
/$group2/ ) {##
                                                                $already
= 1;
                                                        }#
                                                }#
                                        }#
                                        if ($already == 0) {##
                                                if ($in{groups} !~
/^all/) {##
                                                        foreach $group
(split(/\0/, $in{'groups'})) {##
                                                                $groups
 .= "$group*";
                                                        }#
                                                } else {###
                                                        $groups =
"all*";
                                                }#
                                                
                                                print(DB
"$Email\t$groups\n")  || print "<!-- Couldn't format groups to DB -->";
                                                
                                                undef($groups);
                                        } else {###
                                                $emailhash =~ s/\n//g;
                                                print(DB
"$emailhash\n")  || print "<!-- Couldn't print emailhash to DB -->";
                                                $already_in_database =
1;
                                        }#

                                        undef($already);
                                        
                                        } else {###
                                        $emailhash =~ s/\n//g;
                                        print(DB "$emailhash\n")  ||
print "<!-- Couldn't print emailhash to DB -->";
                                        $already_in_database = 1;
                                }#
                        }#
                }#
                close(DB);

                if ( $already_in_database ) {##
                        &already_group;
                        exit;
                }#
        }#
        &send_email;
        print(STDOUT "Location: $response\n\n") || print "<!-- Couldn't
send email -->";
}#

   
##########################################################################
sub print_to_file {
   
##########################################################################
 
        local($file) = "$_[0]"; 

        if ($HEADER == 1){
                $file = &file_to_string($HEADER );
        }

        $file .= &file_to_string($_[0] );

        if ($FOOTER == 1){
                $file .= &file_to_string($FOOTER );
        }

        open(HTML, "$file") || print "<!-- Couldn't locate $_[0] -->";

        while (<HTML>) {
                s/"/\\"/g;
                s/&/\\&/g;
                print eval qq/"$_"/;
        }
        close(HTML);
}

   
#########################################################################
sub file_to_string {
    ##################################################################
    ## This function takes a single filename as its parameter. It then
    ## reads that file, parses any variables within that file, and
    ## returns a string.

        local($file) = $_[0];
        local($string);
        
        $string = "";
        open(FHANDLE, "$file");
        while (<fhandle>) {
                s/"/\\"/g;
                $string .= eval qq/"$_"/;
        }
        close(FHANDLE);
        return $string;
}


$HEADER = &file_to_string($headerfile);
$FOOTER = &file_to_string($footerfile);

}


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

Date: Wed, 20 May 1998 16:55:31 -0400
From: Dan Boorstein <danboo@negia.net>
Subject: Re: Benchmark: local filehandle vs. Filehandle.pm
Message-Id: <35634343.3B31AF2B@negia.net>

Tom Christiansen wrote:

[SNIP]

> 
> Modules are
> 
>     s
>     l
>     o
>     w

damn, i can never find that rot90 decoder when i need it. ;-)

-- 
Dan Boorstein   home: danboo@negia.net  work: danboo@y-dna.com

 "THERE IS AS YET INSUFFICIENT DATA FOR A MEANINGFUL ANSWER."
                         - Cosmic AC


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

Date: Thu, 21 May 1998 00:51:03 GMT
From: Tom Phoenix <rootbeer@teleport.com>
To: ? the platypus {aka David Formosa} <dformosa@st.nepean.uws.edu.au>
Subject: Re: Cryptography in Perl?
Message-Id: <Pine.GSO.3.96.980520174625.12546P-100000@user2.teleport.com>

On 20 May 1998, ? the platypus {aka David Formosa} wrote:

> The export a crypto-system sig thing is just an act of cival disobedence
> and not realy a serious crypto system.

To be more precise, it _is_ serious cryptography (which is why it's
covered under the ITAR export laws), but it's not intended to be used for
any real world cryptography, since it lacks such things as key management
and error checking.

Cheers!

-- 
Tom Phoenix       Perl Training and Hacking       Esperanto
Randal Schwartz Case:     http://www.rahul.net/jeffrey/ovs/



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

Date: 20 May 1998 22:02:34 GMT
From: millerb@millerb.fc.hp.com (Bryan Miller)
Subject: Re: file locking question
Message-Id: <6jvjtq$kdi@fcnews.fc.hp.com>

Ala Qumsieh (aqumsieh@matrox.com) wrote:
: Ryan McGuigan wrote:

: > How can I read the last line of a file, and then append to it while having
: > it locked the whole time?
: >
: > thanks,
: > Ryan

:  Well...
: Lock it (exclusively) before you read and append.
: Is this a trick question?

Sheesh! It must be.  The answers certainly are tricks!  Here is
a brief snippet from Randal's posting on this topic a few months ago:

%%%
Here's the canonical "append" model with flocking:

        open FILE, "+>>in-duh-vidual";
        flock FILE, 2;
        seek FILE, 0, 0;
        @contents = <FILE>;
        ## process @contents to the new contents
        seek FILE, 0, 0;
        truncate FILE, 0;
        print FILE @contents;
        close FILE;

Do *not* release the flock before you close.  Bad bad bad.  This *is*
the way.  Yes, *all* of these steps are necessary.  Any deviation will
break down somewhere.  You have been warned.
%%%

cheers,
Bryan Miller
---
HP-UX Development Labs
Fort Collins, CO, USA
millerb@patchsvr.fc.hp.com


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

Date: Wed, 20 May 1998 04:52:20 -0400
From: "Bob Bacola" <bobbacola@pipeline.com>
Subject: Re: Flat-File db recommendation
Message-Id: <6jvs9d$q1l$1@camel25.mindspring.com>

This has probably been asked many times but is a RDBMS like MySQL required
to search a large flat ascii file (43 megs, 136,000 rows) or does perl and
or unix have enough built in power?

I currently search this file using  the grep command in AIX 3.2.5 which is
very slow as you can imagine since it searches every character in the file.
Could perl be setup to search by an index somehow?  Thank you for any help.

>> Can anyone recommend a flat-file db module (e.g. Sprite) which can
>> deal with columns that hold a lot of text? I'm trying to convert
>> some Oracle tables into flat-file tables, but some of the Oracle
>> fields hold up to 2000 words.
>
>I don't know your exact situation, but have you considered using one
>of the freely available RDBMS's for this project?  MySQL and
>PostgreSQL do pretty well.





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

Date: Wed, 20 May 1998 18:06:09 -0400
From: Alee Ali <aaa@dms2.com>
Subject: Help on stripping a string
Message-Id: <356353D1.548A@dms2.com>

Hi if someone can help it will be greatly appreciated.

I have a string that can be either 
1) [Perl Language] I want it to become into 2 strings "Perl" and
"Language".

2) [Perl+Language] I want it become into 2 strings "Perl" and
"Language".

3) ["Perl Language"] I want it to remain as "Perl Language".
 
4) ["Perl Language" Misc] I want it to become into 2 strings "Perl
Language" and "Misc".

5) ["Perl Language"+Misc] I want it to become into 2 strings "Perl
Language" and "Misc".

The code I wrote is following:
@first = split(/\s+/, $term);
	foreach $first (@first) {
		if ($first =~ /\"/) {
			next;
		} elsif ($first =~ /[a-zA-Z0-9](.*)\"/) {
			next;
		} elsif ($first =~ /[a-zA-Z0-9](.*)\+/) {
			next;
		} else {
			push(@templist,$first);
			push(@permanentlist,$first);
		}
	}

It is not properly working.  If someone can help me with what I am doing
wrong it will be greatly appreciated or suggest a better idea.

Thanks

Alee


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

Date: 20 May 1998 21:54:32 GMT
From: Tom Christiansen <tchrist@mox.perl.com>
Subject: Re: Inter-process file arbitration?
Message-Id: <6jvjeo$r4h$5@csnews.cs.colorado.edu>

In comp.lang.perl.misc, "Larry Rosler" <lr@hpl.hp.com> writes:
:This technique works fine on Unix-based systems.  

No, it should work everywhere.

:However, flock is not
:implemented by the commercial perl that I must use on the Windows NT
:system I must port to.  (The version information is reproduced below.)

Sucks to be you.  Ever considered a new job?   I can't believe 
peopel screw you over so badly.

The standard port of Perl supports flocking even on such 
programmer hostile systems as you have been condemned to.
Just use standard.

/* win32io.c  */

/* simulate flock by locking a range on the file */

#define LK_ERR(f,i)     ((f) ? (i = 0) : (errno = GetLastError()))
#define LK_LEN          0xffff0000

int
my_flock(int fd, int oper)
{
    OVERLAPPED o;
    int i = -1;
    HANDLE fh;

    fh = (HANDLE)my_get_osfhandle(fd);
    memset(&o, 0, sizeof(o));

    switch(oper) {
    case LOCK_SH:               /* shared lock */
        LK_ERR(LockFileEx(fh, 0, 0, LK_LEN, 0, &o),i);
        break;
    case LOCK_EX:               /* exclusive lock */
        LK_ERR(LockFileEx(fh, LOCKFILE_EXCLUSIVE_LOCK, 0, LK_LEN, 0, &o),i);
        break;
    case LOCK_SH|LOCK_NB:       /* non-blocking shared lock */
        LK_ERR(LockFileEx(fh, LOCKFILE_FAIL_IMMEDIATELY, 0, LK_LEN, 0, &o),i);
        break;
    case LOCK_EX|LOCK_NB:       /* non-blocking exclusive lock */
        LK_ERR(LockFileEx(fh,
                       LOCKFILE_EXCLUSIVE_LOCK|LOCKFILE_FAIL_IMMEDIATELY,
                       0, LK_LEN, 0, &o),i);
        break;
    case LOCK_UN:               /* unlock lock */
        LK_ERR(UnlockFileEx(fh, 0, LK_LEN, 0, &o),i);
        break;
    default:                    /* unknown */
        errno = EINVAL;
        break;
    }
    return i;
}

:Instead, I use the deprecated (in perlfaq5) technique of testing for the
:existence of a lockfile, waiting if necessary until it goes away, and
:then creating it.  To avoid the disastrous race condition, I do this
:sequentially on two separate lockfiles, which reduces the probability of

Don't do that.  Use O_EXCL.

You could this, but it's not quite perfect yet.  It should use
mkdir instead.

--tom

package File::NetLock;

use Exporter;

@ISA = qw(Exporter);
@EXPORT = qw(nflock nunflock);

use Cwd;
use Sys::Hostname;
use File::Basename;
use File::stat;

use strict;

sub nflock($;$) {
    my $pathname = shift;
    my $naptime  = shift || 5;
    my $lockname = name2lock($pathname);
    while (1) { 
	link($pathname, $lockname);  # XXX: ignore return
	last if stat($pathname)->nlink == 2;
	sleep 5;
    }
    print "lock granted on $lockname\n";
} 

sub nunflock($) {
    my $pathname = shift;
    my $lockname = name2lock($pathname);
    print "lock dissolved on $lockname\n";
    unlink($lockname); 		# XXX: ignore return
}

sub name2lock {
    my $pathname = shift;
    my $dir  = dirname($pathname);
    my $file = basename($pathname);
    $dir = getcwd() if $dir eq '.';
    my $hostname = hostname();
    my $lockname = "$dir/$file.lock-$hostname.$$";
    warn $lockname;

    return $lockname;
} 

1;
-- 
clueless> $SOCK_STREAM = 2  
    Huh?  use Socket or die!
	    --Tom Christiansen <tchrist@mox.perl.com>


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

Date: Wed, 20 May 1998 18:29:23 -0600
From: "Tyler Andersen" <zygotech@*remove*.itsnet.com>
Subject: Newbie needs help!
Message-Id: <35637961.0@news.itsnet.com>

I'm a perl newbie and I'm wondering how to check if a file exsists. Could
someone provide some sample code or a link to a faq that explains how to do
this?

Thanks!




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

Date: 21 May 1998 00:44:54 GMT
From: tina@nicke.andreasen.se (Tina Marie Holmboe)
Subject: Re: Newbie needs help!
Message-Id: <6jvte6$mf7$1@news1.sol.no>

In article <35637961.0@news.itsnet.com>,
	"Tyler Andersen" <zygotech@*remove*.itsnet.com> writes:

> I'm a perl newbie and I'm wondering how to check if a file exsists. Could
> someone provide some sample code or a link to a faq that explains how to do
> this?

  You don't really need a FAQ for that - have a look in the Perlfunc manual
  for the -e function. Good luck!

-- 
        Tina


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

Date: Wed, 20 May 1998 20:49:46 -0400
From: Arthur Dardia <ahdiii@webspan.net>
Subject: Re: Newbie needs help!
Message-Id: <35637A2A.4C731299@webspan.net>

Try the following code:

#!c:/progra~1/perl/bin/perl
if ( open MYFILE, "<myfile.txt" ) {
     close(MYFILE);
     print "File exists.";
} else {
     print "File does NOT exist.";
}

Remember to change the first line from #!c:/progra~1/perl/bin/perl to whatever
you need.  I tested this code and it worked fine.

                    HTH,
                    Arthur Dardia

Tyler Andersen wrote:

> I'm a perl newbie and I'm wondering how to check if a file exsists. Could
> someone provide some sample code or a link to a faq that explains how to do
> this?
>
> Thanks!





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

Date: Sun, 17 May 1998 09:11:15 +0300
From: Zohar Tsaba <ztsaba@iil.intel.com>
Subject: Perl and C++, MFC.
Message-Id: <355E7F83.5E5816C2@iil.intel.com>

Hi,

I have a Perl program, and I want to implement additional part for this
program (Data Base, GUI...) with MFC, C++.

Does anyone know how to call Perl from C++ code (MFC) ?
How to call C++ from Perl ?


Thanks,
Zohar.

--
Zohar Tsaba
ztsaba@iil.intel.com
04-8655852
Intel IDC, HAIFA




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

Date: Mon, 18 May 1998 10:59:53 +0300
From: Zohar Tsaba <ztsaba@iil.intel.com>
Subject: Perl and C++, MFC.
Message-Id: <355FEA79.76443D65@iil.intel.com>

Hi,

I have a Perl program, and I want to implement additional part for this
program (Data Base, GUI...) with MFC, C++.

Does anyone know how to call Perl from C++ code (MFC) ?
How to call C++ from Perl ?


Thanks,
Zohar.

--
Zohar Tsaba
ztsaba@iil.intel.com
04-8655852
Intel IDC, HAIFA





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

Date: Thu, 21 May 1998 00:37:48 GMT
From: Tom Phoenix <rootbeer@teleport.com>
To: stuboy@ac.net
Subject: Re: perl compiler for winnt
Message-Id: <Pine.GSO.3.96.980520173701.12546N-100000@user2.teleport.com>

On Tue, 19 May 1998 stuboy@ac.net wrote:

> Does anyone know of a perl 5 compiler for windows nt?

Have you seen the FAQ? Hope this helps!

-- 
Tom Phoenix       Perl Training and Hacking       Esperanto
Randal Schwartz Case:     http://www.rahul.net/jeffrey/ovs/



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

Date: Thu, 21 May 1998 00:19:07 GMT
From: Tom Phoenix <rootbeer@teleport.com>
To: Steven Tolkin <steve.tolkin@fmr.com>
Subject: Re: Perl for Windows is important, and comments on COM and CPAN
Message-Id: <Pine.GSO.3.96.980520171831.12546J-100000@user2.teleport.com>

On Tue, 19 May 1998, Steven Tolkin wrote:

> It would be better if CPAN/FirstTime.pm checked the OS and
> quickly gave a message saying e.g. "Windows is not supported".

Good idea! Got a patch? :-)

-- 
Tom Phoenix       Perl Training and Hacking       Esperanto
Randal Schwartz Case:     http://www.rahul.net/jeffrey/ovs/



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

Date: 21 May 1998 00:15:59 GMT
From: mgjv@comdyn.com.au (Martien Verbruggen)
Subject: Re: Perl Net::Telnet()
Message-Id: <6jvrnv$7op$1@comdyn.comdyn.com.au>

In article <6ju2sn$d2n$2@baker.cc.tut.fi>,
	aajii@aajii.ton.tut.fi (Antti-Jussi Korjonen) writes:
> I tried this on my Linux machine. The problem is that the
> program doesn't seem to understand the Password: prompt.

That is odd. According to the documentation, which you have read all
the way through, and not just to extract that little piece of example
code, the prompt must match:

         Password prompts must match the pattern:

             /password[: ]*$/i

If your linux box does indeed have the prompt 'Password:', then there
shouldn't be any problems. Now.. What does it have as prompt?

> $t = new Net::Telnet (Timeout => 10, Prompt => '/bash\$ $/');

Is this actually a regexp for the command prompt you will be expecting?

Martien
-- 
Martien Verbruggen                      |
Webmaster www.tradingpost.com.au        | "In a world without fences,
Commercial Dynamics Pty. Ltd.           |  who needs Gates?"
NSW, Australia                          |


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

Date: Wed, 20 May 1998 19:23:26 -0700
From: Steve Palincsar <palincss@tidalwave.net>
Subject: Re: perl variables
Message-Id: <3563901E.28AE@tidalwave.net>

Of course, a far more perlish way to determine this would be with
a regular expression:  if ($var =~ /@/) {  ...  # true condition }


Jeff & Rebecca Jo Isom wrote:
> 
> Mike Stok wrote:
> 
> > In article <6jv9e8$23t@bgtnsc02.worldnet.att.net>,
> > Jeff & Rebecca Jo Isom  <jeffyjo-isom@worldnet.att.net> wrote:
> > >Is there a way to check the contents of a variable to see if it contains
> > >a specific character?
> > >
> > >For example if I have a variable from a form that stores an email
> > >address and I want to make sure the variable contains a @.  How would I
> > >accomplish this?
> >
> > One way to do it is to say
> >
> >   if (index ($var, '@') >= $[) {
> >     ...
> >   }
> 
> This actually needs to be
> 
>     if (index ($var, '@') <= $[) {
>       ...
>     }
> 
> to work right
> 
> Jeff Isom


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

Date: Thu, 21 May 1998 00:11:51 GMT
From: Tom Phoenix <rootbeer@teleport.com>
To: Chris Martin <c.martin@sheffield.ac.uk>
Subject: Re: Sockets and system() give segfault
Message-Id: <Pine.GSO.3.96.980520171049.12546I-100000@user2.teleport.com>

On 19 May 1998, Chris Martin wrote:

> [Is "$SIG{CHLD} = \&REAPER;" a mistake? There is no REAPER sub...]

Then it's a mistake. (Perl shouldn't segfault when this happens, either,
but that's another story.) Hope this helps!

-- 
Tom Phoenix       Perl Training and Hacking       Esperanto
Randal Schwartz Case:     http://www.rahul.net/jeffrey/ovs/



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

Date: 20 May 1998 20:41:03 -0400
From: Lloyd Zusman <ljz@asfast.com>
Subject: Re: translate A-Z to 1-26
Message-Id: <ltemxoe9r4.fsf@asfast.com>

mjd@op.net (Mark-Jason Dominus) writes:

> In article <ltaf8fapzc.fsf@asfast.com>, Lloyd Zusman  <ljz@asfast.com> wrote:
> >But in EBCDIC, the set ('a' .. 'z') contains 41 elements.
> 
> You'd think so, but according to this article, it contains 9.
> (_Perl and EBCDIC?_, Peter Prymmer, The Perl Journal, vol 2. no
> 4. pp. 16-16) 

Does this article appear on line anywhere?

-- 
 Lloyd Zusman   ljz@asfast.com
 perl -e '$n=170;for($d=2;($d*$d)<=$n;$d+=(1+($d%2))){for($t=0;($n%$d)==0;
 $t++){$n=int($n/$d);}while($t-->0){push(@r,$d);}}if($n>1){push(@r,$n);}
 $x=0;map{$x+=(($_>0)?(1<<log($_-0.5)/log(2.0)+1):1)}@r;print"$x\n"'


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

Date: Thu, 21 May 1998 00:31:49 GMT
From: Tom Phoenix <rootbeer@teleport.com>
To: Bob Carroll <rlcarro@escher.ppco.com>
Subject: Re: unpacking signed network ints
Message-Id: <Pine.GSO.3.96.980520173119.12546L-100000@user2.teleport.com>

On Tue, 19 May 1998, Bob Carroll wrote:

> The documentation could be more specific and state that
> these produce unsigned results.

Patches welcome!

> It would be helpful to have format characters that will produce
> signed results.

Even more patches welcome!

:-)

-- 
Tom Phoenix       Perl Training and Hacking       Esperanto
Randal Schwartz Case:     http://www.rahul.net/jeffrey/ovs/



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

Date: 20 May 1998 23:29:45 GMT
From: cchapman@chat.carleton.ca (chris chapman)
Subject: uploading but getting 0 bytes
Message-Id: <6jvp19$jtj$1@bertrand.ccs.carleton.ca>
Keywords: upload .pdf files

Using a form (cgi perl script) I'm trying to upload .pdf files. In the
script I read the file's data from standard input (STDIN) but because the
file is .pdf it requires special decoding.

I've tried storing the .pdf data in a file as a binary file but I have
had no luck.

I think it may be some sort of mime type problem. Also the OS is Linux and
the web server is Apache.

thanks 
chris

it is valid -> chapman@engsoc.carleton.ca


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

Date: 21 May 1998 00:36:17 GMT
From: mgjv@comdyn.com.au (Martien Verbruggen)
To: brian@brie.com (Brian Lavender)
Subject: Re: Where is warning about PERL 5.001?
Message-Id: <6jvsu1$7so$1@comdyn.comdyn.com.au>

[Posted and Mailed]

In article <35661958.2971797@news.jps.net>,
	brian@brie.com (Brian Lavender) writes:
> I am looking for the warning regarding PERL 5.001. I remember it being

Do you mean the CERT advisories?

http://www.cert.org/

These are the ones that relate to perl:

http://www.cert.org/advisories/CA-97.17.sperl.html
http://www.cert.org/advisories/CA-96.12.suidperl_vul.html
http://www.cert.org/advisories/CA-96.11.interpreters_in_cgi_bin_dir.html

Martien
-- 
Martien Verbruggen                      |
Webmaster www.tradingpost.com.au        | "In a world without fences,
Commercial Dynamics Pty. Ltd.           |  who needs Gates?"
NSW, Australia                          |


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

Date: Wed, 20 May 1998 19:19:24 -0700
From: Steve Palincsar <palincss@tidalwave.net>
Subject: Re: Why does "each" not go thru entire hash??
Message-Id: <35638F2C.4D4C@tidalwave.net>

You aren't by any chance expecting "each" to traverse the hash
in the order in which you defined it, are you?  If so, your problem
is that hashes don't work that way.  They are stored in no determined
order (or, if you like it better, in an order known but to God and
Larry Wall).

Tom Turton wrote:
> 
> I am seeing some bizarre behavior while trying to use a while/each on a
> hash.  It appears to jump into the middle/end of the hash the first time
> through.

[code omitted]

> If I run the above snippet of code in a small test program, it operates
> as I would expect.  In this case, the hash seems to be initiated in the
> following index (value) order:
>    13,12,8,4,9,1,11,5,2,7,0,3,6,10
> 
> When I run it in my main program, the first time through ($rwi = 0), it
> appears to check starting with 'values' 3,6,10 then goes on to index
> $rwi=1 and loop starting at hash value '13' down until it matches '1';
> $rwi=2 starting again with hash value '13' down until it matches '2',
> etc.


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

Date: Wed, 20 May 1998 17:31:06 -0700
From: Matthew Purdon <playinmantis@earthlink.net>
Subject: writing image from http request to file
Message-Id: <356375CA.A8C7539F@earthlink.net>

I'm using the LWP module in the binary version of Perl for WinNT to
retrieve and write a gif image to a file, but some how the file data is
not being retrieved or written properly.  It seems to occur only on
images with long content length.  Images under 50 seem to be okay..
Below is a copy of the test code I've been using.

  # Create a user agent object
  use LWP::UserAgent;
  $ua = new LWP::UserAgent;
  $ua->agent("AgentName/0.1 " . $ua->agent);

  # Create a request
  my $req = new HTTP::Request GET =>
'http://www.perl.com/graphics/ora_logo.gif';

  # Pass request to the user agent and get a response back
  my $res = $ua->request($req);

  # Check the outcome of the response
  if ($res->is_success) {
      open(IMAGE,">ora_logo.gif") || die "Can't open image file";
      print IMAGE $res->content;
      close(IMAGE);
  } else {
      print "Bad luck this time\n";
  }

- Matthew Purdon



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

Date: Wed, 20 May 1998 23:32:07 GMT
From: Randal Schwartz <merlyn@stonehenge.com>
To: cberry@cinenet.net (Craig Berry)
Subject: Re: Year2000 compliant?
Message-Id: <8czpgcplhm.fsf@gadget.cscaper.com>

>>>>> "Craig" == Craig Berry <cberry@cinenet.net> writes:

Craig> You
Craig> can write today's date as 5/20/98 with a pencil;

OK, time for the aside -- there is *nothing* Y2K-noncompliant with
2-digit years.  What is non-compliant is erroneously making 1/1/00
into 1900 when it's not intended to be that.

So even 5/20/98 is "Y2K compliant".

print "Just another Perl hacker," # but not what the media calls "hacker!" :-)
## legal fund: $20,990.69 collected, $186,159.85 spent; just 103 more days
## before I go to *prison* for 90 days; email fund@stonehenge.com for details

-- 
Name: Randal L. Schwartz / Stonehenge Consulting Services (503)777-0095
Keywords: Perl training, UNIX[tm] consulting, video production, skiing, flying
Email: <merlyn@stonehenge.com> Snail: (Call) PGP-Key: (finger merlyn@teleport.com)
Web: <A HREF="http://www.stonehenge.com/merlyn/">My Home Page!</A>
Quote: "I'm telling you, if I could have five lines in my .sig, I would!" -- me


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

Date: 21 May 1998 00:32:54 GMT
From: gebis@albrecht.ecn.purdue.edu (Michael J Gebis)
Subject: Re: Year2000 compliant?
Message-Id: <6jvsnm$b57@mozo.cc.purdue.edu>

Randal Schwartz <merlyn@stonehenge.com> writes:

}>>>>> "Craig" == Craig Berry <cberry@cinenet.net> writes:

}Craig> You
}Craig> can write today's date as 5/20/98 with a pencil;

}OK, time for the aside -- there is *nothing* Y2K-noncompliant with
}2-digit years.  What is non-compliant is erroneously making 1/1/00
}into 1900 when it's not intended to be that.

}So even 5/20/98 is "Y2K compliant".

That's why I prefer to refer to today as 5/0/8.

-- 
Mike Gebis  gebis@ecn.purdue.edu  mgebis@eternal.net


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

Date: Thu, 21 May 1998 00:44:59 GMT
From: Tom Phoenix <rootbeer@teleport.com>
To: Pierre Porter <pierre_porter@y2k1000.ps.compuware.com>
Subject: Re: |more trouble and more...
Message-Id: <Pine.GSO.3.96.980520173930.12546O-100000@user2.teleport.com>

On Tue, 19 May 1998, Pierre Porter wrote:

> I am having a problem with using |more at the command line.
> Redirection at the command line (foo.pl text.txt >result.txt) also 
> doesn't work. 

Could you be a little less specific? :-)  If you can tell us in what way
this doesn't work, we might be able to tell you what to change. 

Of course, you should have already checked that you are able to direct
output of other programs than perl. 

Hope this helps!

-- 
Tom Phoenix       Perl Training and Hacking       Esperanto
Randal Schwartz Case:     http://www.rahul.net/jeffrey/ovs/



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

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

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