[17667] in Perl-Users-Digest
Perl-Users Digest, Issue: 5087 Volume: 9
daemon@ATHENA.MIT.EDU (Perl-Users Digest)
Tue Dec 12 03:05:40 2000
Date: Tue, 12 Dec 2000 00:05:08 -0800 (PST)
From: Perl-Users Digest <Perl-Users-Request@ruby.OCE.ORST.EDU>
To: Perl-Users@ruby.OCE.ORST.EDU (Perl-Users Digest)
Message-Id: <976608307-v9-i5087@ruby.oce.orst.edu>
Content-Type: text
Perl-Users Digest Tue, 12 Dec 2000 Volume: 9 Number: 5087
Today's topics:
Re: Can we have left side info of subs, as 'split' does (Damian Conway)
Cookie retrieval question. (Loans2001)
Re: Faster than LWP <whataman@home.com>
Re: Need help to replace passwd - New at this ! (Chris Fedde)
Re: Problem understanding references <uri@sysarch.com>
Re: single quote hell (Logan Shaw)
time differences qwex@my-deja.com
Re: Visual Perl (Latka)
Re: Why isn't Perl highly orthogonal? (Rafael Garcia-Suarez)
Re: Why isn't Perl highly orthogonal? (Logan Shaw)
Digest Administrivia (Last modified: 16 Sep 99) (Perl-Users-Digest Admin)
----------------------------------------------------------------------
Date: 12 Dec 2000 05:23:11 GMT
From: damian@cs.monash.edu.au (Damian Conway)
Subject: Re: Can we have left side info of subs, as 'split' does?
Message-Id: <914cnv$c47$1@towncrier.cc.monash.edu.au>
Jeff Pinyan <jeffp@crusoe.net> writes:
>>>It means 'split' has the information of the left side of sub calling.
>>>Can we also do that?
>>>The first thought that came to my mind was 'wantarray'.
>>
>>Yes it is.
>No, it's not. We currently have no way of knowing how many arguments a
>function is expected to return. That might actually be a nice thing to
>have.
Jeff is correct, and I have a paper on that. :-)
See: http://dev.perl.org/rfc/21.html
Damian
------------------------------
Date: 12 Dec 2000 06:53:47 GMT
From: loans2001@aol.com (Loans2001)
Subject: Cookie retrieval question.
Message-Id: <20001212015347.20345.00004622@ng-bj1.aol.com>
I have an affiliate script that signs up new affiliates. They stick a graphic
on their website, and when someone clicks on it, it transports the surfer to my
site. When it does this, the program is supposed to stick a cookie into their
browser. I need the cookie there so that if and when they come back, since they
may not sign up for my program right then and there, I need to read the cookie
in their browser that should have the affiliate's id. Without the id, if
someone signs up, I need to know who gets the credit for the sign up.
I need to understand more about the Setcookie program. How can I make sure the
id is written to the cookie, so that name=affiliate and value=cookie. I read
on the Netscape page on cookies that you can have as many name=value fields as
you want. I'm using the following script: How do I check the cookie later for
an affiliate = field later?
#!/usr/bin/perl
####################################
# #
#affiliates redirection script v.2 #
# #
# by Pierre Rodrigues #
# #
# 1999-2000 #
####################################
###########################################
#Nothing below this line should be changed
###########################################
require "config.cgi";
#require 'cookie.lib';
use CGI::Carp (fatalsToBrowser);
#print "Content-type: text/html\n\n";
# get data from link
$ip=$ENV{'REMOTE_ADDR'};
$http=$ENV{'HTTP_REFERER'};
$id=$ENV{'QUERY_STRING'};
$id=lc($id);
# raw click saving
$timenow = time;
open(FILE, ">>$clicklog") || die "I can't open $logfile2";
print FILE "$timenow $id $ip $http\n";
close (FILE);
##############################
# IF NO URL THEN NO CLICK !
if (!($http)){
print "Location: $URL\nURI: $URL\n\n" ;
exit;
}
##############################
if (-f "$regdir/$id.dat") {
&clickprocess;
}
#no matching member id found, so redirect with no click record
#redirection
print "Location: $URL\nURI: $URL\n\n" ;
exit;
########################
#process click
sub clickprocess {
open(FILE, "$regdir/$id.dat") || die "I can't open $regdir/$id.dat";
@all=<FILE>;
close (FILE);
# canceled accounts do not receive clicks
if ($all[0]=~/Canceled/){
print "Location: $URL\nURI: $URL\n\n" ;
exit;
}
($idfile,$clicks,$ipfile)=split (/\|/,$all[0]);
chomp ($ipfile);
if ($ipfile=~/\+/){
($iplog2,$iplog1)=split (/\+/,$ipfile);
}else{
$iplog1=$ipfile;
}
#check if IP is different and if so add one count to clicks
if ($iplog1 eq $ip or $iplog2 eq $ip){
#redirect without click sum because only one click allowed for each visitor
print "Location: $URL\nURI: $URL\n\n" ;
}else{
&cookies_check;
} #end if
} #end sub
########################
#add click to member
sub cookies_check {
if (&GetCookies("$cookiename")) {
#redirect without click sum because only one click allowed for each visitor
print "Location: $URL\nURI: $URL\n\n" ;
}else{
# Print out the HTML Content-Type header. #
# print "Content-type: text/html\n";
# Set a new cookie. #
$time=time;
$time=$time+($cookierange*86400);
$expiration1=localtime($time);
(@splitdate)=split(/ /,$expiration1);
if (length($splitdate[2]) >1 ){
$compdate=0;
$day=$splitdate[2+$compdate];
}else{
$compdate=1;
$day="0".$splitdate[2+$compdate];
}
$expiration="$splitdate[0], $day\-$splitdate[1]\-$splitdate[4+$compdate]
00:00:00 GMT";
&SetCookieExpDate($expiration);
&SetCookies("$cookiename",'1');
&addclick;
}
}
########################
#add click to member
sub addclick {
#add one click count
$clicks++;
#saves the new log file with new click value for the member
open(FILE, ">$regdir/$id.dat") || die "I can't open $regdir/$id.dat";
&lock;
print FILE "$id|$clicks|$iplog1+$ip\n";
close (FILE);
#finally redirects to the URL
print "Location: $URL\nURI: $URL\n\n" ;
} #end sub
##############################################
# Sub: File Lock
# This locks files when bidding takes place
sub lock {
flock (FILE, 2);
seek(FILE, 0, 2);
}
##############################################################################
##############################################################################
# HTTP Cookie Library Version 2.1 #
# Copyright 1996 Matt Wright mattw@worldwidemart.com #
# Created 07/14/96 Last Modified 12/23/96 #
# Script Archive at: http://www.worldwidemart.com/scripts/ #
# Extensive Documentation found in README file.#
##############################################################################
# COPYRIGHT NOTICE #
# Copyright 1996 Matthew M. Wright. All Rights Reserved. #
# #
# HTTP Cookie Library may be used and modified free of charge by anyone so #
# long as this copyright notice and the comments above remain intact. By #
# using this code you agree to indemnify Matthew M. Wright from any #
# liability that might arise from it's use. #
# #
# Selling the code for this program without prior written consent is #
# expressly forbidden. In other words, please ask first before you try and #
# make money off of my program. #
# #
# Obtain permission before redistributing this software over the Internet or #
# in any other medium. In all cases copyright and header must remain intact.#
##############################################################################
# Define variables for this library. #
# By default this will be set to the same path as the document being #
# described by the header which contains the cookie. #
$Cookie_Path = '';
# This should be set to 0 if the cookie is safe to send across over #
# unsecured channels. If set to 1 the cookie will only be transferred #
# if the communications channel with the host is a secure one. Currently #
# this means that secure cookies will only be sent to HTTPS (HTTP over #
# SSL) servers. According to Netscape docs at least. #
$Secure_Cookie = '0';
# These are the characters which the HTTP Cookie Library will translate #
# to url encoded (hex characters) when it sets individual or compressed #
# cookies. The array holds the order in which these should be #
# translated (as we wouldn't want to translate spaces into pluses and #
# then pluses into the URL encoded form, but rather the other way #
# around) and the associative array holds the values to translate #
# characters into. The decoded set will reverse the process. Feel free #
# to add any other characters here, but it shouldn't be necessary. #
# This is a correction in version 2.1 which makes this library adhere #
# more to the Netscape specifications. #
@Cookie_Encode_Chars = ('\%', '\+', '\;', '\,', '\=', '\&', '\:\:', '\s');
%Cookie_Encode_Chars = ('\%', '%25',
'\+', '%2B',
'\;', '%3B',
'\,', '%2C',
'\=', '%3D',
'\&', '%26',
'\:\:', '%3A%3A',
'\s', '+');
@Cookie_Decode_Chars = ('\+', '\%3A\%3A', '\%26', '\%3D', '\%2C', '\%3B',
'\%2B', '\%25');
%Cookie_Decode_Chars = ('\+', ' ',
'\%3A\%3A', '::',
'\%26', '&',
'\%3D', '=',
'\%2C', ',',
'\%3B', ';',
'\%2B', '+',
'\%25', '%');
# Done #
##############################################################################
##############################################################################
# Subroutine: &GetCookies() #
# Description: This subroutine can be called with or without arguments. If #
# arguments are specified, only cookies with names matching #
# those specified will be set in %Cookies. Otherwise, all #
# cookies sent to this script will be set in %Cookies. #
# Usage: &GetCookies([cookie_names]) #
# Variables: cookie_names - These are optional (depicted with []) and #
# specify the names of cookies you wish to set.#
# Can also be called with an array of names. #
# Ex. 'name1','name2' #
# Returns: 1 - If successful and at least one cookie is retrieved. #
# 0 - If no cookies are retrieved. #
##############################################################################
sub GetCookies {
# Localize the variables and read in the cookies they wish to have #
# returned. #
local(@ReturnCookies) = @_;
local($cookie_flag) = 0;
local($cookie,$value);
# If the HTTP_COOKIE environment variable has been set by the call to #
# this script, meaning the browser sent some cookies to us, continue. #
if ($ENV{'HTTP_COOKIE'}) {
# If specific cookies have have been requested, meaning the #
# @ReturnCookies array is not empty, proceed. #
if ($ReturnCookies[0] ne '') {
# For each cookie sent to us: #
foreach (split(/; /,$ENV{'HTTP_COOKIE'})) {
# Split the cookie name and value pairs, separated by '='. #
($cookie,$value) = split(/=/);
# Decode any URL encoding which was done when the compressed #
# cookie was set. #
foreach $char (@Cookie_Decode_Chars) {
$cookie =~ s/$char/$Cookie_Decode_Chars{$char}/g;
$value =~ s/$char/$Cookie_Decode_Chars{$char}/g;
}
# For each cookie to be returned in the @ReturnCookies array:#
foreach $ReturnCookie (@ReturnCookies) {
# If the $ReturnCookie is equal to the current cookie we #
# are analyzing, set the cookie name in the %Cookies #
# associative array equal to the cookie value and set #
# the cookie flag to a true value. #
if ($ReturnCookie eq $cookie) {
$Cookies{$cookie} = $value;
$cookie_flag = "1";
}
}
}
}
# Otherwise, if no specific cookies have been requested, obtain all #
# cookied and place them in the %Cookies associative array. #
else {
# For each cookie that was sent to us by the browser, split the #
# cookie name and value pairs and set the cookie name key in the #
# associative array %Cookies equal to the value of that cookie. #
# Also set the coxokie flag to 1, since we set some cookies. #
foreach (split(/; /,$ENV{'HTTP_COOKIE'})) {
($cookie,$value) = split(/=/);
# Decode any URL encoding which was done when the compressed #
# cookie was set. #
foreach $char (@Cookie_Decode_Chars) {
$cookie =~ s/$char/$Cookie_Decode_Chars{$char}/g;
$value =~ s/$char/$Cookie_Decode_Chars{$char}/g;
}
$Cookies{$cookie} = $value;
}
$cookie_flag = 1;
}
}
# Return the value of the $cookie_flag, true or false, to indicate #
# whether we succeded in reading in a cookie value or not. #
return $cookie_flag;
}
##############################################################################
# Subroutine: &SetCookieExpDate() #
# Description: Sets the expiration date for the cookie. #
# Usage: &SetCookieExpDate('date') #
# Variables: date - The date you wish for the cookie to expire, in the #
# format: Wdy, DD-Mon-YYYY HH:MM:SS GMT #
# Ex. 'Wed, 09-Nov-1999 00:00:00 GMT' #
# Returns: 1 - If successful and date passes regular expression check #
# for format errors and the new ExpDate is set. #
# 0 - If new ExpDate was not set. Check format of date. #
##############################################################################
sub SetCookieExpDate {
# If the date string is formatted as: Wdy, DD-Mon-YYYY HH:MM:SS GMT, set #
# the $Cookie_Exp_Date to the new value and return 1 to signal success. #
# Otherwise, return 0, as the date was not successfully changed. #
# The date can also be set null value by calling: SetCookieExpDate(''). #
if ($_[0] =~ /^\w{3}\,\s\d{2}\-\w{3}-\d{4}\s\d{2}\:\d{2}\:\d{2}\sGMT$/ ||
$_[0] eq '') {
$Cookie_Exp_Date = $_[0];
return 1;
}
else {
return 0;
}
}
##############################################################################
# Subroutine: &SetCookiePath() #
# Description: Sets the path for the cookie to be sent to. #
# Usage: &SetCookiePath('path') #
# Variables: path - The path to which this cookie should be sent. #
# Ex. '/' or '/path/to/file' #
# Returns: Nothing. #
##############################################################################
sub SetCookiePath {
# Set the new Cookie Path, assuming it is correct. No error checking is #
# done. #
$Cookie_Path = $_[0];
}
##############################################################################
# Subroutine: &SetCookieDomain() #
# Description: Sets the domain for the cookie to be sent to. You can only #
# specify a domain within the current domain. Must have 2 or #
# 3 periods, depending on type of domain. e.g., .domain.com #
# or .k12.co.us. #
# Usage: &SetCookieDomain('domain') #
# Variables: domain - The domain to set the cookie for. #
# Ex. '.host.com' #
# Returns: 1 - If successful and value of $Cookie_Domain was set. #
# 0 - If unsuccessful and value was not changed. #
##############################################################################
sub SetCookieDomain {
# Following Netscape specifications, if the domain specified is one of 7 #
# top level domains, only require it to contain two periods, and if it #
# is not, require that there be three. If the new domain passes error #
# checking, set the new domain and return a true value. Otherwise, #
# return 0. Trying to set a domain other than the current one is futile,#
# since the browser won't allow it. But if people may be accessing the #
# page from www.host.xxx or host.xxx, you may wish to set it to .host.xxx#
# so that either host the access will have access to the cookie. #
if ($_[0] =~ /(.com|.edu|.net|.org|.gov|.mil|.int)$/i &&
$_[0] =~ /\..+\.\w{3}$/) {
$Cookie_Domain = $_[0];
return 1;
}
elsif ($_[0] !~ /(.com|.edu|.net|.org|.gov|.mil|.int)$/i &&
$_[0] =~ /\..+\..+\..+/) {
$Cookie_Domain = $_[0];
return 1;
}
else {
return 0;
}
}
##############################################################################
# Subroutine: &SetSecureCookie() #
# Description: This subroutine will set the cookie to be either secure, #
# meaning the cookie will only be passed over a secure HTTP #
# channel, or unsecure, meaning it is safe to pass unsecured. #
# Usage: &SetSecureCookie('flag') #
# Variables: flag - 0 or 1 depending whether you want it secure or not #
# secure. By default, it is set to unsecure, unless #
# $Secure_Cookie was changed at the top. #
# Ex. 1 #
# Returns: 1 - If successful and value of $Secure_Cookie was set. #
# 0 - If unsuccessful and value was not changed. #
##############################################################################
sub SetSecureCookie {
# If the value passed to this script is a 1 or 0, set $Secure_Cookie #
# accordingly and return a true value. Otherwise, return a false value. #
if ($_[0] =~ /^[01]$/) {
$Secure_Cookie = $_[0];
return 1;
}
else {
return 0;
}
}
##############################################################################
# Subroutine: &SetCookies() #
# Description: Sets one or more cookies by printing out the Set-Cookie #
# HTTP header to the browser, based on cookie information #
# passed to subroutine. #
# Usage: &SetCookies(name1,value1,...namen,valuen) #
# Variables: name - Name of the cookie to be set. #
# Ex. 'count' #
# value - Value of the cookie to be set. #
# Ex. '3' #
# n - This is tacked on to the last of the name and value #
# pairs in the usage instructions just to show you #
# you can have as many name/value pairs as you wish. #
# ** You can specify as many name/value pairs as you wish, and #
# &SetCookies will set them all. Just string them out, one #
# after the other. You must also have already printed out #
# the Content-type header, with only one new line following #
# it so that the header has not been ended. Then after the #
# &SetCookies call, you can print the final new line. #
# Returns: Nothing. #
##############################################################################
sub SetCookies {
# Localize variables and read in cookies to be set. #
local(@cookies) = @_;
local($cookie,$value,$char);
# While there is a cookie and a value to be set in @cookies, that hasn't #
# yet been set, proceed with the loop. #
while( ($cookie,$value) = @cookies ) {
# We must translate characters which are not allowed in cookies. #
foreach $char (@Cookie_Encode_Chars) {
$cookie =~ s/$char/$Cookie_Encode_Chars{$char}/g;
$value =~ s/$char/$Cookie_Encode_Chars{$char}/g;
}
# Begin the printing of the Set-Cookie header with the cookie name #
# and value, followed by semi-colon. #
print 'Set-Cookie: ' . $cookie . '=' . $value . ';';
# If there is an Expiration Date set, add it to the header. #
if ($Cookie_Exp_Date) {
print ' expires=' . $Cookie_Exp_Date . ';';
}
# If there is a path set, add it to the header. #
if ($Cookie_Path) {
print ' path=' . $Cookie_Path . ';';
}
# If a domain has been set, add it to the header. #
if ($Cookie_Domain) {
print ' domain=' . $Cookie_Domain . ';';
}
# If this cookie should be sent only over secure channels, add that #
# to the header. #
if ($Secure_Cookie) {
print ' secure';
}
# End this line of the header, setting the cookie. #
print "\n";
# Remove the first two values of the @cookies array since we just #
# used them. #
shift(@cookies); shift(@cookies);
}
}
##############################################################################
# Subroutine: &SetCompressedCookies #
# Description: This routine does much the same thing that &SetCookies does #
# except that it combines multiple cookies into one. #
# Usage: &SetCompressedCookies(cname,name1,value1,...,namen,valuen) #
# Variables: cname - Name of the compressed cookie to be set. #
# Ex. 'CC' #
# name - Name of the individual cookie to be set. #
# Ex. 'count' #
# value - Value of the individual cookie to be set. #
# Ex. '3' #
# n - This is tacked on to the last of the name and value #
# pairs in the usage instructions just to show you #
# you can have as many name/value pairs as you wish. #
# Returns: Nothing. #
##############################################################################
sub SetCompressedCookies {
# Localize input into the compressed cookie name and the cookies to be #
# set. #
local($cookie_name,@cookies) = @_;
local($cookie,$value,$cookie_value);
# While there is a cookie and a value to be set in @cookies, that hasn't #
# yet been set, proceed with the loop. #
while ( ($cookie,$value) = @cookies ) {
# We must translate characters which are not allowed in cookies, or #
# which might interfere with the compression. #
foreach $char (@Cookie_Encode_Chars) {
$cookie =~ s/$char/$Cookie_Encode_Chars{$char}/g;
$value =~ s/$char/$Cookie_Encode_Chars{$char}/g;
}
# Prepare the cookie value. If a current cookie value exists, use #
# an ampersand (&) to separate the cookies and instead of using = to #
# separate the name and the value, use double colons (::), so it #
# won't confuse the browser. #
if ($cookie_value) {
$cookie_value .= '&' . $cookie . '::' . $value;
}
else {
$cookie_value = $cookie . '::' . $value;
}
# Remove the first two values of the @cookies array since we just #
# used them. #
shift(@cookies); shift(@cookies);
}
# Use the &SetCookies array to set the compressed cookie and value. #
&SetCookies("$cookie_name","$cookie_value");
}
##############################################################################
# Subroutine: &GetCompressedCookies() #
# Description: This subroutine takes the compressed cookie names, and #
# optionally the names of specific cookies you want returned #
# and uncompressed them, setting the values into %Cookies. #
# Specific names of cookies are optional and if not specified #
# all cookies found in the compressed cookie will be set. #
# Usage: &GetCompressedCookies(cname,[names]) #
# Variables: cname - Name of the compressed cookie to be uncompressed. #
# Ex. 'CC' #
# names - Optional names of cookies to be returned from the #
# compressed cookie if you don't want them all. The #
# [] depict a list of optional names, don't use []. #
# Ex. 'count' #
# Returns: 1 - If successful and at least one cookie is retrieved. #
# 0 - If no cookies are retrieved. #
##############################################################################
sub GetCompressedCookies {
# Localize variables used in this subroutine as well as the compressed #
# cookie name and the cookies to retrieve from the compressed cookie. #
local($cookie_name,@ReturnCookies) = @_;
local($cookie_flag) = 0;
local($ReturnCookie,$cookie,$value);
# If we can get the compressed cookie, proceed. #
if (&GetCookies($cookie_name)) {
# If there are specific cookies which we should set, rather than all #
# cookies found in the compressed cookie, then only retrieve them. #
if ($ReturnCookies[0] ne '') {
# For each cookie that was found in the compressed cookie: #
foreach (split(/&/,$Cookies{$cookie_name})) {
# Split the cookie name and value pair. #
($cookie,$value) = split(/::/);
# Decode any URL encoding which was done when the compressed #
# cookie was set. #
foreach $char (@Cookie_Decode_Chars) {
$cookie =~ s/$char/$Cookie_Decode_Chars{$char}/g;
$value =~ s/$char/$Cookie_Decode_Chars{$char}/g;
}
# For each cookie in the specified cookies we should set, #
# check to see if it matches the cookie we are looking at #
# right now. If so, set that cookie in the %Cookies array #
# and set the cookie flag to 1. #
foreach $ReturnCookie (@ReturnCookies) {
if ($ReturnCookie eq $cookie) {
$Cookies{$cookie} = $value;
$cookie_flag = 1;
}
}
}
}
# Otherwise, if there are no specific cookies to set, we will set #
# all cookies we find in the compressed cookie. #
else {
# Split the compressed cookie and split the cookie name/value #
# pairs, setting them in %Cookies. Also set cookie flag to 1. #
foreach (split(/&/,$Cookies{$cookie_name})) {
($cookie,$value) = split(/::/);
# Decode any URL encoding which was done when the compressed #
# cookie was set. #
foreach $char (@Cookie_Decode_Chars) {
$cookie =~ s/$char/$Cookie_Decode_Chars{$char}/g;
$value =~ s/$char/$Cookie_Decode_Chars{$char}/g;
}
$Cookies{$cookie} = $value;
}
$cookie_flag = 1;
}
# Delete the compressed cookie from the %Cookies array. #
delete($Cookies{$cookie_name});
}
# Return the cookie flag, which tells whether any cookies have been set. #
return $cookie_flag;
}
# This statement must be left in so that when perl requires this script as a #
# library it will do so without errors. This tells perl it has successfully #
# required the library.
------------------------------
Date: Tue, 12 Dec 2000 05:09:47 GMT
From: "What A Man !" <whataman@home.com>
Subject: Re: Faster than LWP
Message-Id: <3A35B377.14296FDA@home.com>
Thanks for all the good info, Eli... but where do I add a
scalar in the below script such as $URL =
http://bob.com/music.tar.gz? And do I really need all of
those codes just to grab a URL?
And David: how do I add a Host:header?
Thanks again,
--Dennis(same as Dennis100)
> use Socket;
>
> $tcpproto = getprotobyname('tcp');
>
> #####################################################
> # Grab an html page. Needs a remote hostname, a port number
> # a first line request (eg "GET / HTTP/1.0"), and the remainder
> # of the request (empty string if HTTP/0.9).
> sub grab ($$$$$$$) {
> my ($remote, $port, $request, $heads, $printhead, $printbody, $no_optimize) = @_;
> my ($iaddr, $paddr, $line);
> my $out = '';
> my $len;
> my $rc;
>
> if (!($iaddr = inet_aton($remote))) {
> return &err444("no host: $remote", $printhead, $printbody);
> }
>
> $paddr = sockaddr_in($port, $iaddr);
>
> print 'Peer is ' . inet_ntoa($iaddr) . ":$port\n" if $debug;
>
> if (!socket(SOCK, PF_INET, SOCK_STREAM, $tcpproto)) {
> return &err444("socket: $!", $printhead, $printbody);
> }
> if (!connect(SOCK, $paddr)) {
> return &err444("connect: $!", $printhead, $printbody);
> }
>
> $len = length($$request);
> $rc = syswrite(SOCK, $$request, $len);
>
> if ($rc != $len) {
> warn("request write to $remote was short ($rc != $len)\n");
>
> } else {
> $len = length($$heads);
> $rc = syswrite(SOCK, $$heads, $len);
>
> warn("heads write to $remote was short ($rc != $len)\n")
> if ($rc != length($$heads));
> }
>
> $nosignal = 1;
>
> while ($line = &saferead() and $nosignal) {
> $out .= $line;
> last if ($line =~ /^\015?\012?$/);
> }
>
> print $out if $printhead;
>
> # Don't optimize not printing the body if we are in benchmark mode.
> if (!$printbody and !$no_optimize) {
> close (SOCK) || die "close: $!";
> return $out;
> }
>
> if ($out =~ /\nContent-Length:\s+(\d+)/) {
> # OLD store everything way :
> ## read(SOCK,$out,$1,length($out));
> # New dump immediately way :
> my $tograb = $1;
> my $chunk = 512; # not too large, since it is off the network
> my $buf;
> my $rc;
>
> while($tograb >= $chunk) {
> $buf = '';
> $rc = read(SOCK,$buf,$chunk,0);
> print $buf if $printbody;
> if ($rc != $chunk) {
> warn "Return from $remote read was short (got $rc of $chunk)\n";
> return $out;
> }
>
> $tograb -= $chunk;
> }
>
> if ($tograb > 0) {
> $buf = '';
> $rc = read(SOCK,$buf,$tograb,0);
> print $buf if $printbody;
> if ($rc != $tograb) {
> warn "Return from $remote read was short (got $rc of $tograb)\n";
> return $out;
> }
> }
>
> } else {
>
> $nosignal = 1;
> # Back to line by line mode.
> while (defined($line = <SOCK>) and $nosignal) {
> # OLD store every way : $out .= $line;
> print $line if $printbody;
> }
> }
>
> close (SOCK) || die "close: $!";
> return $out;
> } # end &grab
>
> #####################################################
> # Attempt to read a line safely from SOCK filehandle.
> sub saferead () {
> my $line;
> eval {
> local$SIG{ALRM} = sub { die 'timeout!' };
> alarm 15;
> $line = <SOCK>;
> alarm 0;
> };
> if ($@ and $@ !~ /timeout!/) {warn("during socket read: $@\n")}
> return $line;
> } # end &saferead
------------------------------
Date: Tue, 12 Dec 2000 07:47:15 GMT
From: cfedde@fedde.littleton.co.us (Chris Fedde)
Subject: Re: Need help to replace passwd - New at this !
Message-Id: <7KkZ5.179$B9.188720640@news.frii.net>
In article <9148ae$iss$1@nnrp1.deja.com>, <msalerno@my-deja.com> wrote:
>In article <_6cZ5.154$B9.170600448@news.frii.net>,
>
>I appreciate the feedback, but I would like to understand what exactly
>it is doing to the passwd file. It would be even more appreciated it
>you did.
>
OK. I realize that this was a bit of a mouthful. Here, I'll read to you
from the manual.
>perl -F: -lapi.bak -e '
>s{^cfedde:[^:]+:}{cfedde:ddsElcoX/00Ns:}
>' /etc/master.passwd
-Fpattern
specifies the pattern to split on if -a is also in
effect. The pattern may be surrounded by `//', `""',
or `''', otherwise it will be put in single quotes.
So -F: causes : to be separator for the autosplit.
-l[octnum]
enables automatic line-ending processing. It has two
separate effects. First, it automatically chomps
`$/' (the input record separator) when used with -n
or -p. Second, it assigns `$\' (the output record
separator) to have the value of octnum so that any
print statements will have that separator added back
on. If octnum is omitted, sets `$\' to the current
value of `$/'.
That should be obvious now. Chomp "\n" off all $_ from <> and put "\n"
on the end of every print.
-a turns on autosplit mode when used with a -n or -p.
An implicit split command to the @F array is done as
the first thing inside the implicit while loop pro-
duced by the -n or -p.
Guess that I really did not need -a after all. Oh well.
-p causes Perl to assume the following loop around your
program, which makes it iterate over filename argu-
ments somewhat like sed:
LINE:
while (<>) {
... # your program goes here
} continue {
print or die "-p destination: $!\n";
}
That's the main loop. The ... above are the -e arguments.
-i[extension]
specifies that files processed by the `<>' construct
are to be edited in-place. It does this by renaming
the input file, opening the output file by the origi-
nal name, and selecting that output file as the
default for print() statements. The extension, if
supplied, is used to modify the name of the old file
to make a backup copy[.]
This makes it overwrite the existing file. And cause it to keep a
copy of the original in /etc/master.passwd.bak
-e commandline
may be used to enter one line of program. If -e is
given, Perl will not look for a filename in the argu-
ment list. Multiple -e commands may be given to
build up a multi-line script. Make sure to use semi-
colons where you would in a normal program.
Sets up the next thing to be the 'guts of the loop defined by -p
s/PATTERN/REPLACEMENT/egimosx
Searches a string for a pattern, and if found,
replaces that pattern with the replacement text
and returns the number of substitutions made.
Otherwise it returns false (specifically, the
empty string).
As always you can use the delimiter of your choice for patterns.
I choose {}. {^cfedde:[^:]+:} matches my name and password in the
password file. {cfedde:ddsElcoX/00Ns:} is the replacement string:
my name followed by a pre-encrypted password.
Finally on FreeBSD the password authentication database is kept in
/etc/master.passwd. That is the input for the loop defined by -p.
Hope that this helps.
chris
--
This space intentionally left blank
------------------------------
Date: Tue, 12 Dec 2000 06:44:36 GMT
From: Uri Guttman <uri@sysarch.com>
Subject: Re: Problem understanding references
Message-Id: <x7elzejfzf.fsf@home.sysarch.com>
>>>>> "PS" == Peter Sundstrom <peter.sundstrom@eds.com> writes:
PS> I'd imagine the overhead of opening and closing files for every
PS> invocation of the loop would be reasonable high?
get it working first before you worry about optimizing. and you haven't
stated the size of the problem - if it is just thousands of IP's then
who cares? if much larger then you can make a hash of file handles using
Symbol.pm and still do it cleanly. it is naming the HANDLE after the
file that is very wrong and confusing and causes your symref error with
strict.
uri
--
Uri Guttman --------- uri@sysarch.com ---------- http://www.sysarch.com
SYStems ARCHitecture, Software Engineering, Perl, Internet, UNIX Consulting
The Perl Books Page ----------- http://www.sysarch.com/cgi-bin/perl_books
The Best Search Engine on the Net ---------- http://www.northernlight.com
------------------------------
Date: 11 Dec 2000 23:41:24 -0600
From: logan@cs.utexas.edu (Logan Shaw)
Subject: Re: single quote hell
Message-Id: <914dq4$hqe$1@boomer.cs.utexas.edu>
In article <ckhZ5.30013$C2.6645210@newsrump.sjc.telocity.net>,
Tommy Martin <tmartin1@telocity.com> wrote:
>I have been beating my head against the wall trying to go through a string
>in a variable and replace where the user entered a single quote ' mark with
>2 of them '' so my sql statement will add that string the to the database.
>
>I have tried q() qq() /s and /tr and have not been able to get any of them
>to work on that character.
Don't. You don't need to.
Instead, either call the quote() method of your database handler, which
will do this for you. Or better, use placeholders for all your SQL so
that quoting isn't necessary at all. Using placeholders makes the SQL
look cleaner, and it reduces the processing that must be done to parse
the SQL if you do it right.
An example without using placeholders:
$x = "abc";
$y = "123";
$sql = "insert into footable (x,y) values ($x,$y)";
$sth = $dbh->prepare($sql);
$sth->execute;
With placeholders it becomes this:
# the next two lines are only done once, not over and over
# again for each insert.
$sql = "insert into footable (x,y) values (?,?)";
$sth = $dbh->prepare($sql);
$x = "abc";
$y = "123";
$sth->execute($x,$y);
"perldoc DBI" for more info.
All of this assumes you are using DBI, but you probably are, and if you
aren't, you might want to.
- Logan
------------------------------
Date: Tue, 12 Dec 2000 06:50:32 GMT
From: qwex@my-deja.com
Subject: time differences
Message-Id: <914hrn$pm0$1@nnrp1.deja.com>
I'm building a simple news site using Perl. the front page will show 3
days of news, which is retrieved from files called mm-dd-yyyy.txt
(primitive, but I'm a beginner :) ). anyway, I live in the CST time
zone, so I figured it would be easiest simply to do all news updates in
CST. I can use gmtime(time) to get GMT time, but how do I convert that
to CST? not just the hour, but also the day: if it's 8:00pm CST, it's
the next day in GMT, so how do I account for that?
Sent via Deja.com http://www.deja.com/
Before you buy.
------------------------------
Date: Tue, 12 Dec 2000 06:32:36 GMT
From: latkaHATES@SPAMcotse.com (Latka)
Subject: Re: Visual Perl
Message-Id: <Xns90087E8Esh6ty87s12x@63.211.125.91>
From the fingers of Justin and or Denitza on 11 Dec 2000:
> Does anyone know
>a way around this? (please no replies like "hack the planet, save the
>rainforest, tell your boss to switch to BSD")
Look for VisiPerl+ and Perl Builder. Other than the pretty color coding
(purple strings, yellow variables, red comments, and green clovers ;-)
there really isn't much to them. Delphi it's not, but maybe someday.
--
Latka.
Hack the rainforest, switch the planet, and save the BDSM for the bedroom.
------------------------------
Date: Tue, 12 Dec 2000 07:27:36 GMT
From: rgarciasuarez@free.fr (Rafael Garcia-Suarez)
Subject: Re: Why isn't Perl highly orthogonal?
Message-Id: <slrn93bkt6.ra4.rgarciasuarez@rafael.kazibao.net>
Michael Carman wrote in comp.lang.perl.misc:
>
> Perl is non-orthogonal by design. From 'perldoc perl'
>
> "The language is intended to be practical (easy to use,
> efficient, complete) rather than beautiful (tiny, elegant,
> minimal)."
Moreover, the Perl language has not been designed from the ground up
(like Java, for example); it's a lot simpler to learn if you're already
used to sh, sed, awk and C.
--
# Rafael Garcia-Suarez / http://rgarciasuarez.free.fr/
------------------------------
Date: 12 Dec 2000 01:38:38 -0600
From: logan@cs.utexas.edu (Logan Shaw)
Subject: Re: Why isn't Perl highly orthogonal?
Message-Id: <914klu$ikn$1@boomer.cs.utexas.edu>
In article <slrn93bkt6.ra4.rgarciasuarez@rafael.kazibao.net>,
Rafael Garcia-Suarez <rgarciasuarez@free.fr> wrote:
>Moreover, the Perl language has not been designed from the ground up
>(like Java, for example); it's a lot simpler to learn if you're already
Java was only designed from the ground up if C++ is the ground.
Note: even though I disagree with your assessment of Java, I do think
that it was a good pun, although it would have been better if you
could have worked the word "beans" in somehow.
- Logan
------------------------------
Date: 16 Sep 99 21:33:47 GMT (Last modified)
From: Perl-Users-Request@ruby.oce.orst.edu (Perl-Users-Digest Admin)
Subject: Digest Administrivia (Last modified: 16 Sep 99)
Message-Id: <null>
Administrivia:
The Perl-Users Digest is a retransmission of the USENET newsgroup
comp.lang.perl.misc. For subscription or unsubscription requests, send
the single line:
subscribe perl-users
or:
unsubscribe perl-users
to almanac@ruby.oce.orst.edu.
| NOTE: The mail to news gateway, and thus the ability to submit articles
| through this service to the newsgroup, has been removed. I do not have
| time to individually vet each article to make sure that someone isn't
| abusing the service, and I no longer have any desire to waste my time
| dealing with the campus admins when some fool complains to them about an
| article that has come through the gateway instead of complaining
| to the source.
To submit articles to comp.lang.perl.announce, send your article to
clpa@perl.com.
To request back copies (available for a week or so), send your request
to almanac@ruby.oce.orst.edu with the command "send perl-users x.y",
where x is the volume number and y is the issue number.
For other requests pertaining to the digest, send mail to
perl-users-request@ruby.oce.orst.edu. Do not waste your time or mine
sending perl questions to the -request address, I don't have time to
answer them even if I did know the answer.
------------------------------
End of Perl-Users Digest V9 Issue 5087
**************************************
