[19587] in Perl-Users-Digest
Perl-Users Digest, Issue: 1782 Volume: 10
daemon@ATHENA.MIT.EDU (Perl-Users Digest)
Thu Sep 20 14:10:32 2001
Date: Thu, 20 Sep 2001 11:10:12 -0700 (PDT)
From: Perl-Users Digest <Perl-Users-Request@ruby.OCE.ORST.EDU>
To: Perl-Users@ruby.OCE.ORST.EDU (Perl-Users Digest)
Message-Id: <1001009411-v10-i1782@ruby.oce.orst.edu>
Content-Type: text
Perl-Users Digest Thu, 20 Sep 2001 Volume: 10 Number: 1782
Today's topics:
Impossible to search and delete! <kalle.anka@markisspecialisten.com>
Re: Limiting floating point decimal places. (Anno Siegel)
Re: Limiting floating point decimal places. <joe+usenet@sunstarsys.com>
Re: multi language html output <bart.lateur@skynet.be>
Re: pattern matcher for embedded seperators. (Mark Jason Dominus)
Re: Problem with Object Oriented Perl (Randal L. Schwartz)
Re: Reading cookies from a different path (Jonadab the Unsightly One)
repeated substitution <peter_icaza@REMOVE2REPLYuhc.com>
Re: repeated substitution (Tad McClellan)
Re: repeated substitution <peter_icaza@REMOVE2REPLYuhc.com>
Re: run another script from this one (without qx{}) news@roaima.demon.co.uk
Re: Schwartzian Transform problem <mjcarman@home.com>
Re: setting up time value and converting it to epoch se <Thomas@Baetzler.de>
Unusual error message... (JR)
Re: Unusual error message... <mjcarman@home.com>
Use symbol table like 'real' hash (Bianka Martinovic)
Re: Win32::ODBC <simon.hughes@bluewin.ch>
Digest Administrivia (Last modified: 6 Apr 01) (Perl-Users-Digest Admin)
----------------------------------------------------------------------
Date: Thu, 20 Sep 2001 14:28:01 GMT
From: "Kalle Anka" <kalle.anka@markisspecialisten.com>
Subject: Impossible to search and delete!
Message-Id: <R1nq7.42$ta7.4746@newsb.telia.net>
I cant figure how to to edit my e-mail list by search and delete i Perl.
For examle:
I want to delete someone@somewere.com
I I whrite for example com, all the addresses with .com deletes.
All addresses are listed like:
(space)someone@somewere.com<br>
someone2@somewere.com<br>
someone2@somewere.com<br>
This is my script:
#!/usr/bin/perl -w
use CGI qw(:standard);
$filename = "/home/markisspecialisten/www/guestmail.htm";
$backupfile = "/home/markisspecialisten/www/backup.html";
$recipient = 'radera@markisspecialisten.com';
$q = CGI->new();
$email = $q->param( "email" );
print $q->header();
print $q->start_html('Resultat av kommando');
print $q->h1('Resultat av kommando');
(&cleanup); # Kjør sub og skriv returnert verdi.
print $q->end_html();
print "\n";
sub cleanup {
# Disable *
if ($email =~ tr/*?//d) {
print "Du har angivit en otillåten e-post address!<br>\n\n";
print qq {<a href="../remove.htm" target="_top">Försök igen!</a>\n} ;
} else{
open INFILE, $filename
or return "Couldn't open file for reading";
@infile = <INFILE>;
close INFILE;
# Disable emty inputs
if ( $email =~ /^\s*$/ ) {
print "Skriv in din e-postadress för att ta bort den från vår lista.<br>\n"
;
print qq {<a href="../remove.htm" target="_top">Försök igen!</a>\n} ;
exit ;
}
open INFILE, $filename or die "Can't open '$filename': $!";
$line;
while (<INFILE>) {
chomp; # drops trailing newlines; can omit if undesirable
$line = $_, last if /^\Q$email/i && ! /^$/; # substr match!
}
close INFILE;
print "Din e-postadress fanns med i vår lista och är nu
borttagen.<br>\n\n" if defined $line;
print "Din e-postadress fanns inte med i vår lista.<br>\n\n" unless
defined $line;
print qq {<a href="../remove.htm" target="_top">Försök igen</a>\n} unless
defined $line;
print " och kontrollera om det är rätt e-postadress du erhållit vår
information på.<br>\n\n" unless defined $line;
print "Var noga med att ange små och stora bokstäver.<br><br>\n\n" unless
defined $line;
print "Kontakta oss på " unless defined $line;
print qq {<a href="mailto:radera@} unless defined $line;
print qq {markisspecialisten.com">radera@} unless defined $line;
print qq {markisspecialisten.com</a>\n} unless defined $line;
print " om problemet kvarstår." unless defined $line;
open BACKUP, ">$backupfile"
or return "Couldn't make backup of original file";
if (@infile) { # Sjekk om den er tom
for $line (@infile) {
print BACKUP $line;
}
}
open OUTFILE, ">$filename"
or return "Couldn't open file for writing";
for (@infile) { print OUTFILE unless /$email/};
close OUTFILE;
}
}
------------------------------
Date: 20 Sep 2001 17:28:55 GMT
From: anno4000@lublin.zrz.tu-berlin.de (Anno Siegel)
Subject: Re: Limiting floating point decimal places.
Message-Id: <9od90n$5qv$1@mamenchi.zrz.TU-Berlin.DE>
According to Mark Jason Dominus <mjd@plover.com>:
> In article <x766ahdrbj.fsf@home.sysarch.com>,
> Uri Guttman <uri@sysarch.com> wrote:
> > CF> Also look at $OFMT and $# in the perlvar manual page.
> >
> >$# is deprecated and not useful. i think it is also broken in some ways.
>
> It's extremely broken. Try this:
>
> $s = 1.23456789;
> $# = '%.0f';
> print $s, "\t$s\n";
>
> I doubt anyone has ever successfully used $# for anything.
So do I.
> I'd really like to see an example of a program that uses it successfully.
I would rather not see one, because that would mean we can't re-use
$# for the more useful loop index in for-loops. Then again, I don't
think we are going to see this kind of change before Perl 6 anymore.
Anno
------------------------------
Date: 20 Sep 2001 13:51:58 -0400
From: Joe Schaefer <joe+usenet@sunstarsys.com>
Subject: Re: Limiting floating point decimal places.
Message-Id: <m3hetxzr5t.fsf@mumonkan.sunstarsys.com>
anno4000@lublin.zrz.tu-berlin.de (Anno Siegel) writes:
> According to Mark Jason Dominus <mjd@plover.com>:
> > In article <x766ahdrbj.fsf@home.sysarch.com>,
> > Uri Guttman <uri@sysarch.com> wrote:
> > > CF> Also look at $OFMT and $# in the perlvar manual page.
> > >
> > >$# is deprecated and not useful. i think it is also broken in some
> > >ways.
> >
> > It's extremely broken. Try this:
> >
> > $s = 1.23456789;
> > $# = '%.0f';
> > print $s, "\t$s\n";
> >
> > I doubt anyone has ever successfully used $# for anything.
>
> So do I.
http://groups.google.com/groups?hl=en&selm=m33dcw27ia.fsf%40mumonkan.sunstarsys.com
:-)
I also think Kalle Anka might benefit from a "judicious" application
of $#. Then again, it probably wouldn't make the slightest difference.
--
Joe Schaefer And he puzzled three hours, till his puzzler was sore. Then the
Grinch thought of something he hadn't before!
-- Dr. Seuss
------------------------------
Date: Thu, 20 Sep 2001 13:24:36 GMT
From: Bart Lateur <bart.lateur@skynet.be>
Subject: Re: multi language html output
Message-Id: <iarjqtcjr6ju5l35d6urtdk586qh2em0t3@4ax.com>
Paul wrote:
>does anyone have an idea how i could realize a perl html output, containing
>the language the user selected, without putting every text into a variable
>like:
>
>$text = ....; -> get value from text file
>print <<"EOF";
><html>
>....
><table ...>
>$titel
>$name
>$text
></table>
>....
>EOF
>
>i'd appreciate any hint even if it's not something like i mentioned above!
You can store the texts in a hash. That way it's easier to add more.
$titel -> $transl{titel}
$name -> $transl{name}
$text -> $transl{text}
If instead you use a template mechanism, simply make a different
template for each language.
--
Bart.
------------------------------
Date: Thu, 20 Sep 2001 16:08:10 GMT
From: mjd@plover.com (Mark Jason Dominus)
Subject: Re: pattern matcher for embedded seperators.
Message-Id: <3baa1469.27a5$1b6@news.op.net>
In article <slrn9qib4o.74t.tadmc@tadmc26.august.net>,
Tad McClellan <tadmc@augustmail.com> wrote:
>Chandra Yemparala <ychandra@cisco.com> wrote:
>>Is there a way to write pattern matcher for the following pattern:
>>
>><x:<a><b><c><d>>
>
>
> print "matched\n" if $_ eq '<x:<a><b><c><d>>';
What do you think is accomplished by this kind of snide answer? Do
you think it's helpful? It seems abusive to me.
>>x,a,b,c,d are going to some value. I want to check if a line is
>>according to this format.
> ^^^^^^^^^^^
>
>One example does not define a format. What are the rules?
I understood x, a, b, c, d as being metasyntactic variables that would
denote any string not containing <, >, or :. It did not seem like an
unusually vague question.
Perhaps in the future if you find yourself completely at a loss, as
you were here, you might try waiting a few hours before you post, to
see if anyone else has more insight than you do.
I noticed that in the last clp.misc traffic report you were the person
who made the largest number of posts. That must be taking up a lot of
your time. Perhaps it would be a better use of your time if you were
to omit this sort of unhelpful post in the future. Then you could
turn your energies towards something more constructive and useful.
--
@P=split//,".URRUU\c8R";@d=split//,"\nrekcah xinU / lreP rehtona tsuJ";sub p{
@p{"r$p","u$p"}=(P,P);pipe"r$p","u$p";++$p;($q*=2)+=$f=!fork;map{$P=$P[$f^ord
($p{$_})&6];$p{$_}=/ ^$P/ix?$P:close$_}keys%p}p;p;p;p;p;map{$p{$_}=~/^[P.]/&&
close$_}%p;wait until$?;map{/^r/&&<$_>}%p;$_=$d[$q];sleep rand(2)if/\S/;print
------------------------------
Date: 20 Sep 2001 07:27:39 -0700
From: merlyn@stonehenge.com (Randal L. Schwartz)
Subject: Re: Problem with Object Oriented Perl
Message-Id: <m1elp2djj8.fsf@halfdome.holdit.com>
>>>>> "Thomas" == Thomas Bätzler <Thomas@Baetzler.de> writes:
Thomas> Try instead:
Thomas> sub new {
Thomas> my $proto = shift;
Thomas> # get proper classname
Thomas> my $class = ref( $proto ) || $proto;
replace this with
my $class = shift;
for reasons explained in and near
http://www.perlmonks.org/index.pl?node_id=52089
ref($proto) - a bad idea as a *default pattern* that has gone too far.
Just say no.
print "Just another Perl hacker,"
--
Randal L. Schwartz - Stonehenge Consulting Services, Inc. - +1 503 777 0095
<merlyn@stonehenge.com> <URL:http://www.stonehenge.com/merlyn/>
Perl/Unix/security consulting, Technical writing, Comedy, etc. etc.
See PerlTraining.Stonehenge.com for onsite and open-enrollment Perl training!
------------------------------
Date: Thu, 20 Sep 2001 15:16:27 GMT
From: jonadab@bright.net (Jonadab the Unsightly One)
Subject: Re: Reading cookies from a different path
Message-Id: <3baa07b8.8853924@news.bright.net>
mjd@plover.com (Mark Jason Dominus) wrote:
> >That's what I get *without* the -w flag.
>
> Please excuse my confusion.
>
> (I don't get those warnings, and I've tried running the program under
> versions of Perl back to 5.000, so I'm mystified about what is going
> wrong. Sorry that it didn't work for you.)
Maybe it's a system-dependent thing; I'm using the ActiveState
Windoze build here. Your headers don't tell me much about
your system, so I'm guessing it's some kind of Unix?
--
$_=$j="(.";s/$/.)/;$o=$_;s/..//;$k=reverse;($a,$b,$c,)="U r bad"=~
"$j$k$j$k$j+)";($f,$d)="lyons"=~"$o.$o";$_=$d;s/s/o/;$;=reverse($c
."a$_");s/o/e/ ;$e="O$_";$g="h";s/$/t/;$ := ".$_";($i) =/(.)$/;$,=
"ig$g$i";$\="he $a$d$,$f $e <j$;\@b$b$,$:>$/";print"$/-- $/J$; $i";
------------------------------
Date: Thu, 20 Sep 2001 10:01:31 -0400
From: peter <peter_icaza@REMOVE2REPLYuhc.com>
Subject: repeated substitution
Message-Id: <3BA9F6BA.4734D9CB@REMOVE2REPLYuhc.com>
hi,
given this line:
DataMart/runtime/monk_scripts/common/ds_BE019_Dart_Out.dsc:56: "Stored
Procedure Name= " (get input0.000000e+00td_Event_Trigger_Out.payload))
(string-append "Oracle Error= " (db-get-error-strconnection-handle))))^M
i want to insert newlines such that the line becomes this:
DataMart/runtime/monk_scripts/common/ds_BE019_Dart_Out.dsc:56:
"Stored Procedure Name= " (get
~input0.000000e+00td_Event_Trigger_Out.payload)) (string-append
"Oracle Error= " (db-get-error-str connection-handle))))^M
in words what i want to do is to break the line into several line, such
that each occurence of the quoted text and the associated values are
on seperate lines.
i have tried various incantations of the following substitutions:
$line =~ s/(".*= ")/\n\1/g;
$line =~ s/(".*= ")/\n$&/g;
and the best i get is this:
DataMart/runtime/monk_scripts/common/ds_BE019_Dart_Out.dsc:56:
"Stored Procedure Name= " (get
~input0.000000e+00td_Event_Trigger_Out.payload))
(string-append"OracleError= " (db-get-error-str connection-handle))))^M
what am i doing wrong and how can i fix it? i have not been able to
find my answer in the owl book.
tia,
peter
------------------------------
Date: Thu, 20 Sep 2001 14:37:07 GMT
From: tadmc@augustmail.com (Tad McClellan)
Subject: Re: repeated substitution
Message-Id: <slrn9qjt36.98b.tadmc@tadmc26.august.net>
peter <peter_icaza@REMOVE2REPLYuhc.com> wrote:
>given this line:
^^^^^^^^^
>DataMart/runtime/monk_scripts/common/ds_BE019_Dart_Out.dsc:56: "Stored
>Procedure Name= " (get input0.000000e+00td_Event_Trigger_Out.payload))
>(string-append "Oracle Error= " (db-get-error-strconnection-handle))))^M
That isn't a line, that is 3 lines. Did your newsreader break it for you?
>i want to insert newlines such that the line becomes this:
>
>DataMart/runtime/monk_scripts/common/ds_BE019_Dart_Out.dsc:56:
>"Stored Procedure Name= " (get
>~input0.000000e+00td_Event_Trigger_Out.payload)) (string-append
>"Oracle Error= " (db-get-error-str connection-handle))))^M
>
>in words what i want to do is to break the line into several line, such
>that each occurence of the quoted text and the associated values are
>on seperate lines.
Your word description does not account for the newline after the
"get". The tilde-input stuff is not "quoted text". What rule
says to put that newline in?
>i have tried various incantations of the following substitutions:
>$line =~ s/(".*= ")/\n\1/g;
^^
You should *always* enable warnings when developing Perl code!
>$line =~ s/(".*= ")/\n$&/g;
That is the same as the first one, except it does not generate
a warning, and makes your entire program slower (maybe).
>and the best i get is this:
>
>DataMart/runtime/monk_scripts/common/ds_BE019_Dart_Out.dsc:56:
>"Stored Procedure Name= " (get
I still don't see how the newline at this position got here...
>what am i doing wrong
Using a greedy quantifier.
>and how can i fix it?
Use a non-greedy quantifier:
s/(".*?= ")/\n$1/g;
--
Tad McClellan SGML consulting
tadmc@augustmail.com Perl programming
Fort Worth, Texas
------------------------------
Date: Thu, 20 Sep 2001 12:27:23 -0400
From: peter <peter_icaza@REMOVE2REPLYuhc.com>
Subject: Re: repeated substitution
Message-Id: <3BAA18EB.3AE7C33F@REMOVE2REPLYuhc.com>
>
> >That isn't a line, that is 3 lines. Did your newsreader break it for you?
yes, i made sure it was one before i sent it.
> >Your word description does not account for the newline after the
> >"get". The tilde-input stuff is not "quoted text". What rule
> >says to put that newline in?
i want to braek it at the quotes so the quotes are on a seperate line
> >i have tried various incantations of the following substitutions:
> >$line =~ s/(".*= ")/\n\1/g;
> ^^
> You should *always* enable warnings when developing Perl code!
i use -w strict and diags. this was just some of the "wrong" attempts i
tried
> >$line =~ s/(".*= ")/\n$&/g;
> s/(".*?= ")/\n$1/g;
>
>
> That is the same as the first one, except it does not generate
> a warning, and makes your entire program slower (maybe).
yea, that is what the owl book said to avoid, another "wrong" attempt
>
> >and the best i get is this:
> >
> >DataMart/runtime/monk_scripts/common/ds_BE019_Dart_Out.dsc:56:
> >"Stored Procedure Name= " (get
>
> I still don't see how the newline at this position got here...
me either....
>
> >what am i doing wrong
> Using a greedy quantifier.
>
> >and how can i fix it?
> Use a non-greedy quantifier:
>
> s/(".*?= ")/\n$1/g;
thanks for rthe help.....
peter
------------------------------
Date: 20 Sep 2001 16:10:34 GMT
From: news@roaima.demon.co.uk
Subject: Re: run another script from this one (without qx{})
Message-Id: <3baa06ea@news.netserv.net>
I wrote,
> Not necessarily approved, but you could open it, slurp it, and then eval
> the result.
Tina Mueller <tinamue@zedat.fu-berlin.de> asked:
> hm, isn't that kind of what do() is supposed to do?
So it is. Thanks for the tip.
Chris
------------------------------
Date: Thu, 20 Sep 2001 07:55:03 -0500
From: Michael Carman <mjcarman@home.com>
Subject: Re: Schwartzian Transform problem
Message-Id: <3BA9E727.73B9C8BC@home.com>
Matt Garrish wrote:
>
> "Leo Hemmings" <leapius@hotmail.com> wrote in message
> news:9obi0k$t7c$1@uranium.btinternet.com...
> >
> > I have an array where each record has a number of tab-delimeted
> > fields. I am trying to sort this array by two of the fields. i.e.
> > by one field and then by another field. Here's a code snippet:
> >
> > @secs = map { $_->[0] }
> > sort {
> > $a->[0] <=> $b->[0] ||
> > $a->[2] <=> $b->[2]
> > }
> > map { [ $_, (split /\t/) ] } @secs;
>
> You are sorting: $a->[0] <=> $b->[0] *OR* $a->[2] <=> $b->[2]
>
> I would assume that $a->[2] does not exist unless $a->[0] also exists,
> therefore your script will only evaluate the first part of the sort,
> since if it is successful there is no need to evaluate the second.
> You'll probably want to try switching || to &&.
What?! That's completely wrong.
Straight out of perlop:
Binary "<=>" returns -1, 0, or 1 depending on whether the left
argument is numerically less than, equal to, or greater that
the right argument.
If the two arguments are not equal, <=> returns non-zero, and there's no
reason for further comparison. If they are equal, <=> returns zero, so
you want to go to the next set of criteria. The use of || is correct.
I suggest reading perlfaq4: "How do I sort an array by (anything)?"
Bart and Uri have already corrected the real problem.
-mjc
------------------------------
Date: Thu, 20 Sep 2001 16:36:19 +0200
From: =?ISO-8859-1?Q?Thomas_B=E4tzler?= <Thomas@Baetzler.de>
Subject: Re: setting up time value and converting it to epoch seconds
Message-Id: <n4vjqt46aandimi8lmg0usea09q72qo5af@4ax.com>
On 20 Sep 2001, Shan Ali Khan <shanali@singapura.singnet.com.sg>
wrote:
># -*- mode: Perl -*-
># SessionTimeout
>#
use strict;
>use Time::Local;
use Date::Calc; # use Steffen Beyer's cool module for Days_in_Month()
>sub
>{
> my $p = ${$_[0]}; # request packet
> my $rp = ${$_[1]}; # reply packet to NAS
> my $result = ${$_[2]}; # handled flag
# This looks strange. Is rp really a ref to hashref?
> my $current = time; # localtime since 1st Jan, 1970
# actually time() is seconds since 1st Jan, 1970 00:00 GMT
> ($sec, $min, $hour, $mday, $mon, $year) = (localtime)[0,1,2,3,4,5]; # calculation of localtime
my($sec, $min, $hour, $mday, $mon, $year) = localtime $current;
# you don't need the slice if you want all elements from the start
# also, compute time values based on the timestamp you got
> $endofmonth = timegm(0, 50, 23, 30, $month, $year); # calculation of time till end of month
my $endofmonth = timelocal( 59, 59, 23,
Date::Calc::Days_in_Month( $year+1900,$mon+1),
$mon, $year);
# Use Days_in_Month to find out how many days your month has.
# The function expects "real" year and month numbers, unlike
# timelocal() which can deal with the output from localtime
> if ($mday = '30' && ($endofmonth - $current) <= '86400') {
# use == instead of =, compare to a number (not a string!),
# and anyways you should probably calculate this number
# using DAys_in_Month, too.
[snip]
Dunno about the rest of the code.
HTH,
--
use strict;my($i,$t,@r)=(0,'5 -.@BHJPT4acd6e2hk2lmn2o4r2s3tuz',map{ord}
split//,unpack('u*','L#`T&)QD5#0`#!!`#%1D)#08`#P05!!(3``$$"``#"0L&``('.
'"`P<!`````0$`'));$t=~s/(\d)(.)/$2x$1/eg;map{$t.=substr$t,$i,1,''while
$_--;$i++}@r;print"$t\n";# Thomas@Baetzler.de - http://baetzler.de/perl
------------------------------
Date: 20 Sep 2001 06:12:28 -0700
From: tommyumuc@aol.com (JR)
Subject: Unusual error message...
Message-Id: <319333f5.0109200512.731d6b94@posting.google.com>
In the following script, I receive an error message on the line that
reads:
$sum += $item{$_} = $code_detail{$code}{$_} || 0 for qw(C P T);
of:
Missing $ on loop variable at process.cgi line 182.
When I run this script in DOS (minus the CGI stuff, of course), it
runs perfectly. When I run the script in UNIX, it fails with the
above error message (even with the CGI stuff removed so that the
script can be run as a Perl script).
Does anyone know how can I correct the above error message?
Thanks very much for any help that you may have. --JR
#!/usr/local/bin/perl5
use Fcntl qw(:flock);
use CGI qw(:all);
use CGI qw(:all escape);
use CGI::Carp qw(fatalsToBrowser);
use strict;
my $q = new CGI;
sub get_lock {
open(SEM, ">semaphore.sem") || die "Cannot open: $!";
flock(SEM, LOCK_EX) || die "Lock failed: $!";
}
sub release_lock {
close(SEM);
}
print header(-type => 'text/plain');
my @hidden = param hidden;
my $filename = $q->param('filename');
my ( $listedTotal, $countedTotal, $tractLength, $lineCounter,
$pumaLength, $numberOfFields, @pumaCode, %uniquePumaCodes,
$uniquePumaCount, @pumaFrequency, $subscript, %code_total,
%code_detail, $sum, @CPTFrequency, @CPTDisplayFrequency );
@pumaFrequency = ();
get_lock();
open(UPLOAD, "uploadData2.dat") || die "Cannot open file: $!";
my @uploadedData = <UPLOAD>;
chomp @uploadedData;
close (UPLOAD);
$lineCounter = 0;
foreach (@uploadedData) {
my ( $recordType, $state, $county,
$mcdPlace, $censusTract, $partIndicator,
$macode, $percentPUMACode, $censusPopulation
) = split ( /,/, $_ );
$lineCounter++;
###############Get listed population total in row
"S"################
if ( $recordType eq "S" ) {
$listedTotal = $censusPopulation;
}
if ( $recordType ne "S" && $percentPUMACode != '' ) {
$countedTotal += $censusPopulation;
}
###############Check length of tract
types###########################
###############Print error message and line contents
################
###############if length of tract !=
6###############################
if ( $recordType eq "T" ) {
$tractLength = length( $censusTract );
if ( $tractLength != 6 ) {
print "The tract length is not 6 digits at\n",
"line $lineCounter.\n",
"Contents of line with error:\n",
"$recordType, $state, $county,",
"$mcdPlace, $censusTract, $partIndicator,",
"$macode, $percentPUMACode, $censusPopulation\n";
}
}
###############Check length of 5% PUMA
code##########################
###############Print error message and line contents
################
###############if length of 5% PUMA code !=
5########################
###############Don't check row "S" or null
percentPUMACodes##########
$pumaLength = length( $percentPUMACode );
if ( $pumaLength != 5 && $recordType ne "S" && $percentPUMACode !=
'' ) {
print "The PUMA code length is not 5 digits at\n",
"line $lineCounter.\n",
"Contents of line with error:\n",
"$recordType, $state, $county,",
"$mcdPlace, $censusTract, $partIndicator,",
"$macode, $percentPUMACode, $censusPopulation\n";
}
###############Verify that there are 9 fields in each
row############
$numberOfFields = split ( /,/, $_ );
if ( $numberOfFields != 9 ) {
print "The number of fields is incorrect at\n",
"line $lineCounter.\n",
"Contents of line with error:\n",
"$recordType, $state, $county,",
"$mcdPlace, $censusTract, $partIndicator,",
"$macode, $percentPUMACode, $censusPopulation\n";
}
###############Get PUMA codes and push PUMA
code#####################
###############to @pumaCodes to get count of unique PUMA
codes#######
if ( $percentPUMACode != '' ) {
push( @pumaCode, $percentPUMACode );
}
###############Load codes and push PUMA
code#########################
###############to @pumaCodes to get count of unique PUMA
codes#######
if ( $pumaCode[ $percentPUMACode ] ) {
++@pumaFrequency[ @pumaCode [ $subscript ] ];
}
}
########Print listed population total for row
"S"###############################
print "Listed population total for the state is: $listedTotal\n";
########Print counted population total for all rows not equal to
"S"############
print "Counted population total for the state is: $countedTotal\n";
########Print counted population total for all rows not equal to
"S"############
if ( $listedTotal != $countedTotal ) {
print "The listed population total does not match\n",
"the counted population total.\n";
}
else {
print "The listed population total matches\n",
"the counted population total.\n";
}
########Print the total number of rows in
file#################################
print "The total number of rows in the file is: $lineCounter\n";
########Get unique PUMA codes out of
@pumaCode#################################
%uniquePumaCodes = ();
foreach( @pumaCode ) {
$uniquePumaCodes{$_} = 1;
}
$uniquePumaCount = 0;
foreach ( keys %uniquePumaCodes ) {
$uniquePumaCount++;
}
print "The total number of unique PUMAs is: $uniquePumaCount\n";
########Get count of unique PUMAs codes out of
@pumaCode#######################
@pumaFrequency = ();
for ( $subscript = 0; $subscript <= @pumaCode; $subscript++ ) {
next if ( $pumaCode[ $subscript ] == '' );
++@pumaFrequency[ @pumaCode [ $subscript ] ];
}
#########Display totals for each unique PUMA
code##############################
open(REMOVE, "uploadData2.dat") || die "Cannot open file: $!";
open(TRANSFER, ">modifyData.dat" ) || die "Cannot open file: $!";
while (<REMOVE>){
my ( $recordType, $state, $county,
$mcdPlace, $censusTract, $partIndicator,
$macode, $percentPUMACode, $censusPopulation
) = split( /,/, $_ );
if ( $percentPUMACode != '' ) {
print TRANSFER "$recordType $percentPUMACode
$censusPopulation\n";
}
}
close(REMOVE);
close(TRANSFER);
open(UPLOAD, "modifyData.dat") || die "Cannot open file: $!";
while (<UPLOAD>) {
my ($type, $code, $value) = split;
$code_total{$code} += $value;
$code_detail{$code}{$type} ++;
}
print "PUMA \tPopulation\n";
print "----- \t----------\n";
for my $code (sort keys %code_total) {
print "$code $code_total{$code}\n";
}
print qq(\n\n\n);
#########Display frequency for each unique PUMA code
and#######################
#########display frequency of C P
T############################################
for my $code (sort keys %code_detail) {
next if ( $code_detail{$code} == '' );
my %item, $sum;
$sum += $item{$_} = $code_detail{$code}{$_} || 0 for qw(C P T);
$CPTFrequency[ $subscript ] = qq($code $sum @item{qw(C P T)});
$sum = 0; #reset sum
$subscript++;
}
close(UPLOAD);
foreach ( @CPTFrequency ) {
$_ =~ s/\W+/!/g;
$CPTDisplayFrequency[ $subscript ] = $_;
$subscript++;
}
print "PUMA \tFrequency\tC\tP\tT\n";
print "-----\t---------\t-\t-\t-\n";
foreach ( @CPTDisplayFrequency ) {
$_ =~ s/^\W+//g;
my ( $code, $frequency, $C, $P, $T ) = split ( /!/, $_ );
if ( $code != 0 ) {
print "$code\t$frequency\t\t$C\t$P\t$T\n";
}
}
release_lock();
------------------------------
Date: Thu, 20 Sep 2001 08:27:07 -0500
From: Michael Carman <mjcarman@home.com>
Subject: Re: Unusual error message...
Message-Id: <3BA9EEAB.C6D8E4EB@home.com>
JR wrote:
>
> In the following script, I receive an error message on the line that
> reads:
>
> $sum += $item{$_} = $code_detail{$code}{$_} || 0 for qw(C P T);
>
> of:
>
> Missing $ on loop variable at process.cgi line 182.
The perldiag manpage (perldoc perldiag) will give you more information
about the meaning of errors and warnings. Or, put 'use diagnostics' in
your script to make Perl more verbose up front.
> When I run this script in DOS (minus the CGI stuff, of course), it
> runs perfectly. When I run the script in UNIX, it fails with the
> above error message [...]
[Massive snippage. We didn't need to see all that.]
What are the versions of Perl you're running on DOS and Unix? The
EXPR for[each] EXPR syntax was introduced in 5.005.
-mjc
------------------------------
Date: 20 Sep 2001 17:36:50 GMT
From: blackbird@chatterpages.de (Bianka Martinovic)
Subject: Use symbol table like 'real' hash
Message-Id: <9od9fi$bhh$1@penthesilea.materna.de>
Hello, all together,
I have a problem with the use of a symbol table. I'm sure the solution is
right in front of me but I am too blind to see it.
I am using the &template function of Recipe 20.9 of the Perl Cookbook to
parse data into a html template. Also, I am using the import_names()
function to import the data into namespace 'IN'.
Now, I don't find the right way to pass the %IN:: hash the right way. If I
call the function like
&template( <path>, { \%IN:: });
I am getting nothing into the template. Passing like
&template( <path>, { %IN:: });
sets the symbol names instead of the 'real' values.
At the moment I 'convert' the symbol table IN:: into a 'normal' hash, but
I am sure there is a better and simple way to directly use the symbol
table. I just can't find HOW. I have tried Text::Template too, but as I
have the same problem on another part of the code also (not for parsing
templates), I really need to know how to solve this problem. Can anyone
help me, please?
The real question is, as I think: How to pass a symbol table to a function
which expects a 'normal' hash? I have read many explanations about
Typeglobs an symbol tables, but I did not find out how to use this for my
needs.
Thanks for any tips.
Bianka (Germany)
Here's the &template function:
sub template {
my ($filename, $fillings) = @_;
my $text;
local $/;
local *F;
open(F,"<$filename");
$text = <F>;
close(F);
$text =~ s{ %% ( .*? ) %% }
{ exists( $fillings->{$1} )
? $fillings->{$1}
: ""
}gsex;
return $text;
}
--
Jede Epoche der Menschheit hat so ihre Plagen: Heuschreckenschwaerme
im Altertum, die Pest im Mittelalter, Microsoft in der Neuzeit.
------------------------------
Date: Thu, 20 Sep 2001 15:05:38 +0200
From: "Simon Hughes" <simon.hughes@bluewin.ch>
Subject: Re: Win32::ODBC
Message-Id: <3ba9e9fe$1_3@news.bluewin.ch>
Your syntax assumes that you've already created a DSN in Control Panel
called 'testdsn'. When you created 'testdsn', that's where you specified the
server name.
The (much more flexible) alternative is to fully specify the connection
string (this is an ODBC DSN-less connection) - the exact syntax depends on
the ODBC driver used, but for MSSQL, it's something like this:
ODBC;DRIVER={SQL Server};SERVER=sql01;DATABASE=pubs;UID=sa;PWD=;
That's a generic answer for any application using ODBC, it's not specific to
Perl, but also applies to VB etc.
Simon
"James Vaughan" <jvaughan@qinetiq.com> wrote in message
news:9d271e8e.0109200334.741cc6df@posting.google.com...
> I'm coding a script to connect to multiple Microsoft SQL 7 servers and
> run some simple SQL queries. My question being a newcomer to
> Win32::ODBC is how do I specify the server I want to connect to?
>
> I assume that where I'm setting the $dsn variable I need to add
> another section which relates to the server I am connecting to. I've
> been through the Win32::ODBC documentation that ships with ActiveState
> Perl but can't seem to find any reference to setting the server IP
> address, or other DSN attributes.
>
> any help/references/faq's/links gratefully recieved
>
> kind regards
>
>
> James Vaughan
>
>
>
> ~~~~~~~~~~~~~~~~~~~~~~
> My code is as follows:
>
> #Load modules
> use Win32::ODBC;
> #Set variables
> $dsn = "DSN=testdsn;UID=sa;PWD=;";
>
> if (!($data_connection = new Win32::ODBC($dsn)))
> {
> print "Error connecting to $DSN\n";
> print "Error: " . Win32::ODBC::Error() . "\n";
> exit;
> }
> $data_connection->Close();
------------------------------
Date: 6 Apr 2001 21:33:47 GMT (Last modified)
From: Perl-Users-Request@ruby.oce.orst.edu (Perl-Users-Digest Admin)
Subject: Digest Administrivia (Last modified: 6 Apr 01)
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.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 V10 Issue 1782
***************************************
