[18896] in Perl-Users-Digest

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

Perl-Users Digest, Issue: 1064 Volume: 10

daemon@ATHENA.MIT.EDU (Perl-Users Digest)
Tue Jun 5 14:16:11 2001

Date: Tue, 5 Jun 2001 11:15:21 -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: <991764921-v10-i1064@ruby.oce.orst.edu>
Content-Type: text

Perl-Users Digest           Tue, 5 Jun 2001     Volume: 10 Number: 1064

Today's topics:
        Perl Server Problems (Joe)
    Re: perl/cgi and dynamic hyperlink <thunderbear@bigfoot.com>
    Re: perl/cgi and dynamic hyperlink <joe+usenet@sunstarsys.com>
    Re: Problem with STAT function (Tad McClellan)
    Re: Problem with STAT function (Abigail)
    Re: releasing array memory (Tad McClellan)
    Re: releasing array memory (Abigail)
        viewing ceritficate information (Ian)
        What am I doing wrong with this array operation? <jhill@technoslave.net>
    Re: What am I doing wrong with this array operation? <jhill@technoslave.net>
    Re: What am I doing wrong with this array operation? (Andrew J. Perrin)
    Re: What am I doing wrong with this array operation? <jhill@technoslave.net>
        Digest Administrivia (Last modified: 6 Apr 01) (Perl-Users-Digest Admin)

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

Date: 5 Jun 2001 09:13:18 -0700
From: jbowman@budweiser.com (Joe)
Subject: Perl Server Problems
Message-Id: <6e9d82e3.0106050813.4d5f5ac@posting.google.com>

I am having a problem with a perl server. Basically I am trying to
adapt a CGI I had written to a perl server which interacts with Java
Applet clients. The reason being is that I am dealing with files that
need to be input to it that are very large (my example file given to
me is 42.9kb).

The problem I am having is that on the large files, my variable
$storytextsend is never getting cleared, even though I explicitly
clear it in serveral places. This is the variable that holds the
largest amount of text in it.

The full code for my server is listed below -

------------------------------------------------------------------------------
#!/usr/bin/perl
##########################################################################
#
# I/O Multiplexing Server example.
#
# This server accepts connections from an arbitrary number of clients.
# When a new connection is established, information about the new
connection
# is sent to all connected clients.   Input from individual clients is
# simply echoed back to the sender.
#
# Notice that arrays of file handles in Perl are incredibly yucky,
since
# file handles aren't first class objects.  It's not my fault.
#
# By Prof. Golden G. Richard III, Dept. of Computer Science,
University
# of New Orleans, April 1996.   Use for any purpose whatsoever
granted.
#
# Command line arguments expected are:   port
#
##########################################################################
#
# Perl socket stuff is based on, and very similar to, C socket stuff.
# The Unix man pages for the various socket system calls such as 
# 'listen', 'bind', etc. may be very useful to you.  To get 
# information on a particular call, such as 'accept', use the
following
# command:
# 
#  % man -s3N accept
#
# The -s3N tells man to look in 3N section of the Unix manual.
#
# Ranges of port addresses will be assigned to you in class. 
Generally, if
# you get an "address already in use" error, try a different port.
# We'll be using ports in the ranges 5000-6000.
#
##########################################################################

# In Perl 5 and above, the Socket module contains Perl definitions for
# the stuff in the C include file "/usr/include/sys/socket.h".  
# Rather than manually poking through that include file to get values
# for each architecture, a "use Socket" assures that you'll get the
right
# values.  This replaces the following lines in the example in the
book:
# 
# $AF_INET = 2;
# $SOCK_STREAM = 1;
#
# which turn out to be wrong for Solaris, anyway 
# ($SOCK_STREAM should be 2)
#
# In general, hard-coded socket constants in Perl 5+ are a bad
practice.  Use
# the Socket module instead.

use Socket;

sub readline {

# 'select'-compatible function for reading one line of input from 
#    a filehandle.
#    
#    readline() expects one argument -- filehandle S
#
#    sample call:       $mystring = readline('S')
#

    my $filehandle = $_[0];
    my $c='';
    my $retstr='';
    my $endoffile=0;

    while ($c ne "\n" && ! $endoffile) {
        if (sysread($filehandle, $c, 1) > 0) {
            $retstr = $retstr . $c;
        }
        else {
            $endoffile=1;
        }
    }
    
    return $retstr;
}

# Sucks in the command line arguments (resident in the array variable
ARGV)
# and assigns them to the variables listed in ().  In this case, the
first
# command line argument is the port [more on this later] and it's
# placed into the variable 'port'.  We don?t care about any other
command-line
# arguments.
        
($port) = @ARGV;

# This checks to see if 'port' has been assigned a value and if it
hasn't,
# assigns the default port value 2345

$port = 2345 unless $port;

# Looks up important information related to the network protocol you
wish
# to use.   'tcp' is a connection-oriented protocol.  Look in 
# the file /etc/protocols for examples of others.   Don't change this
unless
# you know what you're doing.

($name, $aliases, $protocol) = getprotobyname('tcp');

# In the following, $port is the port the user specified either on the
# command line or by default.   =~ is the Perl regular expression
binding
# operator and !~ is the negation of =~.   Regular expressions are
# enclosed between / / characters in Perl.   \d matches a single
digit,
# \d+ matches a string of 1 or more digits, ^ specifies "beginning of 
# string", and $ specifies "end of string".    /^\d+$/ as a regular
# expression, therefore, matches integers of arbitrary length.
# So...   The following line says:  If the port contains any non-digit
# characters, look up the port number associated with the symbolic
# name specified by the user.   The lookup is done against the
# file/etc/services.  Unless you're hacking code to talk to
well-established
# servers such as the httpd daemon, for example, you'll use numeric
port
# addresses, so don't worry about this too much.

if ($port !~ /^\d+$/) {
    ($name, $aliases, $port) = getservbyport($port, 'tcp');
}

# Let the user know what port we're listening on, just in case (s)he
# accidentally typed an incorrect port.

print "Listening on port $port...\n";

# 'socket' creates one endpoint for a communication link (think of it
as
# creating a telephone. Later, someone else will create another
telephone
# and wires will be attached between them).   The S parameter is the
handle
# associated with the created communication endpoint.    AF_INET
specifies
# that we're talking using ports.   AF_UNIX would specify that we'd be
# communicating through special files created in the filesystem.  This
# is very attractive because then you can do away with the port number

# business, but unfortunately AF_UNIX sockets only work on the same 
# machine.  SOCK_STREAM sockets communicate using streams of
characters.
# Another possibility is unreliable datagram communication using 
# SOCK_DGRAM. Just stick with the parameters used here unless you 
# know what you're doing.

