[11870] in Perl-Users-Digest
Perl-Users Digest, Issue: 5470 Volume: 8
daemon@ATHENA.MIT.EDU (Perl-Users Digest)
Fri Apr 23 21:07:24 1999
Date: Fri, 23 Apr 99 18:00:19 -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 Fri, 23 Apr 1999 Volume: 8 Number: 5470
Today's topics:
Re: $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex( (Larry Rosler)
Re: $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex( <cassell@mail.cor.epa.gov>
Re: $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex( <gregm@well.com>
Re: $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex( (Benjamin Franz)
Re: Can a DNS lookup be performed from within perl ? <rradhakr@ececs.uc.edu>
Re: embedding Perl in C <cassell@mail.cor.epa.gov>
Re: Encrypt/Decrypt <cassell@mail.cor.epa.gov>
Re: Help: Problem capturing cntl-c signal in perl scrip <cassell@mail.cor.epa.gov>
Re: newbie with a "howto" question <cassell@mail.cor.epa.gov>
Re: newbie with a "howto" question <ray@perry.geo.berkeley.edu>
Re: newbie with a "howto" question <cassell@mail.cor.epa.gov>
Parse::Lex problem (bug ?) <rashidk@home.net>
Parse::Lex problem (bug ?) <rashidk@home.net>
perl_destruct and core dumps. (D. M. Ilstrup)
Re: Problems with the connect function <tchrist@mox.perl.com>
Question: Opening and closing files. networks@skynet.co.uk
Re: Question: Opening and closing files. <cassell@mail.cor.epa.gov>
Re: Question: Opening and closing files. <tchrist@mox.perl.com>
Re: Refresh button on a web page? <emschwar@rmi.net>
Re: Sorting Array of Arrays <yfang@gte.com>
Re: Sorting Array of Arrays (Larry Rosler)
Special: Digest Administrivia (Last modified: 12 Dec 98 (Perl-Users-Digest Admin)
----------------------------------------------------------------------
Date: Fri, 23 Apr 1999 16:33:38 -0700
From: lr@hpl.hp.com (Larry Rosler)
Subject: Re: $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
Message-Id: <MPG.118aa32f620af7d298992c@nntp.hpl.hp.com>
[Posted and a courtesy copy mailed.]
In article <7fqtf5$pj1$1@news2.kornet.net> on Sat, 24 Apr 1999 07:45:15
+0900, Rapision <rapision@neobit.net> says...
> Although I met the following line many times while I study perl,
> $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
> I can not understand exactly what it means.
It means you are not using the module CGI.pm (or is URI::URL enough?) to
parse your HTTP URL-encoded input. Others on this group will rub your
nose in this.
> Please advise me how it works.
In URL encoding, the character sequence 'percent followed by two
hexadecimal digits' encodes the single character whose numerical value
is the value of the two digits. Thu, '%21' encodes a '!'.
The regex captures the two digits into $1, then evaluates the expression
on the right: convert the value of the two characters, interpreted as a
hexadecimal integer, into a character.
I prefer to use:
$value =~ s/%([\dA-Fa-f]{2})/chr hex $1/eg;
because it is less to type (or just cut-and-paste :-). As you can
guess, I don't use those modules either. Shame on me!
--
(Just Another Larry) Rosler
Hewlett-Packard Company
http://www.hpl.hp.com/personal/Larry_Rosler/
lr@hpl.hp.com
------------------------------
Date: Fri, 23 Apr 1999 17:09:14 -0700
From: David Cassell <cassell@mail.cor.epa.gov>
Subject: Re: $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
Message-Id: <37210BAA.3588579E@mail.cor.epa.gov>
Larry Rosler wrote:
>
> [Posted and a courtesy copy mailed.]
>
> In article <7fqtf5$pj1$1@news2.kornet.net> on Sat, 24 Apr 1999 07:45:15
> +0900, Rapision <rapision@neobit.net> says...
> > Although I met the following line many times while I study perl,
> > $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
> > I can not understand exactly what it means.
>
> It means you are not using the module CGI.pm (or is URI::URL enough?) to
> parse your HTTP URL-encoded input. Others on this group will rub your
> nose in this.
I think it also means he's using some bad study materials, and needs
to switch textbooks immediately. Perhaps he should go to
www.perl.com and look at the book reviews, to pick out some Perl and
CGI texts that have *good* examples in them.
Let me see if the PSI::ESP module is working today...
I see a book... A book with with a vague title... I can't quite make
it out... Is that the word 'Dummies' I see? Or the phrase
'In XX Days'?
> [big snip]
> because it is less to type (or just cut-and-paste :-). As you can
> guess, I don't use those modules either. Shame on me!
The PSI::ESP module already told me that.
:-)
--
David Cassell, OAO cassell@mail.cor.epa.gov
Senior Computing Specialist phone: (541) 754-4468
mathematical statistician fax: (541) 754-4716
------------------------------
Date: Fri, 23 Apr 1999 17:34:33 -0700
From: Greg McCann <gregm@well.com>
Subject: Re: $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
Message-Id: <37211199.33175363@well.com>
Larry Rosler wrote:
> I prefer to use:
>
> $value =~ s/%([\dA-Fa-f]{2})/chr hex $1/eg;
>
> because it is less to type (or just cut-and-paste :-). As you can
> guess, I don't use those modules either. Shame on me!
Thank you, Larry. You've given me the courage to admit it...
I DON'T USE CGI.PM EITHER!!
There - I feel better now.
Greg
--
======================
Gregory McCann
http://www.calypteanna.com
"Be kind, for everyone you meet is fighting a great battle." Saint Philo of
Alexandria
------------------------------
Date: Sat, 24 Apr 1999 00:56:08 GMT
From: snowhare@long-lake.nihongo.org (Benjamin Franz)
Subject: Re: $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
Message-Id: <IE8U2.299$oU1.22408@typhoon-sf.snfc21.pbi.net>
In article <37211199.33175363@well.com>, Greg McCann <gregm@well.com> wrote:
>Larry Rosler wrote:
>> I prefer to use:
>>
>> $value =~ s/%([\dA-Fa-f]{2})/chr hex $1/eg;
>>
>> because it is less to type (or just cut-and-paste :-). As you can
>> guess, I don't use those modules either. Shame on me!
>
>Thank you, Larry. You've given me the courage to admit it...
>
>I DON'T USE CGI.PM EITHER!!
Nor do I. I find pulling a 150+Kbytes for a form decoder to be...excessive.
Here is what I use (perhaps I should send it to CPAN as 'CGI::UltraLite')
Before someone locks on to my use of \r and \n - yes I know. I only use
it on *nix boxes.
Benjamin Franz
package Local::JCGI;
use strict;
use vars qw ($_query);
$_query = {};
bless $_query;
$_query->{'jcgi'}{'max_buffer'} = 400000;
$_query->{'jcgi'}{'sgml_safe_mode'} = 0;
@{$$_query{'jcgi'}{'field_names'}} = ();
%{$$_query{'jcgi'}{'field'}} = ();
$_query->_read_form;
=head1 NAME
Local::JCGI - A lightweight CGI form variable processing pacakge
=head1 SYNOPSIS
=head1 DESCRIPTION
Provides a lightweight alternative to the CPAN CGI.pm module
(which currently clocks in at a hefty 153K!!!)
=head2 Initialization
=cut
######################################################################
=over 4
=item C<$query = Local::JCGI-E<gt>new;>
Creates a new instance of the Local::JCGI object and decodes
any type of form (GET/POST). Only one 'true' object is generated -
all subsequent calls return an alias of the one object.
=back
=cut
sub new {
$_query;
}
=head2 Public API
=cut
#######################################################################
=over 4
=item C<$query-E<gt>param([$fieldname]);>
Called as C<$query-E<gt>param();> it returns the list of all defined
form fields in the same order they appear in the data from the
user agent.
Called as C<$query-E<gt>param($fieldname);> it returns the value (or
array of values for multiple occurances of the same field name) assigned
to that $fieldname. If there is more than one value, the values are
returned in the same order they appeared in the data from user agent.
=back
=cut
sub param {
my ($self) = shift;
if ($#_ == -1) {
return (@{$$self{'jcgi'}{'field_names'}});
} elsif ($#_ == 0) {
my ($fieldname)=@_;
if (defined($self->{'jcgi'}{'field'}{$fieldname})) {
return (@{$$self{'jcgi'}{'field'}{$fieldname}{'value'}});
} else {
return();
}
}
}
#######################################################################
=over 4
=item C<$query-E<gt>param_mime([$fieldname]);>
Called as C<$query-E<gt>param_mime();> it returns the list of all defined
form fields in the same order they appear in the data from the
user agent.
Called as C<$query-E<gt>param_mime($fieldname);> it returns the MIME
type (or array of MIME types for multiple occurances of the same field
name) assigned to that $fieldname. If there is more than one value, the
values are returned in the same order they appeared in the data from user
agent.
This is only meaningful when doing Form Based File Uploads.
=back
=cut
sub param_mime {
my ($self) = shift;
if ($#_ == -1) {
return (@{$$self{'jcgi'}{'field_names'}});
} elsif ($#_ == 0) {
my ($fieldname)=@_;
if (defined($self->{'jcgi'}{'field'}{$fieldname})) {
return (@{$$self{'jcgi'}{'field'}{$fieldname}{'mime_type'}});
} else {
return ();
}
}
}
#######################################################################
=over 4
=item C<$query-E<gt>param_filename([$fieldname]);>
Called as C<$query-E<gt>param_filename();> it returns the list of all
defined form fields in the same order they appear in the data from the
user agent.
Called as C<$query-E<gt>param_filename($fieldname);> it returns the
file name (or array of file names for multiple occurances of the same field
name) assigned to that $fieldname. If there is more than one value, the
values are returned in the same order they appeared in the data from user
agent.
This is only meaningful when doing Form Based File Uploads.
=back
=cut
sub param_filename {
my ($self) = shift;
if ($#_ == -1) {
return (@{$$self{'jcgi'}{'field_names'}});
} elsif ($#_ == 0) {
my ($fieldname)=@_;
if (defined($self->{'jcgi'}{'field'}{$fieldname})) {
return (@{$$self{'jcgi'}{'field'}{$fieldname}{'filename'}});
} else {
return ();
}
}
}
#######################################################################
=over 4
=item C<$query-E<gt>date_rfc1123($time);>
Takes a unix time tick value and returns a RFC1123 compliant date
as a formatted text string suitable for direct use in Expires,
Last-Modified or other HTTP headers.
=back
=cut
sub date_rfc1123 {
my ($self) = shift;
my ($tick) = @_;
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst,
$month,$wkday);
($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst)=gmtime($tick);
$wkday = ('Sun','Mon','Tue','Wed','Thu','Fri','Sat')[$wday];
$month = ('Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep','Oct','Nov','Dec')[$mon];
$sec = "0$sec" if (length($sec) < 2);
$min = "0$min" if (length($min) < 2);
$hour = "0$hour" if (length($hour) < 2);
$mday = "0$mday" if (length($mday) < 2);
if ($year < 95) {
$year = $year + 2000;
}
if (($year > 94) && ($year < 1000)) {
$year = $year + 1900;
}
return ("$wkday, $mday $month $year ${hour}\:${min}\:${sec} GMT");
}
#######################################################################
=over 4
=item C<$query-E<gt>calling_parms_table();>
Returns a formatted HTML table containing all the form and environment
variables for debugging purposes
=back
=cut
sub calling_parms_table {
my ($self) = shift;
my ($outputstring) = <<"EOF";
<table border=1 cellspacing=0>
<tr>
<th colspan=4>Form Fields</th>
</tr>
<tr>
<th>Field</th>
<th>Value</th>
<th>mime Type</th>
<th>File Name</th>
</tr>
EOF
my ($fieldname);
foreach $fieldname (sort @{$$self{'jcgi'}{'field_names'}}) {
my ($fieldmime,$fieldfile,$fieldvalue);
my ($sub_field_counter)= $#{$$self{'jcgi'}{'field'}{$fieldname}{'value'}};
my ($fieldn);
for ($fieldn=0;$fieldn<=$sub_field_counter;$fieldn++) {
$fieldmime = $self->{'jcgi'}{'field'}{$fieldname}{'mime_type'}[$fieldn];
$fieldfile = $self->{'jcgi'}{'field'}{$fieldname}{'filename'}[$fieldn];
$fieldvalue = '[non-text value]';
if ($fieldmime =~ m#^text/#oi) {
$fieldvalue = $self->htmlize($self->{'jcgi'}{'field'}{$fieldname}{'value'}[$fieldn]);
}
$outputstring .= <<"EOF";
<tr>
<td>$fieldname (#$fieldn)</td>
<td> $fieldvalue </td>
<td>$fieldmime</td>
<td>$fieldfile</td>
</tr>
EOF
}
}
$outputstring .= <<"EOF";
<tr>
<th colspan=4>Environment Variables</th>
</tr>
<tr>
<th>Variable</th>
<th colspan=3>Value</th>
</tr>
EOF
foreach $fieldname (sort keys (%ENV)) {
$outputstring .= "<tr>\n <td>$fieldname</td>\n <td colspan=3>" .
$self->htmlize($ENV{$fieldname}) . "</td>\n</tr>\n";
}
$outputstring .= "</table>\n";
$outputstring;
}
#######################################################################
=over 4
=item C<$query-E<gt>url_encode($string);>
Returns URL encoding of input string
=back
=cut
sub url_encode {
my ($self) = shift;
my ($line)=@_;
return ('') if (! defined ($line));
$line=~s/([\000-\054\072-\100\176-\377])/"\%".unpack("H",$1).unpack("h",$1)/egos;
$line;
}
#######################################################################
=over 4
=item C<$query-E<gt>url_decode($string);>
Returns URL *decoding* of input string
=back
=cut
sub url_decode {
my ($self) = shift;
my ($line) = @_;
return ('') if (! defined($line));
$line =~ s/\+/ /gos;
$line =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/egos;
$line;
}
#######################################################################
=over 4
=item C<$query-E<gt>htmlize($string);>
Returns HTML 'safe' encoding of input string. Replaces &,>,< and "
with their named entity codes
=back
=cut
sub htmlize {
my ($self) = shift;
my ($line)=@_;
return ('') if (! defined($line));
$line =~ s/\&/\&/gos;
$line =~ s/>/\>/gos;
$line =~ s/</\</gos;
$line =~ s/"/\"/gos;
$line;
}
#######################################################################
=over 4
=item C<$query-E<gt>dehtmlize($string);>
Undoes basic HTML encoding of input string. Replaces &,>,< and "
named entity codes with their actual values.
NOT a general purpose entity decoder.
=back
=cut
sub dehtmlize { # Undo any browser mis-coding of values
my ($self) = shift; # Can cause trouble in general. Use with caution.
my($line)=@_;;
return ('') if (! defined($line));
$line=~s/\>/>/go;
$line=~s/\</</go;
$line=~s/\"/\"/go;
$line=~s/\&/\&/go;
$line;
}
########################################################################
# Wrapper for form reading for GET, HEAD and POST methods #
########################################################################
sub _read_form {
my ($self) = shift;
return if (! defined($ENV{"REQUEST_METHOD"}));
my ($request_method)=$ENV{"REQUEST_METHOD"};
if ($request_method eq 'POST') {
$self->_read_post;
} elsif (($request_method eq 'GET') || ($request_method eq 'HEAD')) {
$self->_read_get;
}
}
########################################################################
# Performs form reading for POST method #
########################################################################
sub _read_post {
my ($self) = shift;
my ($read_length) = $self->{'jcgi'}{'max_buffer'};
if ($ENV{'CONTENT_LENGTH'} < $self->{'jcgi'}{'max_buffer'}) {
$read_length= $ENV{'CONTENT_LENGTH'};
}
my ($buffer) = '';
my ($read_bytes) = 0;
if ($read_length) {
$read_bytes = read(STDIN, $buffer, $read_length);
}
if ($read_bytes < $ENV{'CONTENT_LENGTH'}) {
$self->{'jcgi'}{'form_truncated'} = 1;
} else {
$self->{'jcgi'}{'form_truncated'} = 0;
}
# Default to this if they don't tell us
my ($content_type) = 'application/x-www-form-urlencoded';
if (defined($ENV{'CONTENT_TYPE'})) {
$content_type = $ENV{'CONTENT_TYPE'};
}
my ($boundary,$form_type);
if ($content_type =~ m#^multipart/form-data; boundary=(.*)$#oi) {
$form_type="multipart";
$boundary="--$1(--)?\r\n"; # Why the extra '--'?
$self->_burst_multipart_buffer ($buffer,$boundary);
} elsif ($content_type =~ m#^application/x-www-form-urlencoded$#oi) {
$form_type="xwwwformurlencoded";
$self->_burst_URL_encoded_buffer($buffer,$form_type);
} elsif ($content_type =~ m#^application/sgml-form-urlencoded$#oi) {
$form_type="sgmlformurlencoded";
$self->_burst_URL_encoded_buffer($buffer,$form_type);
}
}
########################################################################
# Performs form reading for GET and HEAD methods #
########################################################################
sub _read_get {
my ($self) = shift;
my ($buffer)='';
if (defined($ENV{'QUERY_STRING'})) {
$buffer = $ENV{'QUERY_STRING'};
}
my ($form_type);
if ( (! defined($ENV{'CONTENT_TYPE'})) || ($ENV{'CONTENT_TYPE'} =~ m#^application/x-www-form-urlencoded$#oi)) {
$form_type="xwwwformurlencoded";
# if running in SGML safe mode, do that ol' black magic
if ($self->{'jcgi'}{'sgml_safe_mode'}) {
if ($buffer) {
$buffer =~ s/\&/;/gos;
$buffer = "?${buffer}";
}
print "Status: 302 Moved Temporarily\r\n",
"Location: $ENV{SCRIPT_NAME}$ENV{PATH_INFO}$buffer\r\n\r\n";
exit; # We're done.
}
} elsif ($ENV{'CONTENT_TYPE'} =~ m#^application/sgml-form-urlencoded$#oi) {
$form_type="sgmlformurlencoded";
} else {
$form_type='xwwwformurlencoded';
}
$self->_burst_URL_encoded_buffer($buffer,$form_type);
}
##########################################################################
# Bursts normal URL encoded buffers #
# Takes: $buffer - the actual data to be burst #
# $form_type - 'xwwwformurlencoded','sgmlformurlencoded' #
# 'xwwwformurlencoded' is old style forms #
# 'sgmlformurlencoded' is new style SGML compatible forms #
##########################################################################
sub _burst_URL_encoded_buffer {
my ($self) = shift;
my ($buffer,$form_type)=@_;
my ($spliton) = '&';
my ($mime_type) = "text/plain";
my ($filename) = "";
$spliton = ';' if ($form_type eq 'sgmlformurlencoded'); # if they understand SGML encoding - do it.
# Split the name-value pairs on the selected split char
my (@pairs) = ();
if ($buffer) {
@pairs = split(/$spliton/, $buffer);
}
# Initialize the field hash and the field_names array
%{$$self{'jcgi'}{'field'}} = ();
@{$$self{'jcgi'}{'field_names'}} = ();
my ($pair);
foreach $pair (@pairs) {
my ($name, $data) = split(/=/, $pair);
# De-URL encode plus signs and %-encoding
$name = $self->url_decode($name);
$data = $self->url_decode($data);
if (! defined ($self->{'jcgi'}{'field'}{$name}{'count'})) {
push (@{$$self{'jcgi'}{'field_names'}},$name);
$self->{'jcgi'}{'field'}{$name}{'count'} = 0;
}
my ($field_count) = $self->{'jcgi'}{'field'}{$name}{'count'};
$self->{'jcgi'}{'field'}{$name}{'count'}++;
$self->{'jcgi'}{'field'}{$name}{'value'}[$field_count] = $data;
$self->{'jcgi'}{'field'}{$name}{'filename'}[$field_count] = $filename;
$self->{'jcgi'}{'field'}{$name}{'mime_type'}[$field_count] = $mime_type;
}
}
##########################################################################
# Bursts multipart mime encoded buffers #
# Takes: $buffer - the actual data to be burst #
# $boundary - the mime boundary to split on #
##########################################################################
sub _burst_multipart_buffer {
my ($self) = shift;
my ($buffer,$Boundary)=@_;
# Split the name-value pairs
my (@pairs) = split(/$Boundary/, $buffer);
# Initialize the field hash and the field_names array
%{$$self{'jcgi'}{'field'}} = ();
@{$$self{'jcgi'}{'field_names'}} = ();
my ($pair);
foreach $pair (@pairs) {
next if (! defined ($pair));
chop $pair; # Trailing \n left over from the boundary
chop $pair; # Trailing \r left over from the boundary
last if ($pair eq "--");
next if (! $pair);
# Split the header off from the actual data
my ($header, $data) = split(/\r\n\r\n/so,$pair,2);
# parse the header lines
$header =~ s/\r\n/\n/osg; # change all the \r\n to \n
my (@headerlines) = split(/\n/so,$header);
my ($name) = '';
my ($filename) = '';
my ($mime_type) = 'text/plain';
my ($headfield);
foreach $headfield (@headerlines) {
my ($fieldname,$fielddata) = split(/: /,$headfield);
if ($fieldname =~ m/^Content-Type$/io) {
$mime_type=$fielddata;
}
if ($fieldname =~ m/^Content-Disposition$/io) {
my (@dispositionlist) = split(/; /,$fielddata);
my ($dispitem);
foreach $dispitem (@dispositionlist) {
next if ($dispitem eq 'form-data');
my ($dispfield,$dispdata) = split(/=/,$dispitem,2);
$dispdata =~ s/^\"//o;
$dispdata =~ s/\"$//o;
$name = $dispdata if ($dispfield eq 'name');
$filename = $dispdata if ($dispfield eq 'filename');
}
}
}
if (! defined ($self->{'jcgi'}{'field'}{$name}{'count'})) {
push (@{$$self{'jcgi'}{'field_names'}},$name);
$self->{'jcgi'}{'field'}{$name}{'count'} = 0;
}
my ($field_count) = $self->{'jcgi'}{'field'}{$name}{'count'};
$self->{'jcgi'}{'field'}{$name}{'count'}++;
$self->{'jcgi'}{'field'}{$name}{'value'}[$field_count] = $data;
$self->{'jcgi'}{'field'}{$name}{'filename'}[$field_count] = $filename;
$self->{'jcgi'}{'field'}{$name}{'mime_type'}[$field_count] = $mime_type;
}
}
=head1 AUTHOR
Benjamin Franz
=head1 TODO
Debugging.
=cut
1;
------------------------------
Date: Fri, 23 Apr 1999 19:55:51 -0400
From: Rajesh Radhakrishnan <rradhakr@ececs.uc.edu>
Subject: Re: Can a DNS lookup be performed from within perl ?
Message-Id: <37210887.24C61A7A@ececs.uc.edu>
Uri Raz wrote:
> I'm working on a perl script that analyses a web server's log file.
>
> As part of the script I want to translate an IP address into a host's
> name, using (reverse) DNS lookup.
>
> Is there a way to do this from within perl, as a function and not by
> calling a shell to perform nslookup ?
>
> --
> +---------+---------------------------+---------------------------------+
> | Uri Raz | mailto:uraz@iil.intel.com | I speak for myself, not Intel. |
> | Work is what employees do while managers lay down the work plans. ;-) |
> | My home page <URL:http://www.private.org.il> |
> +-----------------------------------------------------------------------+
Try this,
open(IN,"$log_file") or die "Can't open file $log_file\n";
open(OUT,"> $output_file");
my %ip_addr=();
my $machine_name=undef;
while(<IN>) {
# search for IP address eg.129.137.4.62 in log file
if (m/(\d+.\d+.\d+.\d+)/) {
# has this IP address been checked before
if (!exists($ip_addr{$1})) {
# if not in the hash table
$machine_name = gethostbyaddr(inet_aton($1), AF_INET)
# if the IP address can't be resolved, set machine_name to be the IP
address
or $machine_name=$1;
# insert it into the hash table
$ip_addr{$1} = $machine_name;
# replace the IP address in $_ with the machine name
$_ =~ s/(\d+.\d+.\d+.\d+)/$machine_name/;
}
else {
$machine_name = $ip_addr{$1};
$_ =~ s/(\d+.\d+.\d+.\d+)/$machine_name/;
}
print OUT $_;
}
}
- Rajesh
------------------------------
Date: Fri, 23 Apr 1999 16:26:04 -0700
From: David Cassell <cassell@mail.cor.epa.gov>
Subject: Re: embedding Perl in C
Message-Id: <3721018C.2021B856@mail.cor.epa.gov>
Soo Jang wrote:
>
> Does anybody know the performance difference between a regular
> C program and an embedded Perl in C program
> to perform the same task?
I can't tell from way over here. It depends on far too many things:
Do you mean an *expertly-written* chunk of C code to do the same thing?
Because the Perl opcodes are implemented in the fastest C code I ever
hurt my cerebrum staring at.
Do you factor in Perl's malloc() vs. the system malloc() ?
What are you using the Perl code to do, and are you using Perl in
an efficient manner? Is your code the fastest way to implement
the problem in Perl? Bear in mind that is *not* necessarily the
same as the fastest way to implement it in C.
Is raw performance even the feature which is most important for
your program, or do you really need to consider other optimality
criteria?
Okay, enough blathering. The only way I know to tell is to
write the code both ways and clock it yourself. When you get both
programs running, come back and tell us how the benchmarks came
out. Be sure to include relevant code, so we can see if you
did a near-optimal job.
David
--
David Cassell, OAO cassell@mail.cor.epa.gov
Senior Computing Specialist phone: (541) 754-4468
mathematical statistician fax: (541) 754-4716
------------------------------
Date: Fri, 23 Apr 1999 16:38:18 -0700
From: David Cassell <cassell@mail.cor.epa.gov>
Subject: Re: Encrypt/Decrypt
Message-Id: <3721046A.C6AFCD94@mail.cor.epa.gov>
Goof wrote:
>
> I am going to say yes it can be done.
I agree with this part.
> How safe from others decrypting I could not say. I can also not give
> you code because I have not come along far enough in perl to do this
> but here is how I did it, for a class many years ago in college in C.
>
> Take your input and XOR it with some key value. Make the key some sort
> of alphanumeric value that would be hard for someone to figure out.
>
> After the XOR dump it to the file. It will write to file a mess of
> weird characters along with characters from the alphabet.
Eeeeewwwwww. Please don't do this.. unless you're only trying to
protect your files from technoturnips and pointy-haired bosses.
This is *not* a good encryption methodology. For an example of how
weak this technique is, check out most of the so-called 'encrypted'
passowrds in Microsoft products. Granted, they use a painfully-
short key.
If it's worth going to the trouble of encrypting your files, it
should be worth the trouble to ensure that Seymour Scriptkiddie
can't crack it in 12 seconds with downloaded alt.2600 crud.
> Now to decode it run the input from the file through the XOR again
> using the same key. Whalla .. it's back to readable by you and I.
This is fine for RAID, but the purpose there is being able to
easily get back to the original state without all the disks on-line
anymore.
> As I stated, this is not 100% safe from someone cracking the key. But
> it will keep the average snoop from reading what is stored in the
> file.
Much better: stroll on over to CPAN and check out one of the many
Crypt::* modules already written for your crypting pleasure.
DES? It's there.
MD5? It's there. [Use it for signatures, not large files, okay?]
SHA.
IDEA.
They're waiting for you. Go for the gusto.
HTH,
David
--
David Cassell, OAO cassell@mail.cor.epa.gov
Senior Computing Specialist phone: (541) 754-4468
mathematical statistician fax: (541) 754-4716
------------------------------
Date: Fri, 23 Apr 1999 16:44:15 -0700
From: David Cassell <cassell@mail.cor.epa.gov>
Subject: Re: Help: Problem capturing cntl-c signal in perl script
Message-Id: <372105CF.9304FB45@mail.cor.epa.gov>
Jonathan Stowe wrote:
>
> On Thu, 22 Apr 1999 13:29:59 -0700 Eric Castle wrote:
> > Sorry for the multiple posting. I only posted once. Not sure why it is
> > showing up 3 times.
> >
>
> Don't worry its not your fault - some news server belonging to uunet in
> Germany went into one and started reposting articles.
I thought it was another part of Bill Gates' attempt to drive TomC
off the deep end.
And I take it you're claiming it was just an accident that this only
seemed to be happening in c.l.p.* ? A likely story...
:-)
--
David Cassell, OAO cassell@mail.cor.epa.gov
Senior Computing Specialist phone: (541) 754-4468
mathematical statistician fax: (541) 754-4716
------------------------------
Date: Fri, 23 Apr 1999 16:19:15 -0700
From: David Cassell <cassell@mail.cor.epa.gov>
Subject: Re: newbie with a "howto" question
Message-Id: <3720FFF3.567A8BC@mail.cor.epa.gov>
Eric Bohlman wrote:
>
> David Cassell <cassell@mail.cor.epa.gov> wrote:
> : And it also depends on the question itself. A Perl question is
> : more likely to get an answer than some html or Os question dressed up
> ^^^^^^^^^^
> : in a llama's coat. Or a question about WebTV, or shell programming,
> ^^^^^^^^^^^^^^^^^
> : or ...
>
> This metaphor deserves to be used as frequently as the one that calls
> perl 4 a "dead flea-bitten camel carcass."
Why, thank you. I would be honored. :-)
David
--
David Cassell, OAO cassell@mail.cor.epa.gov
Senior Computing Specialist phone: (541) 754-4468
mathematical statistician fax: (541) 754-4716
------------------------------
Date: 23 Apr 1999 16:49:11 -0700
From: Ray Baxter <ray@perry.geo.berkeley.edu>
Subject: Re: newbie with a "howto" question
Message-Id: <shr9paq4nc.fsf@perry.geo.berkeley.edu>
David Cassell <cassell@mail.cor.epa.gov> writes:
> Try the following commands, and see what niftiness awaits you:
> perldoc -q uniq [or perldoc -q unique]
perldoc perldoc
doesn't describe the -q option and
perldoc -q uniq
doesn't tell me anything.
Is my perldoc out of date?
--
Ray Baxter
Berkeley Seismological Laboratory
University of California
------------------------------
Date: Fri, 23 Apr 1999 16:58:29 -0700
From: David Cassell <cassell@mail.cor.epa.gov>
Subject: Re: newbie with a "howto" question
Message-Id: <37210925.E485C67E@mail.cor.epa.gov>
Ray Baxter wrote:
>
> David Cassell <cassell@mail.cor.epa.gov> writes:
>
> > Try the following commands, and see what niftiness awaits you:
>
> > perldoc -q uniq [or perldoc -q unique]
>
> perldoc perldoc
>
> doesn't describe the -q option and
>
> perldoc -q uniq
>
> doesn't tell me anything.
>
> Is my perldoc out of date?
Probably. This works in 5.005, but not in my copy of 5.004_04 .
Another good reason to upgrade.
HTH,
David
--
David Cassell, OAO cassell@mail.cor.epa.gov
Senior Computing Specialist phone: (541) 754-4468
mathematical statistician fax: (541) 754-4716
------------------------------
Date: Fri, 23 Apr 1999 23:04:17 GMT
From: Rashid Karimov <rashidk@home.net>
Subject: Parse::Lex problem (bug ?)
Message-Id: <3720F63C.80BFAD9C@home.net>
Attached is a simple test program, that parses the input for:
<OBJECT *>
anything here
</OBJECT>
tag. Now, it does find such token , but does not execute the subroutine
that is defined for it.
In other words, if you just run it, you will get the following output:
$ ================> Type: OBJECT_DECL
which means that the token was recognised, but the subroutine does not
get executed . Am I doing
anything wrong here or is it a problem with Parse::Lex or ::Token ?
Please help.
Rashid.
#!/usr/local/bin/perl -w
require 5.004;
use Parse::Lex;
@token = (
##########################################################################################
'OBJECT_DECL', [qw(<OBJECT (?s:.*?) </OBJECT>)],
sub {
print "Got Object Declaration!\n";
print " $_[1] \n";
$_[1];
},
);
#########################################################################################
$lexer = Parse::Lex->new(@token);
$lexer->skip('');
$lexer->from(\*DATA);
TOKEN:while (1) {
$token = $lexer->next;
if (not $lexer->eoi) {
print " ================> Type: ", $token->name, "\n";
} else {
last TOKEN;
}
}
__END__
<OBJECT TYPE=OSP_EDO CLASS_ID=PROD_EDO NAME=prod1>
<PARAM NAME=ID VALUE =1223>
<PARAM CATEGORY= VALUE =TOYS>
</OBJECT>
################ END OF CODE. #############
------------------------------
Date: Fri, 23 Apr 1999 23:04:20 GMT
From: Rashid Karimov <rashidk@home.net>
Subject: Parse::Lex problem (bug ?)
Message-Id: <3720F640.32731D82@home.net>
Attached is a simple test program, that parses the input for:
<OBJECT *>
anything here
</OBJECT>
tag. Now, it does find such token , but does not execute the subroutine
that is defined for it.
In other words, if you just run it, you will get the following output:
$ ================> Type: OBJECT_DECL
which means that the token was recognised, but the subroutine does not
get executed . Am I doing
anything wrong here or is it a problem with Parse::Lex or ::Token ?
Please help.
Rashid.
#!/usr/local/bin/perl -w
require 5.004;
use Parse::Lex;
@token = (
##########################################################################################
'OBJECT_DECL', [qw(<OBJECT (?s:.*?) </OBJECT>)],
sub {
print "Got Object Declaration!\n";
print " $_[1] \n";
$_[1];
},
);
#########################################################################################
$lexer = Parse::Lex->new(@token);
$lexer->skip('');
$lexer->from(\*DATA);
TOKEN:while (1) {
$token = $lexer->next;
if (not $lexer->eoi) {
print " ================> Type: ", $token->name, "\n";
} else {
last TOKEN;
}
}
__END__
<OBJECT TYPE=OSP_EDO CLASS_ID=PROD_EDO NAME=prod1>
<PARAM NAME=ID VALUE =1223>
<PARAM CATEGORY= VALUE =TOYS>
</OBJECT>
################ END OF CODE. #############
------------------------------
Date: Sat, 24 Apr 1999 00:11:47 GMT
From: dmi2@netcom.com (D. M. Ilstrup)
Subject: perl_destruct and core dumps.
Message-Id: <dmi2FAo37n.94s@netcom.com>
I'm having what I believe to be a perl_destruct related
problem.
I've got a persistant app that occasionally needs to run
perl scripts. It does so by the series of calls
perl_alloc
perl_construct
perl_parse
perl_run
perl_destruct
perl_free
Pretty standard. Everything works fine for a few times
(anywhere from 5 to 50 times, depending on what script I
run).
But eventually there is a core dump; segmentation violation
from inside the interpreter, always inside pp_sort.
Now I have set perl_destruct_level to 1, because I noticed
horrible memory leaks before when it was set to 0.
I'm using system malloc on DEC 4.0d, compiled cc without
any thread support.
I realize that this could be lots of things, but I'm suspicious
of perl_destruct simply because it is apparently a memory management
issue that's blowing me up, and I have changed the way it works
'out of the box' by changing the default value of perl_destruct_level.
Anyone have any words of wisdom for this?
Thanks,
-Dave i.
------------------------------
Date: 23 Apr 1999 17:19:13 -0700
From: Tom Christiansen <tchrist@mox.perl.com>
Subject: Re: Problems with the connect function
Message-Id: <3720fff1@cs.colorado.edu>
[courtesy cc of this posting sent to cited author via email]
In comp.lang.perl.misc,
lr@hpl.hp.com (Larry Rosler) writes:
:No comment on your skewering of the Perl code. But you were at least a
:tiny bit too harsh about the unquoted HTML.
I ran weblint with -pedantic. Apparently it whinges more than
you would prefer. :-)
--tom
--
"The social dynamics of the net are a direct consequence of the fact
that nobody has yet developed a Remote Strangulation Protocol."
--Larry Wall
------------------------------
Date: Fri, 23 Apr 1999 23:30:48 GMT
From: networks@skynet.co.uk
Subject: Question: Opening and closing files.
Message-Id: <372100b0.15978191@news.skynet.co.uk>
Hi,
Can anyone answer this question?
Once a file (text for example) has been opened by a perl script, can
another script open that file before the first script closes the file?
eg. a script opens a text file to search for a word, another script
also tries to open the same text file while the first script is still
searching the text file.
Any help and info very much appreciated - thanks in advance.
------------------------------
Date: Fri, 23 Apr 1999 17:03:16 -0700
From: David Cassell <cassell@mail.cor.epa.gov>
Subject: Re: Question: Opening and closing files.
Message-Id: <37210A44.47C2D26A@mail.cor.epa.gov>
networks@skynet.co.uk wrote:
>
> Hi,
>
> Can anyone answer this question?
>
> Once a file (text for example) has been opened by a perl script, can
> another script open that file before the first script closes the file?
>
> eg. a script opens a text file to search for a word, another script
> also tries to open the same text file while the first script is still
> searching the text file.
You betchum, Red Rider.
This sort of problem can lead to all sorts of horrible things,
like corrupt data files.. and [gasp!] non-working web counters. :-)
Read up on flock() and the Fcntl module if you need to lock the files
so that only one person at a time can ruin them.
If you need record-level locking, you'll have to look into one of
the databases and the DBI interface.
> Any help and info very much appreciated - thanks in advance.
HTH,
David
--
David Cassell, OAO cassell@mail.cor.epa.gov
Senior Computing Specialist phone: (541) 754-4468
mathematical statistician fax: (541) 754-4716
------------------------------
Date: 23 Apr 1999 18:57:19 -0700
From: Tom Christiansen <tchrist@mox.perl.com>
Subject: Re: Question: Opening and closing files.
Message-Id: <372116ef@cs.colorado.edu>
[courtesy cc of this posting sent to cited author via email]
In comp.lang.perl.misc, networks@skynet.co.uk writes:
:Once a file (text for example) has been opened by a perl script, can
:another script open that file before the first script closes the file?
Consult the source for your kernel's implementation of its
open(2) system call. That should answer your question.
--tom
--
Besides, it's good to force C programmers to use the toolbox occasionally. :-)
--Larry Wall in <1991May31.181659.28817@jpl-devvax.jpl.nasa.gov>
------------------------------
Date: 23 Apr 1999 17:24:28 -0600
From: Eric The Read <emschwar@rmi.net>
Subject: Re: Refresh button on a web page?
Message-Id: <xkfaevyhqdv.fsf@valdemar.col.hp.com>
"David MacBride" <dmacbride@home.com> writes:
> Can I put a refresh button on a web page?
Good heavens, no! Next thing, you'll be telling me you want to put a
"back" button there. And then a "forward" button. And then a "Just a
little to the left" button.
Some things Man was just not meant to know.
> Basically I want to have a button that the user can press if they want
> the page to be reloaded from the server. Is it possible?
Beware! You're devling into the black arts of the Mad Wizard, Abdul
Al-Hazred! If you travel down that road, forever will it dominate your
destiny!
> How can I learn about doing it?
Maybe by asking in an appropriate newsgroup?
> Please respond by mail to dmacbride@home.com
Ask it here, get mocked here.
-=Eric
------------------------------
Date: Fri, 23 Apr 1999 15:17:51 -0400
From: Yu Fang <yfang@gte.com>
Subject: Re: Sorting Array of Arrays
Message-Id: <3720C75F.85329879@gte.com>
I suggest you use hash of arrays, instead of array of arrays. You can
then sort the keys of hash.
Good luck.
Kent Kling wrote:
>
> I have the following code:
>
> #!/usr/bin/perl -w
>
> open( FD, "</u/kkling/myfile.txt");
>
> $row=0;
> while ( <FD> )
> {
> $row++;
> my @line = split;
> @LoL[$row] = [ @line ];
> }
>
> /u/kkling/myfile.txt looks like
>
> 7033250001 100 123
> 7031239900 56 23
> 7021231231 123 190
> 5141231233 12 723
> 2121212809 912 542
>
> how can I sort these? Do anyone have a clue how I can use sort on a
> List of Lists ( Array of Arrays ) @LoL ?
>
> Kent Kling
--
------------------------------
Date: Fri, 23 Apr 1999 17:19:50 -0700
From: lr@hpl.hp.com (Larry Rosler)
Subject: Re: Sorting Array of Arrays
Message-Id: <MPG.118aadfbab5fd42098992d@nntp.hpl.hp.com>
[Posted and a courtesy copy sent.]
1. Please put the material you are referring to ahead of your comments,
so that they can be read in rational sequence.
2. Please quote only the material you are referring to, not the whole
article.
A proper newsreader would help you do these things.
In article <3720C75F.85329879@gte.com> on Fri, 23 Apr 1999 15:17:51 -
0400, Yu Fang <yfang@gte.com> says...
> Kent Kling wrote:
> > how can I sort these? Do anyone have a clue how I can use sort on a
> > List of Lists ( Array of Arrays ) @LoL ?
>
> I suggest you use hash of arrays, instead of array of arrays. You can
> then sort the keys of hash.
Huh? That doesn't give him a sorted List of Lists. It gives him a hash
that he has to sort again every time he wants to use the lists in sorted
order.
--
(Just Another Larry) Rosler
Hewlett-Packard Company
http://www.hpl.hp.com/personal/Larry_Rosler/
lr@hpl.hp.com
------------------------------
Date: 12 Dec 98 21:33:47 GMT (Last modified)
From: Perl-Request@ruby.oce.orst.edu (Perl-Users-Digest Admin)
Subject: Special: Digest Administrivia (Last modified: 12 Dec 98)
Message-Id: <null>
Administrivia:
Well, after 6 months, here's the answer to the quiz: what do we do about
comp.lang.perl.moderated. Answer: nothing.
]From: Russ Allbery <rra@stanford.edu>
]Date: 21 Sep 1998 19:53:43 -0700
]Subject: comp.lang.perl.moderated available via e-mail
]
]It is possible to subscribe to comp.lang.perl.moderated as a mailing list.
]To do so, send mail to majordomo@eyrie.org with "subscribe clpm" in the
]body. Majordomo will then send you instructions on how to confirm your
]subscription. This is provided as a general service for those people who
]cannot receive the newsgroup for whatever reason or who just prefer to
]receive messages via e-mail.
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 5470
**************************************
