[6274] in Perl-Users-Digest
Perl-Users Digest, Issue: 896 Volume: 7
daemon@ATHENA.MIT.EDU (Perl-Users Digest)
Tue Feb 4 23:57:32 1997
Date: Tue, 4 Feb 97 20:00:17 -0800
From: Perl-Users Digest <Perl-Users-Request@ruby.OCE.ORST.EDU>
To: Perl-Users@ruby.OCE.ORST.EDU (Perl-Users Digest)
Perl-Users Digest Tue, 4 Feb 1997 Volume: 7 Number: 896
Today's topics:
Re: Adding a carrage return (Nathan V. Patwardhan)
Re: Can't locate CGI.pm ?? (Nathan V. Patwardhan)
Re: Can't locate CGI.pm ?? (Tad McClellan)
Re: Getting Input <stevej@wco.com>
Re: How to do this using perl? (Tad McClellan)
Re: Need CGI script that reads files from another HTTP (Nathan V. Patwardhan)
Re: Nice perl way to generate n! permutations for n=8 ? (Tad McClellan)
Re: Nice perl way to generate n! permutations for n=8 ? <rootbeer@teleport.com>
Re: nt perl question (Stephen R. Morley)
Re: nt perl question (Nathan V. Patwardhan)
Re: NT perl, system() and html output (Stephen R. Morley)
Re: NT perl, system() and html output (Nathan V. Patwardhan)
Re: paching nested C-structure (Chaim Frenkel)
Re: PERL AND C ROUTINES <rootbeer@teleport.com>
Re: Recursive Calls in Perl? (Dave Thomas)
Script does not work under NT/Netscape Enterprise Serve <Kumar_Kashyap@gecmc.ge.com>
Tell me how to quick access to Perl <topo@pacific.net.sg>
Re: Trimming Dollar Value (Craig Berry)
Digest Administrivia (Last modified: 8 Jan 97) (Perl-Users-Digest Admin)
----------------------------------------------------------------------
Date: 5 Feb 1997 02:12:38 GMT
From: nvp@shore.net (Nathan V. Patwardhan)
Subject: Re: Adding a carrage return
Message-Id: <5d8qam$nav@fridge-nf0.shore.net>
Jeremy Coulter (vss@xtra.co.nz) wrote:
: But what I need, is for it to append a line to a new line, rather that
: straight after the last entery.
Do you do mean this?
$var = 'this is the text';
open(FILE, ">>filename.txt") || print("Hey!: $!\n");
print FILE $var,"\n";
close(FILE);
--
N Patwardhan
nvp@shore.net
send me mail
--Jamie Zawinski
------------------------------
Date: 5 Feb 1997 02:03:46 GMT
From: nvp@shore.net (Nathan V. Patwardhan)
Subject: Re: Can't locate CGI.pm ??
Message-Id: <5d8pq2$nav@fridge-nf0.shore.net>
Jeremy Coulter (vss@xtra.co.nz) wrote:
: Can't locate CGI.pm in @INC at d:\WEBSITE\CGI-SHL\ACCESSES.PL line 27.
: BEGIN failed--compilation aborted at d:\WEBSITE\CGI-SHL\ACCESSES.PL
: line 27
Put the following at the top of your accesses.pl script (In my old Windoze
days, something like this was functional):
BEGIN
{
unshift(@INC, "/path/to/cgipm");
}
use CGI;
HTH!
--
N Patwardhan
nvp@shore.net
send me mail
--Jamie Zawinski
------------------------------
Date: Tue, 4 Feb 1997 20:26:26 -0600
From: tadmc@flash.net (Tad McClellan)
Subject: Re: Can't locate CGI.pm ??
Message-Id: <i4r8d5.vo.ln@localhost>
Jeremy Coulter (vss@xtra.co.nz) wrote:
: Hi, Have downloaded the CGI.pm file and added it to the Perl/Lib
: directory, but I still get the following error :-
: Can't locate CGI.pm in @INC at d:\WEBSITE\CGI-SHL\ACCESSES.PL line 27.
: BEGIN failed--compilation aborted at d:\WEBSITE\CGI-SHL\ACCESSES.PL
: line 27
: why is this, and how do I fix it ?
I dunno. Let's at least find out where perl is looking for it:
perl -e 'foreach (@INC) {print "$_\n"}'
Do any of those directories have CGI.pm in it?
--
Tad McClellan SGML Consulting
Tag And Document Consulting Perl programming
tadmc@flash.net
------------------------------
Date: 5 Feb 1997 00:55:34 GMT
From: Steve Johnson <stevej@wco.com>
Subject: Re: Getting Input
Message-Id: <5d8lq6$qpu@news.wco.com>
Nathan V. Patwardhan <nvp@shore.net> wrote:
> Steve Johnson (stevej@wco.com) wrote:
> : Oh another thing I want to do is be able to home the curser to the top of
> : the screen with out clearing the screen.. is there an easy way to do
> : this.. Basicly Im writing a menu program that uses curser keys to move up
> : and down a highlighted bar on the menu. Any help would be apreciated.
> oooo. Sounds like you're entering the wonderful realm of curses, and
> are looking for the menu.pl package. Clearing the screen is system-specific.
> You might want to pursue Curses.pm available at a CPAN near you (if you're
> using a Unix)!
Thats just it I dont want to depend on someone elses code.. Is there a way
to trap key presses with out Curses? I've got Curses and menu.pl But i
dont want to use them.
-Steve
------------------------------
Date: Tue, 4 Feb 1997 20:22:08 -0600
From: tadmc@flash.net (Tad McClellan)
Subject: Re: How to do this using perl?
Message-Id: <gsq8d5.vo.ln@localhost>
[ emailed, posted ]
Tom Christiansen (tchrist@mox.perl.com) wrote:
: [courtesy cc of this posting sent to cited author via email]
: In comp.lang.perl.misc,
: "Samir Grover" <sgrover@elizacorp.com> writes:
: :@data = split("\", "c:\speech\work");
: :
: :I want to split "c:\speech\work" into array of "c:", "speech" and "work".
: :
: :"\" is creating a problem for perl compiler.
^^^^^^^^^^^^^^^^^^^^^^^^^
: And likewise for awk, C, C++, Tcl, Python, or Java -- or in fact any
: language reasonable or otherwise. It's a stoopid microsoft megablunder.
^^^^^^^^^^^^^^^^^^^^^
I thought it was a CP/M megablunder, wasn't it?
(or should that be CP\M megablunder ;-)
Even back then, backward compatability was important to M$, which
may be why they are still viewed as 'backward' by some (present
company included ;-). It may also be why they are rich as sin...
: Just use real slashes like God and Dennis intended.
^^^^^^^^^^^^^^^^^^^
But, apparently, not like Gary (Kildall) intended ;-)
: @elements = split( m#/#, "c:/speech/work" );
: Yes, the real slashes work just fine in pathnames.
--
Tad McClellan SGML Consulting
Tag And Document Consulting Perl programming
tadmc@flash.net
------------------------------
Date: 5 Feb 1997 02:05:53 GMT
From: nvp@shore.net (Nathan V. Patwardhan)
Subject: Re: Need CGI script that reads files from another HTTP server...
Message-Id: <5d8pu1$nav@fridge-nf0.shore.net>
bart@cloud9.net wrote:
: I am looking for a CGI script that will read files from an HTTP server and return them to the client. I would appreciate it if someone could point me to a nice simple, expandable script that will do the job.
Sir, please fix your linewrap - it's rather difficult to read with the
lines all contorted as you reach the end of each line.
Please get LWP from a CPAN near you!
ftp://ftp.cdrom.com/pub/perl/CPAN/modules/by-module/LWP/
--
N Patwardhan
nvp@shore.net
send me mail
--Jamie Zawinski
------------------------------
Date: Tue, 4 Feb 1997 20:03:47 -0600
From: tadmc@flash.net (Tad McClellan)
Subject: Re: Nice perl way to generate n! permutations for n=8 ??
Message-Id: <3qp8d5.5n.ln@localhost>
NCPSLtd (ncpsltd@aol.com) wrote:
: I'm unable to come up with a nice "algorithm" to generate the permutations
^^^^^^^^^^^
: for 12345678.
: Perl has always given me clever, compact ways to do such jobs, and I'm at
: a loss for this one.
: Ideas, gurus ??
^^^^^
I'm not a guru, but I have an idea that can make a mere mortal
_appear_ to be a guru...
My idea was to use Dejanews to search for 'permutation' in
comp.lang.perl.misc.
It found eleven hits.
The one with subject "Re: Permutation Problem" by Mike Stok
gives *two* subroutines for calculating permutations.
As a good net citizen, I'm sure you have already looked to see
if this question has been asked before, so you already knew this.
I'm just pointing it out for the other readers of the newsgroup ;-)
--
Tad McClellan SGML Consulting
Tag And Document Consulting Perl programming
tadmc@flash.net
------------------------------
Date: Tue, 4 Feb 1997 19:32:36 -0800
From: Tom Phoenix <rootbeer@teleport.com>
To: NCPSLtd <ncpsltd@aol.com>
Subject: Re: Nice perl way to generate n! permutations for n=8 ??
Message-Id: <Pine.GSO.3.95.970204185036.15797B-100000@linda.teleport.com>
On 5 Feb 1997, NCPSLtd wrote:
> I'm unable to come up with a nice "algorithm" to generate the permutations
> for 12345678.
>
> Perl has always given me clever, compact ways to do such jobs, and I'm at
> a loss for this one.
I consider this method neither clever nor compact, but you're welcome to
it. It would probably be faster coded non-recursively. Enjoy!
-- Tom Phoenix http://www.teleport.com/~rootbeer/
rootbeer@teleport.com PGP Skribu al mi per Esperanto!
Randal Schwartz Case: http://www.lightlink.com/fors/
#!/usr/bin/perl -w
use strict;
# perms takes a string as input, and returns a list of the possible
# permutations of that input string, treating all characters as
# different. That is, if the input string is n characters long,
# the returned list will have n! elements.
sub perms {
my $input = $_[0];
my $length = length $input;
# Impose an arbitrary limit:
die "Too many elements ($length)\n" if $length > 8;
return $input if $length < 2; # For efficiency
return scalar(reverse $input), $input
if $length == 2; # For more efficiency
my $last; # Each element gets a turn at being last
my $tried = ''; # Elements which have already been last
my @results; # Finished permutations
while ('' ne ($last = chop $input)) {
push @results, map "$last$_",
&perms("$input$tried");
substr($tried,0,0) = $last; # Prepend $last to $tried
}
@results;
}
# scalar reverse is kind of nice here
print map "$_\n", &perms(scalar reverse '1234');
__END__
------------------------------
Date: Wed, 05 Feb 1997 03:13:38 GMT
From: morleys@ix.netcom.com (Stephen R. Morley)
Subject: Re: nt perl question
Message-Id: <5d8u88$nq7@sjx-ixn10.ix.netcom.com>
Be careful with UNIX style delimiters, they don't work if you need to
pass the filename to the OS via a system() call.
nvp@shore.net (Nathan V. Patwardhan) wrote:
>Hieu Bui (hbui@hmc.edu) wrote:
>: $file = ".\\data\\file.txt";
>: open (HANDLE, ">>$file")
>Slightly off-topic, but:
>I'd suggest that you don't use the DOS "\" conventions, as it seems that
>you're going well out of your way by escaping all the "\". NT Perl will
>work with "Unix-style" path delimiters "/". For example, to open the
>file C:\WINDOWS\SYSTEM.INI, you can do:
>$file = '/windows/system.ini';
>open(FILE, ">>$file") || die("Hey!: $!\n");
>etc etc etc
>To add/append to strings, try:
>$string .= "something to append";
>--
>N Patwardhan
>nvp@shore.net
>send me mail
> --Jamie Zawinski
------------------------------
Date: 5 Feb 1997 03:38:45 GMT
From: nvp@shore.net (Nathan V. Patwardhan)
Subject: Re: nt perl question
Message-Id: <5d8vc5$sq@fridge-nf0.shore.net>
Stephen R. Morley (morleys@ix.netcom.com) wrote:
: Be careful with UNIX style delimiters, they don't work if you need to
: pass the filename to the OS via a system() call.
Right, but there's no need to use system() or backticks with the
flotilla of useful modules, and the ease of filehandles, not to
mention (from my other posting) the ease of porting code that
doesn't delve into system-specific malarchy.
--
N Patwardhan
nvp@shore.net
send me mail
--Jamie Zawinski
------------------------------
Date: Wed, 05 Feb 1997 03:11:30 GMT
From: morleys@ix.netcom.com (Stephen R. Morley)
Subject: Re: NT perl, system() and html output
Message-Id: <5d8u48$nq7@sjx-ixn10.ix.netcom.com>
Another way would be to use `copy ...` syntax, or even
system("copy ... >nul"), either will suppress stdout.
nvp@shore.net (Nathan V. Patwardhan) wrote:
>Daniel Donghoon Paik (uctt@uclink.berkeley.edu) wrote:
>: i wrote a perl script for a form in html. i am using the system()
>: function to call dos exe programs. my problem is that that output of
>: these system calls shows up on the screen. for example, if i do
>: system("copy myfile.doc myfile2.doc"); then on my html page i will get a
>Don't use system() when you don't have to. There are a couple of "neat"
>File modules that you might be interested in, including File::Copy. These
>might be included with the most recent NT Perl port, but are definitely
>available from a CPAN near you!
>--
>N Patwardhan
>nvp@shore.net
>send me mail
> --Jamie Zawinski
------------------------------
Date: 5 Feb 1997 03:36:46 GMT
From: nvp@shore.net (Nathan V. Patwardhan)
Subject: Re: NT perl, system() and html output
Message-Id: <5d8v8e$sq@fridge-nf0.shore.net>
Stephen R. Morley (morleys@ix.netcom.com) wrote:
: Another way would be to use `copy ...` syntax, or even
: system("copy ... >nul"), either will suppress stdout.
I don't understand one's reliance on system() or backticks if there
are some perfectly reliable modules around (that will perform the same
function(s)). Just my opinion, but modules and non-system specific
code expedite (and simplify) the porting process.
--
N Patwardhan
nvp@shore.net
send me mail
--Jamie Zawinski
------------------------------
Date: 5 Feb 1997 01:52:03 GMT
From: Chaimf@cris.com (Chaim Frenkel)
Subject: Re: paching nested C-structure
Message-Id: <5d8p43$gp8@chronicle.concentric.net>
[poster cc'ed]
You are ignoring padding. Either examine what is generated by your
compiler for debugging (stabs), or write a short program to dump the
offsets.
<chaim>
Gabriel Dos Reis (dosreis@DPTMaths.ENS-Cachan.Fr) (comp.lang.perl.misc <v8vn2tk6pqo.fsf@piano.dptmaths.ens-cachan.fr>) wrote:
:
:
: How does one pack the utmpx scturture in Perl ? Just saying
:
: $utmpx_t = 'A32 A4 A32 l s s2 l2 l l5 s A257';
:
: doesn'y work. (Its size is 369 bytes whereas a C-program (included
: below) says it is 372 bytes)
:
: Any help appreciated.
------------------------------
Date: Tue, 4 Feb 1997 18:29:34 -0800
From: Tom Phoenix <rootbeer@teleport.com>
To: John Fishbone <emf@remus.rutgers.edu>
Subject: Re: PERL AND C ROUTINES
Message-Id: <Pine.GSO.3.95.970204182738.15797A-100000@linda.teleport.com>
On Tue, 4 Feb 1997, John Fishbone wrote:
> I need to call the "crypt function that is found in the unistd.h"
>
> Can I call this function from within my PERL script?
I do believe that this is Perl's crypt() function, documented in
perlfunc(1).
> Does anyone know if i call this will I be able to give it filehandles
> as paramters or just straight files from my UNIX environment?
I don't believe you can. It takes two strings as parameters, and returns
one. (The C function doesn't take files either.)
Hope this helps!
-- Tom Phoenix http://www.teleport.com/~rootbeer/
rootbeer@teleport.com PGP Skribu al mi per Esperanto!
Randal Schwartz Case: http://www.lightlink.com/fors/
------------------------------
Date: 5 Feb 1997 02:03:12 GMT
From: dave@fast.thomases.com (Dave Thomas)
Subject: Re: Recursive Calls in Perl?
Message-Id: <slrn5ffqek.l3a.dave@fast.thomases.com>
On 4 Feb 1997 20:49:33 GMT, Samir Grover <sgrover@elizacorp.com> wrote:
> Hello all,
> Consider following simple perl script
> #Start
> ...
> $file_name = "foo";
> &doCommand($file_name);
> print "Completed\n";
> ...
> ...
>
> sub doCommand {
> open(COMFILE, <$_[0]>) # open for read
>
> $another_file_name = <COMFILE>;
> &doCommand(another_file_name);
> ...
> print "YET MORE TO DO\n";
> ...
> ...
>
> #END
>
> I want to see output as:
>
> YET MORE TO DO
> Completed
>
> However, I see following:
>
> YET MORE TO DO
>
>
> Whey does it not print "Completed" after "YET MORE TO DO"
>
Well, a couple of things here. Firstly, this isn't Perl! It doesn't compile.
The 'open' line should be:
open(COMFILE, $_[0]);
The <>s are spurious.
Then, you're not checking any error codes, so how do you know if you even
get a second file name.
my $fileName = shift;
open(COMFILE, $fileName) or die "Can't open $fileName: $!";
Then, you're re-using the file handle COMFILE, so each level or recursion
closes the file opened at the level above.
The Perl documentation or the Camel books talk about ways of handling this.
The easiest way is to generate the file handles dynamically.
Regards
Dave
--
_________________________________________________________________________
| Dave Thomas - Dave@Thomases.com - Unix and systems consultancy - Dallas |
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
------------------------------
Date: Tue, 04 Feb 1997 15:52:12 -0500
From: Kumar Kashyap <Kumar_Kashyap@gecmc.ge.com>
Subject: Script does not work under NT/Netscape Enterprise Server
Message-Id: <32F7A17C.33E4@gecmc.ge.com>
This is a multi-part message in MIME format.
------------BF74A8E1A2811
Content-Type: multipart/alternative; boundary="----------303C50131B5812"
------------303C50131B5812
Content-Transfer-Encoding: 7bit
Content-Type: text/plain; charset=us-ascii
Hi!
I am having problems with the attached script running under
winnt/Netscape Enterprise Server. No problems executing it on Unix. The
script runs fine from the perl command line.
Any help/suggestions greatly appreciated.
thanks,
Kumar
------------303C50131B5812
Content-Transfer-Encoding: 7bit
Content-Type: text/html; charset=us-ascii
<HTML><BODY>
<DT> Hi!</DT>
<DT> </DT>
<DT> I am having problems with the attached script running
under winnt/Netscape Enterprise Server. No problems executing it on Unix.
The script runs fine from the perl command line. </DT>
<DT> </DT>
<DT> Any help/suggestions greatly appreciated.</DT>
<DT> </DT>
<DT>thanks,</DT>
<DT> </DT>
<DT>Kumar</DT>
</BODY>
</HTML>
------------303C50131B5812--
------------BF74A8E1A2811
Content-Transfer-Encoding: 7bit
Content-Disposition: inline; filename="Lticque2.pl"
Content-Type: application/x-perl; name="Lticque2.pl"
#!/usr/bin/perl -- -*-perl-*-
# ------------------------------------------------------------
# Print out a content-type for HTTP/1.0 compatibility
print "Content-type: text/html\n\n";
# Print a title and initial heading
print "<Head><Title>LTIC QUERY RESULTS</Title></Head>";
print "<Body><H1>LTIC QUERY RESULTS</H1>";
# Get the input
read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
# Split the name-value pairs
@pairs = split(/&/, $buffer);
foreach $pair (@pairs)
{
($name, $value) = split(/=/, $pair);
# Un-Webify plus signs and %-encoding
$value =~ tr/+/ /;
$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
# Stop people from using subshells to execute commands
# Not a big deal when using sendmail, but very important
# when using UCB mail (aka mailx).
# $value =~ s/~!/ ~!/g;
# Uncomment for debugging purposes
# print "Setting $name to $value<P>";
$FORM{$name} = $value;
}
# If the comments are blank, then give a "blank form" response
#&blank_response unless $FORM{'Message'};
# Now send mail to $recipient
#print "Region selected is : $FORM{'region'}\n";
#print "State selected is : $FORM{'st'}\n";
#****************************************************************
#global vars passed from form - for now hardcoded
#$st="AL";
#$state="ALABAMA";
@unitarray;
unless (open (OUTFILE, ">region1_.txt"))
{ print STDERR ("cannot open region_out\n"); }
#@region_out=<OUTFILE>;
sub get_unit_tblOrgSr {
unless (open (INFILE, "c:\Netscape\Server\docs\cgi-bin\tblOrgSr.txt"))
{ print STDERR ("cannot open tblOrgSr\n"); }
@tblOrgSr=<INFILE>;
$cnt=0;
#print "\nIN sub get_unit_tblOrgSr with unit - $unit\n";
#$unit=str($unit);
if (@tblOrgSr_a=grep(/$unit/,@tblOrgSr)){
#print "\nIN grep ********* with tblOrgSr_a = @tblOrgSr_a\n";
while (@tblOrgSr_a) {
$cnt+=1;
$tmp6=shift(@tblOrgSr_a);
#print "\n tmp6 - $tmp6\n";
chop ($tmp6);
$tmp6 =~s/"//g;
@tbltmp6=split(/\t/,$tmp6);
chop(@tbltmp6[3]);
#***********FINAL PIECE UNDER UNIT OUT ***************
if ($cnt<2) {
print " @tbltmp6[3], ";print "@tbltmp6[2]\n";
}
else
{
print "\t\t\t\t\t\t\t @tbltmp6[3], ";print "@tbltmp6[2]\n";
}
}
}
else
{print "\n";}
close(INFILE);
}
sub get_OrgRel_key {
unless (open (INFILE, "c:\Netscape\Server\docs\cgi-bin\tblOrgRe.txt"))
{ print STDERR ("cannot open OrgRel\n"); }
@tblOrgRel=<INFILE>;
#print "\nIN ORGREL with unit - $unit\n";
$unit=int($unit);
#if (@tblOrgRel_array=~grep(/$unit.*/,@tblOrgRel)){
if (@tblOrgRel_array[0]=grep(/$unit/,@tblOrgRel)){
#print ("in IFFFFFFFFF\n");
while (@tblOrgRel_array) {
$tmp4=shift(@tblOrgRel_array);
$tmp4 =~s/"//g;
@tbltmp4=split(/\t/,$tmp4);
#***********FINAL ADDRESS OUT ***************
#print "TBLORGREL --- ";
#assign field 2 from OrgRel to varialbe
$OrgRel_field2=@tbltmp4[1];
}
}
close(INFILE);
}
sub place_corporation {
unless (open (INFILE, "c:\Netscape\Server\docs\cgi-bin\tblOrgan.txt"))
{ print STDERR ("cannot open Organize\n"); }
@Organize=<INFILE>;
#print "\nIN Organize with unit - $unit\n";
#$unit=int($unit);
$OrgRel_field2=int($OrgRel_field2);
#if (@Organize_a=~grep(/$unit.*/,@Organize)){
if (@Organize_a[0]=grep(/$OrgRel_field2/,@Organize)){
#print (" OrgRel_field2 - $OrgRel_field2\n");
while (@Organize_a) {
$tmp5=shift(@Organize_a);
$tmp5 =~s/"//g;
@tbltmp5=split(/\t/,$tmp5);
#***********FINAL CORPORATION OUT ***************
#print "ORGANIZATION --- ";
print "@tbltmp5[3]\t\t";
}
}
close(INFILE);
}
#--------------------------------------------------------
#get units piece
sub unit
{
$count=0;
#@unitarray;
for $l (@tblOrganize) {
@unitarray[$count]=$l;
#remove all info after first tab
@unitarray[$count] =~s/(\t).*//g;
#remove quotes
@unitarray[$count] =~s/"//g;
# print STDERR "unit is $l\n";
$count+=1;
#print "\t\t\tUNIT NUMBER(S) = $l";
}#end for $l
#print @unitarray;
}
#--------------------------------------------------------
sub messagefield
{
#--------------------------------------------------------
unless (open (INFILE, "c:\Netscape\Server\docs\cgi-bin\tblMessa.txt"))
{ print STDERR ("cannot open Message\n"); }
@tblMessage=<INFILE>;
for $l (@tblMessage)
{
#$l=~s/\r\n//g;
#print $l;
}
print "<P>* * * $st\n";
for $l (@tblMessage) {
#note ^$st, which means the line must begin with $st
if ($l=~/^\"$st/){
#remove tabs print last field
$l =~s/"//g;
$l =~s/(.*\t)?//g;
print (" $l\n<BR>");
}
}
close(INFILE);
}
sub tblOrganize_out
{
#$tbltmp=grep(/\ARGV[0]/,@tblOrganize);
#@tblOrganize_array=split(/\t/,@tblOrganize[$tbltmp]);
#@tblOrganize_array=split(/\t/,$tbltmp);
#print "tblOrganize_array is @tblOrganize_array\n";
for $m (@tblOrganize) {
#print OUTFILE "m is $m andddd l is $l\n";
if (@unitarray[$count_states]=~/$m/) {
#print "m is $m andddd l is $l\n";
#$m=~s/(\t.*)?//g;
#print ("tblOrganize row is $m\n");
}
}
close(INFILE);
}
sub tblAddress_out
{
unless (open (INFILE, "c:\Netscape\Server\docs\cgi-bin\tblAddre.txt"))
{ print STDERR ("cannot open Address\n"); }
@tblAddress=<INFILE>;
$count_address=0;
for $l (@tblAddress) {
#make array for fielded search
#$m=$l;
#@n=split(/\t/,$m);
#print OUTFILE ("n[0] is \@n[0] befor loop and unit is $unit\n");
#if ($l=~/["']?$unit["']?/) {
if ($l=~/^$unit/) {
#make array for fielded search
#@tblAddress_array=split(/\t/,$n);
#print ("line n is $n\n");
#***********FINAL OUT LINE 3 ***************
print OUTFILE("unit was $unit - unit_int was $unit_int tblAddress_int $tblAddress_int\n");
print OUTFILE("ADDRESS is $n \n");
print "ADDRESS is \@n \n";
$count_address+=1;
#print OUTFILE( "count address is $count_address\n)";
}
}
close(INFILE);
}
sub getunits_for_states {
$count_states=0;
#@unitarray;
#--------------------------------------------------------
unless (open (INFILE, "c:\Netscape\Server\docs\cgi-bin\tblOrgan.txt"))
{ print STDERR ("cannot open Organize\n"); }
@tblOrganize=<INFILE>;
for $l (@tblOrganize)
{
#print "$st is st in getunits_for_states\n";
#print "$l is l in getunits_for_states\n";
if ($l=~/\"$st\"/){
$l =~s/"//g;
@unitarray[$count_states]=$l;
#make array for fielded search
@tblOrganize_array=split(/\t/,$l);
#print "tblOrganize_array is @tblOrganize_array\n";
#remove all but first field
@unitarray[$count_states]=~s/(\t.*)?//g;
@unitarray[$count_states]=~s/"//g;
$unit= @unitarray[$count_states];
#***********FINAL OUT LINE 1 ***************
#print "\n\nunit found is $unit\n";
#remove line feed
chop($unit);
#print "\t\t\tUNIT NUMBER = $l";
#print ("tblOrganize = $l\n");
#print ("tblOrganize has UNIT NUMBER = @unitarray[$count_states])\n";
#***********FINAL OUT LINE 2 ***************
print "<PRE>\n";
print "@tblOrganize_array[7] ";
print "(@tblOrganize_array[10])";
$u=substr($unit,2,5);
print "\t\t\t\t\t(UNIT NUMBER - $u)\n";
&get_OrgRel_key;
#***********FINAL OUT CORPORATION (LINE 2) ***************
&place_corporation;
&get_unit_tblOrgSr;
#print "@tblOrgSr_a[10], @tblOrgSr_a[8]\n";
#***********FINAL OUT LINES 3 and 4 ***************
print "@tblOrganize_array[3]\n";
print "@tblOrganize_array[4]\n";
print "@tblOrganize_array[5]\n";
print "@tblOrganize_array[7], ";
print "@tblOrganize_array[8] ";
#format zipcode
if (length(@tblOrganize_array[9])>5) {
#print " DASHED ALL @tblOrganize_array[9] is \t";
$tmpsub1=substr(@tblOrganize_array[9],0,5);
$tmpsub2=substr(@tblOrganize_array[9],5,8);
print "$tmpsub1-$tmpsub2\n";
}
else
{print "@tblOrganize_array[9]\n";}
unless (open (INFILE, "c:\Netscape\Server\docs\cgi-bin\tblAddre.txt"))
{ print STDERR ("cannot open Address\n"); }
@tblAddress=<INFILE>;
@tblAddress=~s/\r\n//g;
#print @tblAddress;
$unit=int($unit);
if (@tblAddress_array=grep(/($unit).*\n/,@tblAddress)){
while (@tblAddress_array) {
$tmp=shift(@tblAddress_array);
$tmp =~s/"//g;
@tbltmp=split(/\t/,$tmp);
#***********FINAL ADDRESS OUT LINES 5 and 6 ***************
print "MAILING ADDRESS:\n";
print "@tbltmp[2]\n";
#print "@tbltmp[3] ";print "@tbltmp[4]\n";
print "@tbltmp[5], ";
print "@tbltmp[6] ";#print "@tbltmp[7] ";
#format zipcode
if (length(@tbltmp[7])>6) {
#print " DASHED ALL @tblAddress_array[7] is \t";
$tmpsub1=substr(@tbltmp[7],0,5);
$tmpsub2=substr(@tbltmp[7],5,4);
print "$tmpsub1-$tmpsub2\n";
}
else
{print "@tbltmp[7]\n";}
}
}
close(INFILE);
unless (open (INFILE, "c:\Netscape\Server\docs\cgi-bin\tblConta.txt"))
{ print STDERR ("cannot open Contact\n"); }
@tblContact=<INFILE>;
@tblContact=~s/\r\n//g;
$tblContact_count=0;
#print OUTFILE ("unit is $unit --- \n");
#$unit=int($unit);
if (@tblContact_array=grep(/($unit).*\n/,@tblContact)){
while (@tblContact_array) {
$tblContact_count+=1;
$tmp2=shift(@tblContact_array);
$tmp2 =~s/"//g;
@tbltmp2=split(/\t/,$tmp2);
#***********FINAL OUT CONTACT ***************
if ($tblContact_count < 2) {
print "MAIN CONTACT: ";
}
else {
print "OTHER:\t ";
}
print "@tbltmp2[1] ";
print "@tbltmp2[3] ";
print "@tbltmp2[4] ";
print "@tbltmp2[2], ";
print "@tbltmp2[12] \n";
#print "@tbltmp2[5] \n";
#print "@tbltmp2[13] ";
#print "@tbltmp2[6] ";
#print "@tbltmp2[7] ";
#print "@tbltmp2[8]\n";
#print "@tbltmp2[9]\n";
#print "@tbltmp2[10] \n";
#print "@tbltmp2[11]";
}
}
close(INFILE);
unless (open (INFILE, "c:\Netscape\Server\docs\cgi-bin\tblPhone.txt"))
{ print STDERR ("cannot open tblPhone\n"); }
@tblPhone=<INFILE>;
@tblPhone=~s/\r\n//g;
$tblPhone_count=0;
if (@tblPhone_array=grep(/($unit).*\n/,@tblPhone)){
while (@tblPhone_array) {
$tblPhone_count+=1;
if ($tblPhone_count <= 1) {
$tmp3=shift(@tblPhone_array);
$tmp3 =~s/"//g;
@tbltmp3=split(/\t/,$tmp3);
#***********FINAL OUT Phone ***************
if (@tbltmp3[1]) {
print "@tbltmp3[1]: ";
}
else
{
print "PHONE: ";
}
#print "\n@tbltmp3[3] is now ";
$t1=(substr(@tbltmp3[3],0,3));$t2=(substr(@tbltmp3[3],3,3));$t3=(substr(@tbltmp3[3],6,4));
print "$t1-$t2-$t3 \n";
}
}
print "\n * * * * * * * * * * \n";
}
close(INFILE);
$count_states+=1;
}
}
print "\n";
#print @unitarray;
close(INFILE);
}
sub region_query {
#make arrays for regions with key
@states_region1=('region1','DC', 'MD', 'NC', 'WV', 'SC');
@states_region2=('region2','AR', 'AL', 'LA', 'MS', 'TN');
@states_region3=('region3' ,'KS', 'OK', 'NM', 'TX');
@states_region4=('region4' ,'AZ', 'CA', 'OR', 'NV', 'WA');
@states_region5=('region5' ,'CT', 'NH', 'MA', 'ME', 'RI', 'VT');
@states_region6=('region6' ,'ID', 'UT', 'MT', 'WY', 'CO', 'ND', 'SD', 'NE', 'MN', 'IL', 'MO', 'WI', 'IL');
@states_region7=('region7' ,'DE', 'NJ', 'NY', 'PA');
@states_region8=('region8' ,'MI');
@states_region9=('region9' ,'IN', 'KY', 'OH');
@states_region10=('region10' ,'FL');
$reg_count=0;
if ($FORM{region} eq @states_region1[0]) {
@states_region=@states_region1;
$reg_count=1;
}
if ($FORM{region} eq @states_region2[0]) {
@states_region=@states_region2;
$reg_count=1;
}
if ($FORM{region} eq @states_region3[0]) {
@states_region=@states_region3;
$reg_count=1;
}
if ($FORM{region} eq @states_region4[0]) {
@states_region=@states_region4;
$reg_count=1;
}
if ($FORM{region} eq @states_region5[0]) {
@states_region=@states_region5;
$reg_count=1;
}
if ($FORM{region} eq @states_region6[0]) {
@states_region=@states_region6;
$reg_count=1;
}
if ($FORM{region} eq @states_region7[0]) {
@states_region=@states_region7;
$reg_count=1;
}
if ($FORM{region} eq @states_region8[0]) {
@states_region=@states_region8;
$reg_count=1;
}
if ($FORM{region} eq @states_region9[0]) {
@states_region=@states_region9;
$reg_count=1;
}
if ($FORM{region} eq @states_region10[0]) {
@states_region=@states_region10;$reg_count=1;
}
if ($reg_count=0) {
print "\n<P>Region not found, return<P>\n";
exit;
}
else
{
#remove key field
shift(@states_region);
#print STDERR "@states_region\n";
#exit;
while (@states_region)
{
$st=shift(@states_region1);
#print ("STATE IS $st\n");
&messagefield;
&getunits_for_states($st);
}
close(INFILE);
close(OUTFILE);
# Make the person feel good for writing to us
print "LTIC QUERY RESULTS CONCLUDED.\n<P>";
#print "Return to <a href=www\.ltic\.com>LTIC HOME PAGE<\/a><P>";
}
}
sub state_query {
#if (@tblPhone_array=grep(/($unit).*\n/,@tblPhone)){
if (grep (/$FORM{st}/,@states)) {
$st=$FORM{st};
&messagefield;
&getunits_for_states($st);
}
else
{
print "\n<P>State not found, return<P>\n";
exit;
}
}
############## MAIN ###############
@states=('DC', 'MD', 'NC', 'WV', 'SC','AR', 'AL', 'LA', 'MS', 'TN' ,'KS', 'OK', 'NM', 'TX' ,'AZ', 'CA', 'OR', 'NV', 'WA' ,'CT', 'NH', 'MA', 'ME', 'RI', 'VT','ID', 'UT', 'MT', 'WY', 'CO', 'ND', 'SD', 'NE', 'MN', 'IL', 'MO', 'WI', 'IL' ,'DE', 'NJ', 'NY', 'PA','MI' ,'IN', 'KY', 'OH' ,'FL');
&unit;
#$FORM{region}='region7';
#print "\nENTER STATE\n";
#$FORM{st}=<STDIN>;
#$FORM{st}='PA';
#chop($FORM{st});
#check for existence of variable
if ($FORM{'region'}) {
®ion_query;
}
if ($FORM{'st'}) {
&state_query;
}
if ((!($FORM{'region'})) & (!($FORM{'st'}))) {
&blank_response;
}
# ------------------------------------------------------------
# subroutine blank_response
sub blank_response
{
print "\n<H3>Your selection appears to be blank, please <A HREF\=\.\.\/lticquery\.pl>return\.<\/A><\/H3>\n";
exit;
}
------------BF74A8E1A2811--
------------------------------
Date: 5 Feb 1997 03:21:17 GMT
From: "Topo" <topo@pacific.net.sg>
Subject: Tell me how to quick access to Perl
Message-Id: <01bc1313$2eb2afe0$6b4c78cb@topo>
i am newer for Perl, and now i want to learn it for my business.
can you tell me where i can get Perl resource on the internet.
tell me the fastest way to learn Perl.
i had experience with c & cpp lang.
thanks
------------------------------
Date: 5 Feb 1997 02:14:01 GMT
From: cberry@cinenet.net (Craig Berry)
Subject: Re: Trimming Dollar Value
Message-Id: <5d8qd9$hrq$1@marina.cinenet.net>
Tad McClellan (tadmc@flash.net) wrote:
: Bok Nan Lo (support@inklineglobal.com) wrote:
: : I'm having hard time with formatting and trimming an amount in a variable.
:
: : e.g. $3.4405
:
: : I just wanted it to be $3.44 rather than four decimal places. How can I get
: : it solved?!
:
: Here's two ways:
[way 1 snipped]
:
: $trimmed = "\$" . sprintf("%.2f", substr($_, 1)); # round it to two places
: print "$trimmed\n";
As long as you're formatting a string, why not move the display sugar
inside the format spec, rather than appending (well, prepending) it?
I'd do:
$trimmed = sprintf("\$%.2f", ...
Seems a bit more direct that way, but purely a matter of taste, of course.
---------------------------------------------------------------------
| Craig Berry - cberry@cinenet.net
--*-- Home Page: http://www.cinenet.net/users/cberry/home.html
| Member of The HTML Writers Guild: http://www.hwg.org/
"Every man and every woman is a star."
------------------------------
Date: 8 Jan 97 21:33:47 GMT (Last modified)
From: Perl-Request@ruby.oce.orst.edu (Perl-Users-Digest Admin)
Subject: Digest Administrivia (Last modified: 8 Jan 97)
Message-Id: <null>
Administrivia:
The Perl-Users Digest is a retransmission of the USENET newsgroup
comp.lang.perl.misc. For subscription or unsubscription requests, send
the single line:
subscribe perl-users
or:
unsubscribe perl-users
to almanac@ruby.oce.orst.edu.
To submit articles to comp.lang.perl.misc (and this Digest), send your
article to perl-users@ruby.oce.orst.edu.
To submit articles to comp.lang.perl.announce, send your article to
clpa@perl.com.
To request back copies (available for a week or so), send your request
to almanac@ruby.oce.orst.edu with the command "send perl-users x.y",
where x is the volume number and y is the issue number.
The Meta-FAQ, an article containing information about the FAQ, is
available by requesting "send perl-users meta-faq". The real FAQ, as it
appeared last in the newsgroup, can be retrieved with the request "send
perl-users FAQ". Due to their sizes, neither the Meta-FAQ nor the FAQ
are included in the digest.
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 V7 Issue 896
*************************************