# In case you're wondering, the AF_INET and SOCK_STREAM symbols are
# provided by the 'use Socket;' statement at the top of the file. 
# You do NOT want to put $'s in front of these symbols.  

# The 'die' causes execution to terminate with an error message (
which is
# stored in $_) if the 'socket' call fails.   $! is a string
describing
# the latest system error message.

socket(S,AF_INET,SOCK_STREAM,$proto) || die "socket : $!";

# The 'bind' hooks your phone to the port number that was specified.
# Think of all the ports as a telephone switchboard.  'bind' requires
its
# parameters to be in a C structure format.  'pack' smooshes things
# together into a form that 'bind' can stomach.  The $sockaddr thing
below
# says "An unsigned short, followed by a short in 'network order',
# followed by a null-padded 4 character string, followed by 8 null
# bytes."  It's magic.  Don't worry too much about it.

$sockaddr = 'S n a4 x8';
$this = pack($sockaddr, AF_INET, $port, "\0\0\0\0");
bind(S, $this) || die "bind : $!";

# This says "I want 10-way call-waiting."  Basically, that you want
# requests to talk to you queued up to a depth of 10.

listen(S, 10) || die "listen: $!";

# Select S temporarily as the default output channel, turn on
automatic
# flushing, then select standard output again.

select(S);
$| = 1;
select(STDOUT);

$con = 0;

# Server runs forever, accepting connections from clients

while (1) {
    
    # initialize select bit vectors
    $rin = $win = $ein = '';         
    
    # If this socket is ready, we have a new connection
    vec($rin, fileno(S), 1) = 1;    
    
    # ...also want to snoop on existing connections.  The check for 
    # null string is done because we forget about connections by
    # zapping the file handle.
    foreach (@sockets) {
        if ($_ ne "") {
            vec($rin, fileno($_), 1) = 1;
        }
    }
    
    # Wait for some action... the 'select' call will block until one
of
    # of the sockets whose bit we set above becomes available for
reading.
    # A new connection also falls into this category.  The undef's are
here
    # because we don't care about the output, exceptional conditions,
and
    # timeout capabilities of 'select' in this simple example.

    print "Waiting...\n";
    ($numready, $timeleft) =  select($rout=$rin, undef, undef, undef);
    print "Someone's knocking!!\n";

    # Is it a new connection?  New connections will cause activity on
S

    if (vec($rout, fileno(S), 1)) {
        # Someone new is ringing...
        print "New connection.\n";
        # Make a new file handle (yuck).  "." concats strings.
        $con++;
        $sockets[$con - 1] = "NS".$con;
        
        # 'accept' blocks until it notices that an incoming connection
on
        # socket S.  When this occurs, the incoming connection is
        # actually attached to the socket NSn rather than S, thus
leaving
        # S free for other incoming connections.
        # The value that's returned (in $addr) gives some information
        # about the address of the caller.

        ($addr = accept($sockets[$con - 1], S)) || die $!;
    
        select($sockets[$con - 1]);
        $|=1;
        select(STDOUT);
        
        # unpack the information returned by 'accept' to get some
        # (readable) information about the client we're serving and
        # print it to standard output

        ($af,$port, $inetaddr) = unpack($sockaddr, $addr);
        @inetaddr = unpack('C4', $inetaddr);

        # tell the other clients who just connected
#        foreach (@sockets) {
#            if ($_ ne "") {
#                print $_ 
#                    "Got connection $con @ Internet address
@inetaddr\n";
#            }
#        }
    }

    else {
        # An existing connection is trying to talk to us...
        # just display whatever each waiting client sends
        # and then echo the data back to the client.  If we receive a
        # null length message from a client, wipe out the file handle
        # so we don't communicate with that client again.
        $sockcount = 0;
        foreach (@sockets) {
            $sockcount++;
            $thesocket = $_;
            if (vec($rout, fileno($thesocket), 1)){
                # note that data is read with the function 'readline'
                # instead of using <$thesocket>; <>-type reading uses
                # the buffered I/O library and select doesn't like
this
                # at all!
                $result = &readline($thesocket);
                if (! length($result)) {
                    # 0 length message means "goodbye"
                    print "Bye to client on socket $thesocket.\n";
                    close($thesocket);
                    $sockets[$sockcount-1] = "";
                }
                else {
                        $result =~ s/\n$//g;
                    print "Received from client $sockcount:
$result\n";


#######################################################################
#MAIN CODE HERE
#######################################################################
### Variable Delclarations ###
$issuesdir = "/var/www/htdocs/njmag/issues/";
$supportemail = "<a herf=\"mailto:jbowman\@nationaljournal.com\">jbowman\@nationaljournal.com</a>";



$destination = "";
$issue = "";
$publication = "";
$pagenumber = "";
$department = "";
$headline = "";
$deckhard = "";
$byline = "";
$storytext = "";
$story = "";
$storyposition = "";

$destinationsend = "";
$issuesend = "";
$publicationsend = "";
$pagenumbersend = "";
$departmentsend = "";
$headlinesend = "";
$deckhardsend = "";
$bylinesend = "";
$storytextsend = "";
$storysend = "";
$storypositionsend = "";

$publication = "";
$pagenumber = "";
$department = "";
$headline = "";
$deckhard = "";
$byline = "";
$storytext = "";
$storytextsend = "";
$story = "";
$storyposition = "";
$publication = "";
$date = "";
$department = "";
$headline = "";
$deckhard = "";
$byline = "";
$selectedstory = "";
$selectedissue = "";
$update = "";

## Grab what the client sent us and break it down into usable
variables.
    @sfields = split(/&/, $result);
    foreach $field (@sfields) {
        $eq = index($field, "=");
        if ( substr($field, 0, $eq) eq "destination" ) {
             $destination = substr($field, $eq+1);
        } elsif ( substr($field, 0, $eq) eq "issue" ) {
             $issue = substr($field, $eq+1);
        } elsif ( substr($field, 0, $eq) eq "publication" ) {
             $publication = substr($field, $eq+1);
        } elsif ( substr($field, 0, $eq) eq "pagenumber" ) {
             $pagenumber = substr($field, $eq+1);
        } elsif ( substr($field, 0, $eq) eq "department" ) {
             $department = substr($field, $eq+1);
        } elsif ( substr($field, 0, $eq) eq "headline" ) {
             $headline = substr($field, $eq+1);
        } elsif ( substr($field, 0, $eq) eq "deckhard" ) {
             $deckhard = substr($field, $eq+1);
        } elsif ( substr($field, 0, $eq) eq "byline" ) {
             $byline = substr($field, $eq+1);
        } elsif ( substr($field, 0, $eq) eq "storytext" ) {
             $storytext = substr($field, $eq+1);
        } elsif ( substr($field, 0, $eq) eq "story" ) {
             $story = substr($field, $eq+1);
        } elsif ( substr($field, 0, $eq) eq "storyposition" ) {
             $storyposition = substr($field, $eq+1);
        } elsif ( substr($field, 0, $eq) eq "update" ) {
             $update = substr($field, $eq+1); 
        } elsif ( substr($field, 0, $eq) eq "selectedstory" ) {
             $selectedstory = substr($field, $eq+1); 
        }
    }

## $pagenumber is used to create a file. Let's make sure no .'s and
/'s are allowed in the filename. $issue and $story are used in moving
around directories, so lets keep them from starting with . or / also.

$pagenumber =~ s/\.//g;
$pagenumber =~ s/\///g;

$issue =~ s/^\///g;
$issue =~ s/^\.\.//g;
$issue =~ s/^\.//g;

$story =~ s/^\///g;
$story =~ s/^\.\.//g;
$story =~ s/^\.//g;


print "Story = $story\n";
print "Issue = $issue\n";
## Department tag should be all uppercase.

$department = uc($department);
 
### Main body of CGI ###
if ( $destination eq "viewissue") { &viewissue; }
elsif ( $destination eq "newissue") { &newissue; }
elsif ( $destination eq "deleteissue") { &deleteissue; }
elsif ( $destination eq "mergeissue") { &mergeissue; }
elsif ( $destination eq "makenewissue") { &makenewissue; }
elsif ( $destination eq "newstory") { &newstory; }
elsif ( $destination eq "makenewstory") { &makenewstory; }
elsif ( $destination eq "viewstory") { &viewstory; }
elsif ( $destination eq "editstory") { &editstory; }
elsif ( $destination eq "addtostory") { &addtostory; }
elsif ( $destination eq "updatestory") { &updatestory; }
elsif ( $destination eq "deletestory") { &deletestory; }
elsif ( $destination eq "deleteyesno") { &deleteyesno; }
elsif ( $destination eq "viewstorydir") { &viewstorydir; }
elsif ( $destination eq "insert") { &insert; }
else { &showindex; } 


#######################################################################



                }
            }
        }
    }
}


# Display the main issues directory.

sub showindex {

print "SHOWINDEX\n";
opendir ISSUES, "$issuesdir";
@issues = grep !/^\.\.?$/, readdir ISSUES;
closedir ISSUES;
$issuesend = "";
foreach $issue (@issues)
        {
        &encode;
        $issuesend = "$issuesend$issue;";
        }

opendir STORIES, "$issuesdir$issues[0]";
print "issues[0] = $issues[0]\n";
@stories = grep !/^\.\.?$/, readdir STORIES;
sub numerically { $a <=> $b; }
@sortedstories = sort numerically @stories;
closedir STORIES;
$storysend = "";
foreach $story (@sortedstories)
        {
        #print "story is $story";
        if (-d "$issuesdir$issues[0]/$story")
                {
                opendir STORIESDIR, "$issuesdir$issues[0]/$story";
                @storiesdir = grep !/^\.\.?$/, readdir STORIESDIR;
                sub numerically { $a <=> $b; }
                @sortedstoriesdir = sort numerically @storiesdir;
                closedir STORIESDIR;
                foreach $stor (@sortedstoriesdir)
                        {
                        $storysend = "$storysend$story\/$stor;";
                        } 
                }
        else
                {
                &encode;
                $storysend = "$storysend$story;";
                }
        }

&output;
} 


sub viewissue {

if ($issue eq "\.\.")
        {
        &showindex;
        }
else
{
opendir STORIES, "$issuesdir$issue";
print "error = $! $issuesdir$issue\n";
@stories = grep !/^\.\.?$/, readdir STORIES;
sub numerically { $a <=> $b; }
@sortedstories = sort numerically @stories;
closedir STORIES;
$storysend = "";
foreach $story (@sortedstories)
        {
        print "story is $story\n";
        if (-d "$issuesdir$issue/$story")
                {
                opendir STORIESDIR, "$issuesdir$issue/$story";
                @storiesdir = grep !/^\.\.?$/, readdir STORIESDIR;
                sub numerically { $a <=> $b; }
                @sortedstoriesdir = sort numerically @storiesdir;
                closedir STORIESDIR;
                foreach $stor (@sortedstoriesdir)
                        {
                        $storysend = "$storysend$story\/$stor;";
                        }
                }
        else
                {
                &encode;
                $storysend = "$storysend$story;";
                }
        }
&output;
}
}



sub viewstory {
$storysend = "";
$storytextsend = "";
print "VIEWSTORY\n";
if (-d "$issuesdir$issue/$story")
        {
        $subdir = "";
        &viewstorydir;
        }
        else
        {
        $subdir = "1";
        open (VIEWSTORY, "$issuesdir$issue/$story");
        print "error = $!\n";
        $count = 0;
        while (read VIEWSTORY, $BUFFER, 16384)
                {
                @done[$count] = $BUFFER;
                $count++;
                }
        $storytextsend = "";
        foreach $printout (@done)
                {
                $printout =~ s/\n/¥¥¥/g;
                $storytextsend = "$storytextsend$printout";
                &encode;
               }
close VIEWSTORY;
        &output;
        }
}

sub viewstorydir {
opendir STORIES, "$issuesdir$issue/$story";
@stories = grep !/^\.\.?$/, readdir STORIES;
sub numerically { $a <=> $b; }
@sortedstories = sort numerically @stories;
closedir STORIES;
$storysend = "";
foreach $stor (@sortedstories)
        {
        &encode; 
        $storysend = "$storysend$stor;";
        }
$issuesend = "$issue";
&output;
}


sub editstory {
open (EDITSTORY, "$issuesdir$issue/$story");
$storytag = <EDITSTORY>;
$publication = <EDITSTORY>;
$date = <EDITSTORY>;
$department = <EDITSTORY>;
$headline = <EDITSTORY>;
$deckhard = <EDITSTORY>;
$byline = <EDITSTORY>;
$count = 0;
while (read EDITSTORY, $BUFFER, 16384)
        {
        @storytextbuf[$count] = $BUFFER;
        $count++;
        }
foreach $storytex (@storytextbuf)
        {
        $njstorytext = "$storytext" . "$storytex";
        }
close EDITSTORY;

@pagenumberstring = split (/\./, $story);
$pagenumber = $pagenumberstring[0]; 

$story =~ s/\.xml//g;


 
$publication =~ s/\<publication\>//g;
$publication =~ s/\<[\/]publication\>//g;
$date =~ s/\<date\>//g;
$date =~ s/\<[\/]date\>//;
$department =~ s/\<story-department\>//g;
$department =~ s/\<[\/]story-department\>//g;
$headline =~ s/\<story-hed\>//g;
$headline =~ s/\<[\/]story-hed\>//g;
$deckhard =~ s/\<story-deck\>//g;
$deckhard =~ s/\<[\/]story-deck\>//g;
$byline =~ s/\<story-byline\>//g;
$byline =~ s/\<[\/]story-byline\>//g;
$njstorytext =~ s/\n\<para\>/\n/g;
$njstorytext =~ s/\<story\>  \n//g;
$njstorytext =~ s/\<story-content\> \n//g;
$njstorytext =~ s/\<story-content\>\n//g;
$njstorytext =~ s/\<[\/]story-content\>\n//g;
$njstorytext =~ s/\<[\/]story\>  \n//g;
$njstorytext =~ s/\<[\/]story\>\n//g;

&encode;
&output;
}


sub makenewstory {

if (-e "$issuesdir$issue/$pagenumber.xml")
        {
        &fileexists;
        }
else
{
open (NEWSTORY, ">$issuesdir$issue/$pagenumber.xml");

$storytext =~ s/\n/\<para\>/g;
$storytext =~ s/\r\n/\n/g;

# This is the actual creation of the story #
 
print NEWSTORY <<"EOF";
<story>
<publication>$publication</publication>
<date>$issue</date>
<story-department>$department</story-department>
<story-hed>$headline</story-hed>
<story-deck>$deckhard</story-deck>
<story-byline>$byline</story-byline>
<story-content>
$storytext
</story-content>
</story>
EOF
 
close NEWSTORY;

open (DISPLAY, "$issuesdir$issue/$pagenumber.xml");
$count = 0;
while (read DISPLAY, $BUFFER, 16384)
        {
        @done[$count] = $BUFFER;
        $count++;
        }
$storytextsend = ""; 
foreach $printout (@done) 
        {
#        $printout =~ s/([^\w\s])/sprintf ("&#%d;", ord ($1))/ge;
        $printout =~ s/\n/¥¥¥/g;
        $storytextsend = "$storytextsend$printout";
        }
close DISPLAY;


$selectedstory = "$pagenumber.xml";

opendir STORIES, "$issuesdir$issue";
print "error = $! $issuesdir$issue\n";
@stories = grep !/^\.\.?$/, readdir STORIES;
sub numerically { $a <=> $b; }
@sortedstories = sort numerically @stories;
closedir STORIES;
$storysend = "";
foreach $story (@sortedstories)
        {
        print "story is $story\n";
        if (-d "$issuesdir$issue/$story")
                {
                opendir STORIESDIR, "$issuesdir$issue/$story";
                @storiesdir = grep !/^\.\.?$/, readdir STORIESDIR;
                sub numerically { $a <=> $b; }
                @sortedstoriesdir = sort numerically @storiesdir;
                closedir STORIESDIR;
                foreach $stor (@sortedstoriesdir)
                        {
                        $storysend = "$storysend$story\/$stor;";
                        }
                }
        else
                {
                &encode;
                $storysend = "$storysend$story;";
                }
        }




&encode;
&output;

}
}



sub fileexists {

if ($update eq "yes")
{
        &updatestory;
}
else
{

if (-d "$issuesdir$issue/$pagenumber.xml")
        {
        print "$issuesdir$issue/$pagenumber.xml";
        opendir STORY, "$issuesdir$issue/$pagenumber.xml";
        @stories = grep !/^\.\.?$/, readdir STORY;
        $count = 0;
        foreach $stor (@stories)
                {
                print
"$issuesdir$issue/$pagenumber.xml/$pagenumber.xml.$count<br>";
                $count++;
                }
        open NEWFILE,
">$issuesdir$issue/$pagenumber.xml/$pagenumber.xml.$count";
        print NEWFILE <<"EOF";
<story>
<publication>$publication</publication>
<date>$issue</date>
<story-department>$department</story-department>
<story-hed>$headline</story-hed>
<story-deck>$deckhard</story-deck>
<story-byline>$byline</story-byline>
<story-content>
$storytext
</story-content>
</story>
EOF
        close NEWFILE;

        open (DISPLAY,
"$issuesdir$issue/$pagenumber.xml/$pagenumber.xml.$count");
$selectedstory = "$pagenumber.xml/$pagenumber.xml.$count";
        $count = 0;
        while (read DISPLAY, $BUFFER, 16384)
                {
                @done[$count] = $BUFFER;
                $count++;
                }
        $storytextsend = "";
        foreach $printout (@done)
         {
#                $printout =~ s/([^\w\s])/sprintf ("&#%d;", ord
($1))/ge;
                  $printout =~ s/\n/¥¥¥/g;
                $storytextsend = "$storytextsend$printout";
                }
        close DISPLAY;    
}


elsif  (-f "$issuesdir$issue/$pagenumber.xml")
        {
        open MEMFILE, "$issuesdir$issue/$pagenumber.xml";
        $count = 0;
        while (read MEMFILE, $BUFFER, 16384)
                {
                @memstory[$count] = $BUFFER;
                }
        close MEMFILE;
        unlink "$issuesdir$issue/$pagenumber.xml";
        mkdir ("$issuesdir$issue/$pagenumber.xml", 0700);
        open NEWFILE,
">$issuesdir$issue/$pagenumber.xml/$pagenumber.xml.0";
        foreach $BUFFER (@memstory)
                {
                print NEWFILE "$BUFFER";
                }
        close NEWFILE;
        open NEWFILE2,
">$issuesdir$issue/$pagenumber.xml/$pagenumber.xml.1";
        print NEWFILE2 <<"EOF";
<story>
<publication>$publication</publication>
<date>$issue</date>
<story-department>$department</story-department>
<story-hed>$headline</story-hed>
<story-deck>$deckhard</story-deck>
<story-byline>$byline</story-byline>
<story-content>
$storytext
</story-content>
</story>
EOF
        close NEWFILE2;
        open (DISPLAY,
"$issuesdir$issue/$pagenumber.xml/$pagenumber.xml.1");
        $count = 0;
        while (read DISPLAY, $BUFFER, 16384)
                {
                @done[$count] = $BUFFER;
                $count++;
                }
        $storytextsend = "";
        foreach $printout (@done)
         {
#                $printout =~ s/([^\w\s])/sprintf ("&#%d;", ord
($1))/ge;
                  $printout =~ s/\n/¥¥¥/g;
                $storytextsend = "$storytextsend$printout";
                }
        close DISPLAY;
$selectedstory = "$pagenumber.xml/$pagenumber.xml.1";
}

 
opendir STORIES, "$issuesdir$issue";
print "error = $! $issuesdir$issue\n";
@stories = grep !/^\.\.?$/, readdir STORIES;
sub numerically { $a <=> $b; }
@sortedstories = sort numerically @stories;
closedir STORIES;
$storysend = "";
foreach $story (@sortedstories)
        {
        print "story is $story\n";
        if (-d "$issuesdir$issue/$story")
                {
                opendir STORIESDIR, "$issuesdir$issue/$story";
                @storiesdir = grep !/^\.\.?$/, readdir STORIESDIR;
                sub numerically { $a <=> $b; }
                @sortedstoriesdir = sort numerically @storiesdir;
                closedir STORIESDIR;
                foreach $stor (@sortedstoriesdir)
                        {
                        $storysend = "$storysend$story\/$stor;";
                        }
                }
        else
                {
                &encode;
                $storysend = "$storysend$story;";
                }
        }
&encode;
&output;
}
}


sub updatestory
{

unlink "$issuesdir$issue/$selectedstory";

open (NEWSTORY, ">$issuesdir$issue/$selectedstory");
 
$storytext =~ s/\n/\<para\>/g;
$storytext =~ s/\r\n/\n/g;
 
# This is the actual creation of the story #
 
print NEWSTORY <<"EOF";
<story>
<publication>$publication</publication>
<date>$issue</date>
<story-department>$department</story-department>
<story-hed>$headline</story-hed>
<story-deck>$deckhard</story-deck>
<story-byline>$byline</story-byline>
<story-content>
$storytext
</story-content>
</story>
EOF
 
close NEWSTORY; 

open (DISPLAY, "$issuesdir$issue/$selectedstory");
$count = 0;
while (read DISPLAY, $BUFFER, 16384)
        {
        @done[$count] = $BUFFER;
        $count++;
        }
$storytextsend = "";
foreach $printout (@done)
        {
#        $printout =~ s/([^\w\s])/sprintf ("&#%d;", ord ($1))/ge;
         $printout =~ s/\n/¥¥¥/g;
        $storytextsend = "$storytextsend$printout";
        }
close DISPLAY;  

$selectedstory = "$selectedstory";
 
opendir STORIES, "$issuesdir$issue";
print "error = $! $issuesdir$issue\n";
@stories = grep !/^\.\.?$/, readdir STORIES;
sub numerically { $a <=> $b; }
@sortedstories = sort numerically @stories;
closedir STORIES;
$storysend = "";
foreach $story (@sortedstories)
        {
        print "story is $story\n";
        if (-d "$issuesdir$issue/$story")
                {
                opendir STORIESDIR, "$issuesdir$issue/$story";
                @storiesdir = grep !/^\.\.?$/, readdir STORIESDIR;
                sub numerically { $a <=> $b; }
                @sortedstoriesdir = sort numerically @storiesdir;
                closedir STORIESDIR;
                foreach $stor (@sortedstoriesdir)
                        {
                        $storysend = "$storysend$story\/$stor;";
                        }
                }
        else
                {
                &encode;
                $storysend = "$storysend$story;";
                }
        }
 
 
 
 
&encode;
&output;

}



sub makenewissue
{


$selectedissue = $issue;

$newiss = "$issuesdir$issue";
mkdir $newiss, 0700;   

opendir ISSUES, "$issuesdir";
@issues = grep !/^\.\.?$/, readdir ISSUES;
closedir ISSUES;
$issuesend = "";
foreach $issue (@issues)
        {
        &encode;
        $issuesend = "$issuesend$issue;";
        }
&encode;
&output;
}


sub mergeissue
{

opendir (MERGEDIR, "$issuesdir$issue");
@mergefiles = grep !/^\.\.?$/, readdir MERGEDIR;
closedir MERGEDIR;


sub numerically { $a <=> $b; }
@sortedmergefiles = sort numerically @mergefiles;

$storytextsend = "\<complete-doc\>\n";

foreach $mergefile (@sortedmergefiles)
        {
        if (-d "$issuesdir$issue/$mergefile")
                {
                opendir (MERGESTORYDIR,
"$issuesdir$issue/$mergefile");
                @mergestories =  grep !/^\.\.?$/, readdir
MERGESTORYDIR;
                closedir MERGESTORYDIR;
                foreach $mergestory (@mergestories)
                        {
                        open (MERGESTORY,
"$issuesdir$issue/$mergefile/$mergestory");
                        while (read MERGESTORY, $BUFFER, 16384)
                                {
#                                $BUFFER =~ s/([^\w\s])/sprintf
("&#%d;", ord ($1))/ge;
#                                $BUFFER =~ s/\n//g;
                                $storytextsend =
"$storytextsend$BUFFER";
                                }
                        close MERGESTORY;
                        }
 
                }
        else
                {
                open MERGEFILE, "$issuesdir$issue/$mergefile";
                while (read MERGEFILE, $BUFFER, 16384)
                        {
#                        $BUFFER =~ s/([^\w\s])/sprintf ("&#%d;", ord
($1))/ge;
#                        $BUFFER =~ s/\n/\<br\>/g;
                        $storytextsend = "$storytextsend$BUFFER";
                        }
                close MERGEFILE;
                }
        }
$storytextsend = "$storytextsend\n\<\/complete-doc\>";

&encode;
&output;

}



## Encode content for output to client.

sub encode {
$destination =~ s/=/¼½½ /g;
$issue =~ s/=/¼½½ /g;
$publication =~ s/=/¼½½ /g;
$pagenumber =~ s/=/¼½½ /g;
$department =~ s/=/¼½½ /g;
$headline =~ s/=/¼½½ /g;
$deckhard =~ s/=/¼½½ /g;
$byline =~ s/=/¼½½ /g;
$storytext =~ s/=/¼½½ /g;
$njstorytext =~ s/=/¼½½ /g;
$storytextsend =~ s/=/¼½½ /g;
$story =~ s/=/¼½½ /g;
$storyposition =~ s/=/¼½½ /g;
$publication =~ s/=/¼½½ /g;
$date =~ s/=/¼½½ /g;
$department =~ s/=/¼½½ /g;
$headline =~ s/=/¼½½ /g;
$deckhard =~ s/=/¼½½ /g;
$byline =~ s/=/¼½½ /g;
$selectedstory =~ s/=/¼½½ /g;
$selectedissue =~ s/=/¼½½ /g;

$destination =~ s/&/½¼½ /g;
$issue =~ s/&/½¼½ /g;
$publication =~ s/&/½¼½ /g;
$pagenumber =~ s/&/½¼½ /g;
$department =~ s/&/½¼½ /g;
$headline =~ s/&/½¼½ /g;
$deckhard =~ s/&/½¼½ /g;
$byline =~ s/&/½¼½ /g;
$storytext =~ s/&/½¼½ /g;
$njstorytext =~ s/&/½¼½ /g;
$storytextsend =~ s/&/½¼½ /g;
$story =~ s/&/½¼½ /g;
$storyposition =~ s/&/½¼½ /g;
$publication =~ s/&/½¼½ /g;
$date =~ s/&/½¼½ /g;
$department =~ s/&/½¼½ /g;
$headline =~ s/&/½¼½ /g;
$deckhard =~ s/&/½¼½ /g;
$byline =~ s/&/½¼½ /g;
$selectedstory =~ s/&/½¼½ /g;
$selectedissue =~ s/&/½¼½ /g;


$destination =~ s/;/½½¼ /g;
$issue =~ s/;/½½¼ /g;
$publication =~ s/;/½½¼ /g;
$pagenumber =~ s/;/½½¼ /g;
$department =~ s/;/½½¼ /g;
$headline =~ s/;/½½¼ /g;
$deckhard =~ s/;/½½¼ /g;
$byline =~ s/;/½½¼ /g;
$storytext =~ s/;/½½¼ /g;
$njstorytext =~ s/;/½½¼ /g;
$storytextsend =~ s/;/½½¼ /g;
$story =~ s/;/½½¼ /g;
$storyposition =~ s/;/½½¼ /g;
$publication =~ s/;/½½¼ /g;
$date =~ s/;/½½¼ /g;
$department =~ s/;/½½¼ /g;
$headline =~ s/;/½½¼ /g;
$deckhard =~ s/;/½½¼ /g;
$byline =~ s/;/½½¼ /g;
$selectedstory =~ s/;/½½¼ /g;
$selectedissue =~ s/;/½½¼ /g;


$destination =~ s/\n/¥¥¥/g; 
$issue =~ s/\n/¥¥¥/g; 
$publication =~ s/\n/¥¥¥/g; 
$pagenumber =~ s/\n/¥¥¥/g; 
$department =~ s/\n/¥¥¥/g; 
$headline =~ s/\n/¥¥¥/g; 
$deckhard =~ s/\n/¥¥¥/g; 
$byline =~ s/\n/¥¥¥/g; 
$storytext =~ s/\n/¥¥¥/g; 
$njstorytext =~ s/\n/¥¥¥/g; 
$storytextsend =~ s/\n/¥¥¥/g; 
$story =~ s/\n/¥¥¥/g; 
$storyposition =~ s/\n/¥¥¥/g; 
$publication =~ s/\n/¥¥¥/g; 
$date =~ s/\n/¥¥¥/g; 
$department =~ s/\n/¥¥¥/g; 
$headline =~ s/\n/¥¥¥/g; 
$deckhard =~ s/\n/¥¥¥/g; 
$byline =~ s/\n/¥¥¥/g; 
$selectedstory =~ s/\n/¥¥¥/g; 
$selectedissue =~ s/\n/¥¥¥/g; 
}

## Send output to client, and disconnect.

sub output {
my $output;

if ($destinationsend)
        {
        $output = "$output&destination=$desinationsend";
        }
if ($selectedstory)
        {
        $output = "$output&selectedstory=$selectedstory";
        }
if ($selectedissue)
        {
        $output = "$output&selectedissue=$selectedissue";
        }   
if ($issuesend)
        {
        $output = "$output&issue=$issuesend";
        }                                                             
                      if ($publicationsend)
        {
        $output = "$output&publication=$publicationsend";
        }                                                             
                      if ($pagenumbersend)
        {
        $output = "$output&pagenumber=$pagenumbersend";
        }                                                             
                      if ($departmentsend)
        {
        $output = "$output&department=$departmentsend";
        }                                                             
                      if ($headlinesend)
        {
        $output = "$output&headline=$headlinesend";
        }                                                             
                      if ($deckhardsend)
        {
        $output = "$output&deckhard=$deckhardsend";
        }                                                             
                      if ($bylinesend)
        {
        $output = "$output&byline=$bylinesend";
        }
if ($storytextsend)
        {
        $output = "$output&storytext=$storytextsend";
        }
if ($storysend)
        {
        $output = "$output&story=$storysend";
        }
if ($storypositionsend)
        {
        $output = "$output&storyposition=$storypositionsend";
        }
#if ($subdir)
#        {
#        $output = "$output&subdir=$subdir";
#        }
if ($publication)
        {
        $output = "$output&publication=$publication";
        }
if ($date)
        {
        $output = "$output&date=$date";
        }
if ($pagenumber)
        {
        $output = "$output&pagenumber=$pagenumber";
        }
if ($department)
        {
        $output = "$output&department=$department";
        }
if ($headline)
        {
        $output = "$output&headline=$headline";
        }
if ($deckhard)
        {
        $output = "$output&deckhard=$deckhard";
        }
if ($byline)
        {
        $output = "$output&byline=$byline";
        }
if ($njstorytext)
        {
        $output = "$output&njstorytext=$njstorytext";
        }

#$output = "destination=$destinationsend&issue=$issuesend&publication=$publicationsend&pagenumber=$pagenumbersend&department=$departmentsend&headline=$headlinesend&deckhard=$deckhardsend&byline=$bylinesend&storytext=$storytextsend&story=$story&storyposition=$storyposition\r\n\n";
$output = "$output&\n";
$output =~ s/^&//g;
$output =~ s/;$//g;
$output =~ s/;&/&/g;
syswrite $thesocket, "$output";
print "destination = $destination\n";
print "Output = $output";
$destination = "";
$issue = "";
$publication = "";
$pagenumber = "";
$department = "";
$headline = "";
$deckhard = "";
$byline = "";
$storytext = "";
$story = "";
$storyposition = "";
 
$destinationsend = "";
$issuesend = "";
$publicationsend = "";
$pagenumbersend = "";
$departmentsend = "";
$headlinesend = "";
$deckhardsend = "";
$bylinesend = "";
$storytextsend = "";
$storysend = "";
$storypositionsend = "";

$publication = "";
$pagenumber = "";
$department = "";
$headline = "";
$deckhard = "";
$byline = "";
$storytext = "";
$storytextsend = "";
$story = "";
$storyposition = "";
$publication = "";
$date = "";
$department = "";
$headline = "";
$deckhard = "";
$byline = "";
$selectedstory = "";
$selectedissue = "";
$update = "";    
close($thesocket);
}


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

Date: Tue, 05 Jun 2001 17:44:38 +0100
From: =?iso-8859-1?Q?Thorbj=F8rn?= Ravn Andersen <thunderbear@bigfoot.com>
Subject: Re: perl/cgi and dynamic hyperlink
Message-Id: <3B1D0C76.9684043A@bigfoot.com>

"Godzilla!" wrote:


> > > You are surprised I have an attitude in view of all the
> > > crass remarks, insults and such directed at me, daily,
> > > by regulars here.
> 
> > Since you stay, you must like it?
> 
> There is a sufficient number of blithering idiots,
> such as yourself, running loose within this group
> engaging in antidotal idiocy to provide a bit of
> comical relief for an intellect such as I.

Oh, yes.  It is called "responding to Godzilla".

How do you feel about your current successrate regarding being mentioned
in peoples kill-files?

-- 
  Thorbjørn Ravn Andersen                "...plus...Tubular Bells!"
  http://bigfoot.com/~thunderbear


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

Date: 05 Jun 2001 13:19:46 -0400
From: Joe Schaefer <joe+usenet@sunstarsys.com>
Subject: Re: perl/cgi and dynamic hyperlink
Message-Id: <m3r8wyj13h.fsf@mumonkan.sunstarsys.com>

krakle@visto.com (krakle) writes in reference to buggs' comment:

>> "Newbies bitching is even worse than regulars bitching."
> 
> I come sporadicly to this NewsGroup. Newbie to perl? No, I been
> codingin Perl for a couple of years now. Newbie to this group? I dont
> care if you classify me under that particular categlory. I only rarely
> come here. I dont really have time to come here like Godzilla and post
> under every thread. I have what us normal people call a life. A real
> life.
  ^^^^

Yes, and as I understood things, this is exactly what buggs was 
referring to.

-- 
Joe Schaefer         "When angry, count to four; when very angry, swear."
                                               --Mark Twain



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

Date: Tue, 5 Jun 2001 10:17:45 -0400
From: tadmc@augustmail.com (Tad McClellan)
Subject: Re: Problem with STAT function
Message-Id: <slrn9hpqg9.2m8.tadmc@tadmc26.august.net>

chquek <chquek@yahoo.com> wrote:
>
>I noticed that this usually happens when the file exceeds 2Gb.


>Any idea or pointers ?


Upgrade to 5.6.1?

I note this in its perldelta.pod:

-------------------------------------------
=head2 Large file support

If you have filesystems that support "large files" (files larger than
2 gigabytes), you may now also be able to create and access them from
Perl.

    NOTE: The default action is to enable large file support, if
    available on the platform.

If the large file support is on, and you have a Fcntl constant
O_LARGEFILE, the O_LARGEFILE is automatically added to the flags
of sysopen().

Beware that unless your filesystem also supports "sparse files" seeking
to umpteen petabytes may be inadvisable.

Note that in addition to requiring a proper file system to do large
files you may also need to adjust your per-process (or your
per-system, or per-process-group, or per-user-group) maximum filesize
limits before running Perl scripts that try to handle large files,
especially if you intend to write such files.

Finally, in addition to your process/process group maximum filesize
limits, you may have quota limits on your filesystems that stop you
(your user id or your user group id) from using large files.

Adjusting your process/user/group/file system/operating system limits
is outside the scope of Perl core language.  For process limits, you
may try increasing the limits using your shell's limits/limit/ulimit
command before running Perl.  The BSD::Resource extension (not
included with the standard Perl distribution) may also be of use, it
offers the getrlimit/setrlimit interface that can be used to adjust
process resource usage limits, including the maximum filesize limit.
-------------------------------------------


-- 
    Tad McClellan                          SGML consulting
    tadmc@augustmail.com                   Perl programming
    Fort Worth, Texas


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

Date: Tue, 5 Jun 2001 16:56:01 +0000 (UTC)
From: abigail@foad.org (Abigail)
Subject: Re: Problem with STAT function
Message-Id: <slrn9hq3p1.5c3.abigail@tsathoggua.rlyeh.net>

chquek (chquek@yahoo.com) wrote on MMDCCCXXXV September MCMXCIII in
<URL:news:3B1CEDCD.2C9507E2@yahoo.com>:
//  Hi :
//  
//  I am trying to get the size of files in a directory.  I used the stat
//  function, and the 7th element is suppose to contain the size.

While using the 7th element of stat() is fine, it might be simpler
to use -s. Unless you need the other fields of stat too.

//  However, ocassionally, the stat function fails, returning a NULL list.
//  I noticed that this usually happens when the file exceeds 2Gb.  Ls -l ,
//  and 'more|less' is able to list the file and view it.
//  
//  It leads me to think that stat may be having a 32bit problem.  I am
//  running on AIX 64 bit.  I wonder if there is a 64bit version of stat.  I
//  have search CPAN and could not find anything.


You need a version of Perl with the appropriate 64bitness. You will have
to rebuild your Perl, giving the appropriate configure options. Read the
INSTALL file to see which configure options might work for your platform
compiler combination.



Abigail
-- 
srand 123456;$-=rand$_--=>@[[$-,$_]=@[[$_,$-]for(reverse+1..(@[=split
//=>"IGrACVGQ\x02GJCWVhP\x02PL\x02jNMP"));print+(map{$_^q^"^}@[),"\n"


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

Date: Tue, 5 Jun 2001 10:31:26 -0400
From: tadmc@augustmail.com (Tad McClellan)
Subject: Re: releasing array memory
Message-Id: <slrn9hpr9u.2m8.tadmc@tadmc26.august.net>

Michael Carman <mjcarman@home.com> wrote:

>You're getting lost in the semantics here. In Perl-speak, "local" means
>a localized copy of a global variable, via the local() keyword.
           

When teaching local() vs. my(), I find that it helps some people
if this distinction is pointed out:

   local() is NOT about a variable (a "name"). 

   It is about the _value_ of a variable.

   local() says "save the current value somewhere, restore it when
   the current scope ends".

So you don't really get a "copy of a global variable". You get a
copy of a global variable's value.


-- 
    Tad McClellan                          SGML consulting
    tadmc@augustmail.com                   Perl programming
    Fort Worth, Texas


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

Date: Tue, 5 Jun 2001 17:02:09 +0000 (UTC)
From: abigail@foad.org (Abigail)
Subject: Re: releasing array memory
Message-Id: <slrn9hq44h.5c3.abigail@tsathoggua.rlyeh.net>

Tad McClellan (tadmc@augustmail.com) wrote on MMDCCCXXXV September
MCMXCIII in <URL:news:slrn9hpr9u.2m8.tadmc@tadmc26.august.net>:
||  Michael Carman <mjcarman@home.com> wrote:
||  
|| >You're getting lost in the semantics here. In Perl-speak, "local" means
|| >a localized copy of a global variable, via the local() keyword.
||             
||  When teaching local() vs. my(), I find that it helps some people
||  if this distinction is pointed out:


For beginners, I like the white lie:

    local() is for punctuation variables, my() for regular variables.


Abigail
-- 
perl -wle'print"Êõóô áîïôèåò Ðåòì Èáãëåò"^"\x80"x24'


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

Date: 5 Jun 2001 09:20:40 -0700
From: kerrzer@hotmail.com (Ian)
Subject: viewing ceritficate information
Message-Id: <8b46dba4.0106050820.335f2630@posting.google.com>

Does anyone know if there is a module to get the information out of a
base64 encoded certificate string (like the issuer, valid from, etc.)
so that it can be displayed?

Thanks


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

Date: Tue, 05 Jun 2001 12:10:06 -0400
From: "Jason C. Hill" <jhill@technoslave.net>
Subject: What am I doing wrong with this array operation?
Message-Id: <9fj0av$bt@spamz.news.aol.com>

I have several lines of input that I push in to an array.

@arr = join(':', split( /\s+/, $lines));

Output looks something similiar to

operation:123456:123:.:.:.:33:33:33:1:.
operation2:23456:12:.:.:24:26:.:50:1:.:1
operation3:19472:12747:.:10:39:1:60:.:.:.:.
operation4:1237:13:29:31:20:.:.:.:.:10:10:.

Despite the above, they're all exact length entries...(I believe there
are 22 or 23 total).

Anyway, when I do a print "@arr"; it prints everything out in a nice line
by line, as above.

However, there's a possible entry in to the data that I need to account
for. Namely, the entry '.100'

So, I do this:

foreach my $item (@arr) {
	if ($item !~ /\.100/) {
		push (@temp, "$item");
	} else {
		push (@temp, ".");
		push (@temp, "100");
	}

@arr = @temp;

Then when I do a print "@arr"; it comes out with no newline like
above..So it would look something like this:

operation:123456:123:.:.:.:33:33:33:1:. operation2:23456:12:.:.:
24:26:.:50:1:.:1operation3:19472:12747:.:10:39:1:60:.:.:.:. operation4:
1237:13:29:31:20:.:.:.:.:10:10:.

Etc, no new line at the end.  I would guess it has something to do with
pushing the item to the new array.  But I'm not quite sure.  Doing a
print "@arr\n"; has no effect.

What is it that I'm doing wrong here?

Thanks,

		-Jason


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

Date: Tue, 05 Jun 2001 12:13:38 -0400
From: "Jason C. Hill" <jhill@technoslave.net>
Subject: Re: What am I doing wrong with this array operation?
Message-Id: <9fj0hi$c1@spamz.news.aol.com>

Substitue @newarr = @temp;

Don't want you thinking I'm trying to add on to an array I already have.
I'm not...I just typed it all to quickly.


> @arr = @temp;


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

Date: 05 Jun 2001 12:39:54 -0500
From: aperrin@telocity.com (Andrew J. Perrin)
Subject: Re: What am I doing wrong with this array operation?
Message-Id: <87vgma6d1x.fsf@nujoma.perrins>

"Jason C. Hill" <jhill@technoslave.net> writes:

> I have several lines of input that I push in to an array.
> 
> @arr = join(':', split( /\s+/, $lines));

I strongly suspect that your $lines is read in from a file (right?)
and therefore has the \n (newlines) still on the end of each
line. That's why you get the newlines in your output.

> [snip] 

> foreach my $item (@arr) {
> 	if ($item !~ /\.100/) {
> 		push (@temp, "$item");
> 	} else {
> 		push (@temp, ".");
> 		push (@temp, "100");
> 	}

I'm not entirely sure how you want it to look; if you want . and 100
to be on separate lines, try:

push(@temp, ".\n");
push(@temp, "100\n");

If you want them on the same line, try:

push(@temp, ".100\n");



-- 
---------------------------------------------------------------------
Andrew J Perrin - andrew_perrin@unc.edu - http://www.unc.edu/~aperrin
    Asst Professor of Sociology, U of North Carolina, Chapel Hill
From address is real but rarely checked; try andrew_perrin at unc.edu


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

Date: Tue, 05 Jun 2001 13:14:28 -0400
From: "Jason C. Hill" <jhill@technoslave.net>
Subject: Re: What am I doing wrong with this array operation?
Message-Id: <9fj43l$13e@spamz.news.aol.com>

I'm connecting to a port, using some IO::Socket:INET stuff.

Reading the input in, etc.  So, yes, I guess, originally it does have
newlines in it.

As to my input...most of the time it looks like this

get_headends                1     .    .  .  .100    .  .  .  
get_index                   3     .    .  .  . 33    .  . 33 33

Anyway, the program that creates these nice little useless figures is
called stag.  And even though the above output doesn't look like, due to
fonts (on my end at least), they're all equally spaced.

Anyway, it's preset spacing of 3 characters.  So, as you can see, if you
split based on spaces, as I'm doing, you can sometimes end up with the
entry .100

However, b/c it's such a nice little program, it can actually have
numbers that add up to higher than 100 (which is really a percentage).

Anyway, putting \n at the end of the push'd entry won't work, b/c it's
not known if that number is the last entry of the array.  And I don't
think reversing arrays and push'ing \n on to the end of them is really
what I want to do.

	-J



In article <87vgma6d1x.fsf@nujoma.perrins>, "Andrew J. Perrin"
<aperrin@telocity.com> wrote:

> "Jason C. Hill" <jhill@technoslave.net> writes:
> 
>> I have several lines of input that I push in to an array.
>> 
>> @arr = join(':', split( /\s+/, $lines));
> 
> I strongly suspect that your $lines is read in from a file (right?) and
> therefore has the \n (newlines) still on the end of each line. That's
> why you get the newlines in your output.
> 
>> [snip]
> 
>> foreach my $item (@arr) {
>> 	if ($item !~ /\.100/) {
>> 		push (@temp, "$item");
>> 	} else {
>> 		push (@temp, ".");
>> 		push (@temp, "100");
>> 	}
> 
> I'm not entirely sure how you want it to look; if you want . and 100 to
> be on separate lines, try:
> 
> push(@temp, ".\n");
> push(@temp, "100\n");
> 
> If you want them on the same line, try:
> 
> push(@temp, ".100\n");
> 
> 
>


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

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


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