[21824] in Perl-Users-Digest
Perl-Users Digest, Issue: 4028 Volume: 10
daemon@ATHENA.MIT.EDU (Perl-Users Digest)
Fri Oct 25 11:06:35 2002
Date: Fri, 25 Oct 2002 08:05:11 -0700 (PDT)
From: Perl-Users Digest <Perl-Users-Request@ruby.OCE.ORST.EDU>
To: Perl-Users@ruby.OCE.ORST.EDU (Perl-Users Digest)
Perl-Users Digest Fri, 25 Oct 2002 Volume: 10 Number: 4028
Today's topics:
Re: Help with code that cuts off text at first <br> (Tad McClellan)
Re: Help with code that cuts off text at first <br> (Jorge Grippo)
Re: Help with code that cuts off text at first <br> <phil.latio@f-in-stupid.co.uk>
Re: Help with code that cuts off text at first <br> (Rodney Engdahl)
Re: IO::Socket::INET and telnet <billy@arnis-bsl.com>
Re: IO::Socket::INET and telnet <jason@baugher.pike.il.us>
Re: IO::Socket::INET and telnet <jason@baugher.pike.il.us>
Re: IO::Socket::INET and telnet <billy@arnis-bsl.com>
Re: IO::Socket::INET and telnet <jason@baugher.pike.il.us>
Re: MD5 password encryption <cheechew@hotmail.com>
Re: MD5 password encryption (Tad McClellan)
Overloading and recursion; how to turn '""' overloading <heather710101@yahoo.com>
PoCo::IRC dcc chat example / code snipped / help ? <jeroen.van.wissen@twoop.com>
Re: pulling out text from between two strings (shambolic)
Re: pulling out text from between two strings (Tad McClellan)
Replacing string in binary file develop@gistenson.com
Re: Replacing string in binary file <jurgenex@hotmail.com>
Re: Replacing string in binary file <usenet@dwall.fastmail.fm>
Re: RMI Equivalent in Perl? <derek@wedgetail.com>
Re: Slow code, improvements requested <krahnj@acm.org>
Slow File Read and Regex <un1@bluewin.ch>
Re: Tk help, please. <josef.moellers@fujitsu-siemens.com>
Re: Tk help, please. <spikey-wan@bigfoot.com>
Re: Tk help, please. <josef.moellers@fujitsu-siemens.com>
Re: Tk help, please. <twhu@lucent.com>
Re: Trying to make a GUI. <simon.andrews@bbsrc.ac.uk>
unix socket (deita)
Re: unix socket news@roaima.freeserve.co.uk
Re: unix socket (Walter Roberson)
Re: Writing Microsoft Outlook Notes With Perl (Chris)
Digest Administrivia (Last modified: 6 Apr 01) (Perl-Users-Digest Admin)
----------------------------------------------------------------------
Date: Fri, 25 Oct 2002 07:06:08 -0500
From: tadmc@augustmail.com (Tad McClellan)
Subject: Re: Help with code that cuts off text at first <br>
Message-Id: <slrnarictg.30n.tadmc@magna.augustmail.com>
Phil Latio <phil.latio@f-in-stupid.co.uk> wrote:
> how do you change the below so
> instead of cutting text off at 100 characters, it cuts off at the first <br>
$newstext =~ s/<br>.*//is;
In other words, the same way _your code_ did it when you
posted last December.
Did you forget that you already know how to do this?
--
Tad McClellan SGML consulting
tadmc@augustmail.com Perl programming
Fort Worth, Texas
------------------------------
Date: 25 Oct 2002 06:09:33 -0700
From: jorge@grippo.com (Jorge Grippo)
Subject: Re: Help with code that cuts off text at first <br>
Message-Id: <ffb3ecd9.0210250509.2d26e71e@posting.google.com>
my $yourlength = 100;
my $SText = $Text;
if (length($SText) > $yourlength) {
# match first <br>
if ($SText =~ /^(.*?)<br>.*$/mi) {
$SText = $1 . '...';
} else {
$SText = substr($SText, 0, $yourlength) . '...';
# match last \s
if ($SText =~ /^(.+)\s(.+)$/) {
$SText = $1 . '...';
} else {
# warn "no <br> and no \\s in \$SText: \'$SText\'\n";
$SText .= '...';
}
}
}
$newshtml .= $SText;
Jorge Grippo
jorge@grippo.com
------------------------------
Date: Fri, 25 Oct 2002 14:06:58 GMT
From: "Phil Latio" <phil.latio@f-in-stupid.co.uk>
Subject: Re: Help with code that cuts off text at first <br>
Message-Id: <5ecu9.1448516$P95.143112@post-03.news.easynews.com>
"Tad McClellan" <tadmc@augustmail.com> wrote in message
news:slrnarictg.30n.tadmc@magna.augustmail.com...
> Phil Latio <phil.latio@f-in-stupid.co.uk> wrote:
>
> > how do you change the below so
> > instead of cutting text off at 100 characters, it cuts off at the first
<br>
>
>
> $newstext =~ s/<br>.*//is;
>
>
> In other words, the same way _your code_ did it when you
> posted last December.
>
> Did you forget that you already know how to do this?
No I didn't forget, I tried to use this line within a newer version of the
same news publishing script but could not get it working.
Must be a simple syntax error which I shall go back over tonight. I don't
like being beaten.
Cheers
Phil
------------------------------
Date: 25 Oct 2002 07:41:44 -0700
From: erehwon@vanaheim.com (Rodney Engdahl)
Subject: Re: Help with code that cuts off text at first <br>
Message-Id: <b1e27a0c.0210250641.528a1774@posting.google.com>
"Phil Latio" <phil.latio@f-in-stupid.co.uk> wrote in message news:<OB3u9.1432695$P95.142097@post-03.news.easynews.com>...
> Sorry for starting a second thread but how do you change the below so
> instead of cutting text off at 100 characters, it cuts off at the first <br>
> (line break).
>
Not sure what you want here, but why not try split (using
case-insensitive, of course)?
------------------------------
Date: Fri, 25 Oct 2002 11:25:29 +0300
From: Ilja Tabachnik <billy@arnis-bsl.com>
Subject: Re: IO::Socket::INET and telnet
Message-Id: <apav5e$s5qmb$1@ID-33095.news.dfncis.de>
Jason Baugher wrote:
> I've got the following simple code that I can't get to work:
>
> #!/usr/bin/perl -w
> use strict;
> use IO::Socket;
>
> my $request = IO::Socket::INET->new(
> PeerAddr => 'marianne',
> PeerPort => '23',
> Proto => 'tcp',
> Type => SOCK_STREAM,
> ) or die "$!";
>
> print while <$request>;
>
> Basically, when I run this script, I get nothing at all, and it never
> completes - which tells me the socket opened, just that it isn't reading
> the data I expect to see.
>
> Doing a normal telnet to this machine on port 23 works:
>
> $ telnet marianne 23
> Trying 10.10.10.4...
> Connected to marianne (10.10.10.4).
> Escape character is '^]'.
> Red Hat Linux release 7.3 (Valhalla)
> Kernel 2.4.18-3 on an i686
> login:
>
> Why don't I see the 3 "Red Hat .... login:" lines from the perl script?
>
IMHO, that's because the way the telnet protocol works.
Actually when a telnet client connects to a telnet server
they do some kind of initial option negotiation.
This is invisible to the telnet's user (I mean you don't see
the data exchanged between client and server on your screen).
When negotiation completes the 'login:' prompt will be
sent to client.
The option negotiation 'protocol' is not 'line-oriented',
so your "print while <$request>;" never returns just because
it waits for a complete line.
Try to replace
print while <$request>;
with
$|++;
my $buf;
print $buf while ($request->sysread($buf, 1) == 1);
I guess you'll see some garbage on the screen - these
are 'telnet options' the server is trying to negotiate
with you.
To solve this problem you could use Net::Telnet module
from CPAN which (as I guess) knows about option negotiation
(I never tried myself).
> When I alter it to use PeerPort => '25', it gives me the return string
> from the FTP server, like I expect it to.
>
I guess you mean SMTP server ;-)
Sure, SMTP just displays it's greeting when a client is connected.
HTH
Ilja.
------------------------------
Date: Fri, 25 Oct 2002 12:27:36 GMT
From: Jason Baugher <jason@baugher.pike.il.us>
Subject: Re: IO::Socket::INET and telnet
Message-Id: <Xns92B24BE2FB06Ejasonbaugherpikeilus@209.242.76.10>
Ilja Tabachnik <billy@arnis-bsl.com> wrote in comp.lang.perl.misc:
>> When I alter it to use PeerPort => '25', it gives me the return string
>> from the FTP server, like I expect it to.
>>
>
> I guess you mean SMTP server ;-)
> Sure, SMTP just displays it's greeting when a client is connected.
>
Sorry, I meant to type port 21, not 25. :)
Thanks for your help - I'll see what happens.
--
Jason Baugher
Virtual Adept Professional Consulting Services
1406 Adams Street, Quincy, IL 62301 - (217) 221-5406
jason@baugher.pike.il.us - http://baugher.pike.il.us/virtualadept
------------------------------
Date: Fri, 25 Oct 2002 12:33:33 GMT
From: Jason Baugher <jason@baugher.pike.il.us>
Subject: Re: IO::Socket::INET and telnet
Message-Id: <Xns92B24CE4F2BD1jasonbaugherpikeilus@209.242.76.10>
Ilja Tabachnik <billy@arnis-bsl.com> wrote in comp.lang.perl.misc:
>> $ telnet marianne 23
>> Trying 10.10.10.4...
>> Connected to marianne (10.10.10.4).
>> Escape character is '^]'.
>> Red Hat Linux release 7.3 (Valhalla)
>> Kernel 2.4.18-3 on an i686
>> login:
>>
>> Why don't I see the 3 "Red Hat .... login:" lines from the perl
>> script?
>>
>
> IMHO, that's because the way the telnet protocol works.
> Actually when a telnet client connects to a telnet server
> they do some kind of initial option negotiation.
> This is invisible to the telnet's user (I mean you don't see
> the data exchanged between client and server on your screen).
> When negotiation completes the 'login:' prompt will be
> sent to client.
> The option negotiation 'protocol' is not 'line-oriented',
> so your "print while <$request>;" never returns just because
> it waits for a complete line.
> Try to replace
> print while <$request>;
> with
> $|++;
> my $buf;
> print $buf while ($request->sysread($buf, 1) == 1);
>
> I guess you'll see some garbage on the screen - these
> are 'telnet options' the server is trying to negotiate
> with you.
>
Well, this does give me some output, but not what I want to see. Yes,
it shows me the garbage from the telnet negotiation, but what I want to
see is the actual login prompting that comes after that. It seems to me
that if I can see it with a regular telnet, then I should be able to
read from it with a socket.
Like you said above, "When negotiation completes the 'login:' prompt
will be sent to client." I see the negotiation, but never the 'login:'
prompt.
I'm open to any other ideas while I go dig through the Net::Telnet
module to see if I can either use it or see how it does this.
--
Jason Baugher
Virtual Adept Professional Consulting Services
1406 Adams Street, Quincy, IL 62301 - (217) 221-5406
jason@baugher.pike.il.us - http://baugher.pike.il.us/virtualadept
------------------------------
Date: Fri, 25 Oct 2002 16:37:44 +0300
From: Ilja Tabachnik <billy@arnis-bsl.com>
Subject: Re: IO::Socket::INET and telnet
Message-Id: <apbhev$3vqe$1@ID-33095.news.dfncis.de>
Jason Baugher wrote:
...skipped...
> Well, this does give me some output, but not what I want to see. Yes,
> it shows me the garbage from the telnet negotiation, but what I want to
> see is the actual login prompting that comes after that. It seems to me
> that if I can see it with a regular telnet, then I should be able to
> read from it with a socket.
>
> Like you said above, "When negotiation completes the 'login:' prompt
> will be sent to client." I see the negotiation, but never the 'login:'
> prompt.
>
The remote telnet server is waiting for you to complete
options negotiation (handshaking). When the handshaking
will be completed it will issue login prompt. However
since you don't know how to complete the handshaking
you'll get no login :-(
So basically you have options:
1. Just use Net::Telnet. Download it from CPAN, install and
you are set up in five minutes.
2. Get the copies of RFCs which describe the Telnet protocol
(too many to list them all here) and implement it yourself
on top of the IO::Socket. It will take much more time
than using Net::Telnet but once done you'll feel yourself
a Telnet expert ;-)
3. Use some external telnet client from your perl script.
Really I cannot find any reason which could stop you from
taking option (1) ;-)
Ilja.
------------------------------
Date: Fri, 25 Oct 2002 14:33:31 GMT
From: Jason Baugher <jason@baugher.pike.il.us>
Subject: Re: IO::Socket::INET and telnet
Message-Id: <Xns92B2613BCB6jasonbaugherpikeilus@209.242.76.10>
Ilja Tabachnik <billy@arnis-bsl.com> wrote in comp.lang.perl.misc:
> So basically you have options:
>
> 1. Just use Net::Telnet. Download it from CPAN, install and
> you are set up in five minutes.
> 2. Get the copies of RFCs which describe the Telnet protocol
> (too many to list them all here) and implement it yourself
> on top of the IO::Socket. It will take much more time
> than using Net::Telnet but once done you'll feel yourself
> a Telnet expert ;-)
> 3. Use some external telnet client from your perl script.
>
> Really I cannot find any reason which could stop you from
> taking option (1) ;-)
>
I was under the mistaken impression from reading through the Net::Telnet
docs that it was going to handle all the pre-login stuff and not let me
see any of it. Since then I have read through it again, and by creating
a new Net::Telnet object and then using the getline method, I have been
able to do what I wanted, which was basically to connect to the port and
capture the info before the login.
Thanks for all the help, everyone!
--
Jason Baugher
Virtual Adept Professional Consulting Services
1406 Adams Street, Quincy, IL 62301 - (217) 221-5406
jason@baugher.pike.il.us - http://baugher.pike.il.us/virtualadept
------------------------------
Date: Fri, 25 Oct 2002 18:59:16 +0800
From: "cheechew" <cheechew@hotmail.com>
Subject: Re: MD5 password encryption
Message-Id: <apb7oo$h7$1@mawar.singnet.com.sg>
MD5 could not be appropriate. How about 3DES with key. Any perl module on
that?
"Brian McCauley" <nobull@mail.com> wrote in message
news:u93cqv6iaf.fsf@wcl-l.bham.ac.uk...
> "Chee Chew" <cheechew@hotmail.com> writes:
>
> > I am planning to put MD5 password encryption text into the program for
> > security. This program will be using the password to login to some other
> > machine to run certain batch job.
>
> Those two statement don't make sense together.
>
> MD5 is irreversable - you cannot retrieve the plaintext password or a
> password-equivalent.
>
> I suspect your real question is essentially the same as that asked
> numerous previous threads in this newsgroup. The most recent such
> thread being "Hiding password variables in PERL" earlier this week.
>
> (You don't believe that you really have a Perl question).
>
> > Which perl module should I start with and any example on that.
>
> If you really wanted to implement the standard MD5 password encryption
> algorithm you could try a module with MD5 and some contration of the
> word "password" in its name. But I don't think that's really want you
> are talking about.
>
> --
> \\ ( )
> . _\\__[oo
> .__/ \\ /\@
> . l___\\
> # ll l\\
> ###LL LL\\
------------------------------
Date: Fri, 25 Oct 2002 06:55:43 -0500
From: tadmc@augustmail.com (Tad McClellan)
Subject: Re: MD5 password encryption
Message-Id: <slrnaric9v.30n.tadmc@magna.augustmail.com>
cheechew <cheechew@hotmail.com> wrote:
> How about 3DES with key. Any perl module on
> that?
What happened when you searched for that term on CPAN?
http://search.cpan.org/
--
Tad McClellan SGML consulting
tadmc@augustmail.com Perl programming
Fort Worth, Texas
------------------------------
Date: Fri, 25 Oct 2002 14:04:15 +0000 (UTC)
From: Da Witch <heather710101@yahoo.com>
Subject: Overloading and recursion; how to turn '""' overloading off?
Message-Id: <apbj0v$j7n$1@reader1.panix.com>
Suppose I overload "" for some Perl object. Is there a way to locally
disable this overloading so that I may recover the original behavior
of "" on the object?
One application for this would be to avoid recursion in an overloading
of "" that just wants to amplify "", not to rewrite it from scratch.
For example, as written, the following code leads to a deep recursion
fault:
use overload '""' => \&stringify;
sub stringify {
"Just call me $_[0]" # Produces a deep recursion fault
}
Is there a way around this unwanted recursion? It would be nice to be
able to turn the ""-overloading off within the function used to
redefine the overload.
Thanks!
hk
------------------------------
Date: Fri, 25 Oct 2002 12:48:41 +0200
From: Jeroen van Wissen <jeroen.van.wissen@twoop.com>
Subject: PoCo::IRC dcc chat example / code snipped / help ?
Message-Id: <3DB92189.9070300@twoop.com>
Hi,
I'm working on an irc bot useing PoCo::IRC and i want to add dcc chat
functionality in it.
But i can't get it to work.
is there anyone that could give me a small code snipped / example how to
work with dcc chat?
it'll be used for output only from the bot to an user.
thanx!
j. van wissen aka "graaf"
------------------------------
Date: 25 Oct 2002 05:56:28 -0700
From: johnston.jay@mtvne.com (shambolic)
Subject: Re: pulling out text from between two strings
Message-Id: <f333df78.0210250456.5fdca9a0@posting.google.com>
tadmc@augustmail.com (Tad McClellan) wrote in message news:<slrnarhdlo.22f.tadmc@magna.augustmail.com>...
> shambolic <johnston.jay@mtvne.com> wrote:
> >
> > i have a whois webpage in scalar $doc, and want to pull out the text
> > between the strings "netname" and RIPE.
>
>
> if ( $doc =~ /netname(.*?)RIPE/s ) {
> print "$1\n";
> }
>
>
> > i know this is fairly standard, but having pondered the FAQ at
>
>
> It is also on your hard disk already.
>
>
> > http://theoryx5.uwinnipeg.ca/CPAN/perl/pod/perlfaq6/How_can_I_pull_out_lines_between_two_pat.html
> > i am still none the wiser.
>
>
> The FAQ is about text between two lines.
>
> Your subject is about text between two strings.
>
> Which is it, lines or strings?
Strings it was, and that seems to have worked very well indeed. many
thanks.
now, if it's not too much trouble, is there a regex i could employ in
order to match the 5th incidence of "RIPE" in the string?
thanks again!
------------------------------
Date: Fri, 25 Oct 2002 08:39:23 -0500
From: tadmc@augustmail.com (Tad McClellan)
Subject: Re: pulling out text from between two strings
Message-Id: <slrnariicb.3d3.tadmc@magna.augustmail.com>
shambolic <johnston.jay@mtvne.com> wrote:
> tadmc@augustmail.com (Tad McClellan) wrote in message news:<slrnarhdlo.22f.tadmc@magna.augustmail.com>...
>> shambolic <johnston.jay@mtvne.com> wrote:
>> if ( $doc =~ /netname(.*?)RIPE/s ) {
>> print "$1\n";
>> }
> now, if it's not too much trouble, is there a regex i could employ in
> order to match the 5th incidence of "RIPE" in the string?
Here's how to do it for the 3rd occurence:
--------------------------------------
#!/usr/bin/perl
use warnings;
use strict;
my $doc = 'stuff0 netname stuff1 RIPE
stuff2 RIPE stuff3
RIPE stuff4 RIPE';
if ( $doc =~ /netname((?:.*?RIPE){3})/s ) {
print "$1\n";
}
--------------------------------------
--
Tad McClellan SGML consulting
tadmc@augustmail.com Perl programming
Fort Worth, Texas
------------------------------
Date: Fri, 25 Oct 2002 13:13:08 +0000 (UTC)
From: develop@gistenson.com
Subject: Replacing string in binary file
Message-Id: <apbg14$48n$1@flood.xnet.com>
Hi,
I want to replace a string in a binary file. For example, I want to
replace the string "abc" with the string "xyz". Is there a way to do this?
Something similar to replacing a string in a scalar? (e.g. $variable =~
s/abc/xyz/;)
Thanks,
Dan
------------------------------
Date: Fri, 25 Oct 2002 13:35:25 GMT
From: "Jürgen Exner" <jurgenex@hotmail.com>
Subject: Re: Replacing string in binary file
Message-Id: <xMbu9.2285$IU6.1379@nwrddc03.gnilink.net>
develop@gistenson.com wrote:
> I want to replace a string in a binary file. For example, I want to
> replace the string "abc" with the string "xyz". Is there a way to do
> this? Something similar to replacing a string in a scalar? (e.g.
> $variable =~ s/abc/xyz/;)
What happened when you tried it?
Seriously, a file is a file is a file and Perl doesn't care about its
content type.
You just need to be careful about the automatic line end transformation
(perldoc -f binmode) and the concept of a 'line' may not make much sense on
binary files.
jue
------------------------------
Date: Fri, 25 Oct 2002 13:45:23 -0000
From: "David K. Wall" <usenet@dwall.fastmail.fm>
Subject: Re: Replacing string in binary file
Message-Id: <Xns92B2633ECBCD7dkwwashere@216.168.3.30>
<develop@gistenson.com> wrote on 25 Oct 2002:
> I want to replace a string in a binary file. For example, I want to
> replace the string "abc" with the string "xyz". Is there a way to do this?
> Something similar to replacing a string in a scalar? (e.g. $variable =~
> s/abc/xyz/;)
What happened when you tried s/// ?
--
David K. Wall - usenet@dwall.fastmail.fm
"Oook."
------------------------------
Date: Fri, 25 Oct 2002 23:29:29 +1000
From: Derek Thomson <derek@wedgetail.com>
Subject: Re: RMI Equivalent in Perl?
Message-Id: <3db9473f$0$12759$afc38c87@news.optusnet.com.au>
Brian wrote:
>
> I have a perl script executed on an NT machine, and I need to be able
> to execute system calls on a unix server as the current user. I do not
> want to use RSH. I want to use a more solid method. In Java, there is
> RMI which would do the job. I'm wondering if perl has some
> equivalent?
Have you considered SOAP or XMLRPC? The SOAP::Lite module on CPAN
provides both, and is free. It's very easy to use.
Go to http://soaplite.com for more details.
Let's say you wanted to run netstat on a remote machine, passing in a
list of string arguments, and returning a list of strings as the result.
Here's the server:
#!/usr/bin/env perl
require v5.6;
use warnings;
use strict;
use SOAP::Lite;
use SOAP::Transport::HTTP;
sub netstat;
my $daemon = SOAP::Transport::HTTP::Daemon
-> new (LocalPort => 8080)
-> dispatch_to('netstat');
$daemon->handle;
sub netstat
{
my ($class, $args) = @_;
my $netstat_proc = IO::File->new("netstat @$args |");
my @results = ();
while (<$netstat_proc>) {
push @results, $_;
}
return \@results;
}
And here's an example client, that calls the remote netstat method:
#!/usr/bin/env perl
require v5.6;
use warnings;
use strict;
use SOAP::Lite;
my $proxy = SOAP::Lite->proxy('http://localhost:8080');
my $results = $proxy->netstat([ '-r', '-n' ])->result;
print for @$results;
And that's it! You can of course extend to provide more than one remote
method, but that's the basic idea.
--
D.
------------------------------
Date: Fri, 25 Oct 2002 12:09:30 GMT
From: "John W. Krahn" <krahnj@acm.org>
Subject: Re: Slow code, improvements requested
Message-Id: <3DB9347C.AC8506F@acm.org>
Jan Fure wrote:
>
> I just wrote a script which:
>
> 1. Reads in a text file.
> 2. Sorts it. (The heading is stripped prior to sort)
> 3. Goes through each line, and captures the contents of the second
> column.
> 4. Stores the line in a temporary array (@tempdata).
> 5. Every time the value of second column changes, the temporary array
> is appended to a textfile (with the heading), unless the line number
> exceeds a set limit, in which case a new file is created.
> 6. Steps 1-5 are repeated on all files with .txt extension in the
> directory of the script.
>
> Effectively, I break the file into smalled volumes which can be
> handled by a software which is limited to 32000 lines file size.
>
> The problem is that the script runs in no time on 1MB files, but it is
> really slow on 5MB files.
>
> I appreciate any suggestions about how to make the code more
> efficient!
>
> I suspect my sort operation takes most of the computer resources.
>
> Jan
>
> PS, the OS is WinNT4.0, ActiveState perl 5.6
>
> With slow I mean 15-30 minutes for a 5MB file, whereas a 1MB file ran
> in 10 seconds. The computer memory seems to not be exceeded, perl
> process has grown from 30 to 40MB over the last hour: 320MB total
> memory utilized, physical RAM of 384MB. Perl CPU utilization near
> 100%.
>
> Code pasted below:
>
> my $linelimit=31998;
> opendir(DIR, ".");
> my @tfiles = sort(grep(/.txt/, readdir(DIR)));
> closedir(DIR);
> foreach (<@tfiles>) {
> print "$_";
> print "\n";
> }
> foreach (<@tfiles>) {
> my $INPUT_FILE = $_;
> ($name, $extent) = /(\w+).(\w+)/;
> open INPUT_FILE, "$INPUT_FILE" or die "can't open $INPUT_FILE";
> @array = <INPUT_FILE>;
> my $heading=shift(@array);
> print "Heading is $heading!\n";
> my @sorted = sort @array;
> print $name, $extent, "\n";
> my $n1=0; my $n2=0;my $n3=0;my $newone=0;my $old=0;
> my ($lot, @other);
> my $firstrow=shift(@sorted);
> ($lot,$newone,@other)=split /\t/, $firstrow;
> unshift @sorted, $firstrow;
> open(CURRENT,">$name$n3.tx");
> print CURRENT "$heading";
> close CURRENT;
> @tempdata = [];
> foreach (@sorted) {
> $n1++;
> $old=$newone;
> ($lot,$newone,@other)=split /\t/;
> if ($newone ne $old){
> if ($n1<$linelimit){
> shift @tempdata;
> open(CURRENT,">>$name$n3.tx");
> print CURRENT @tempdata;
> close CURRENT;
> print "$n2\n";
> }
> else {
> $n3++;
> shift @tempdata;
> open (CURRENT,">$name$n3.tx");
> print CURRENT "$heading";
> print CURRENT @tempdata;
> close CURRENT;
> $n1=$n1 - $linelimit;
> }
> $n2++;
> @tempdata = [];
> }
> push @tempdata, $_
> }
> if ($n1>$linelimit){
> $n3++;
> shift @tempdata;
> open(CURRENT,">$name$n3.tx");
> print CURRENT "$heading";
> print CURRENT @tempdata;
> close CURRENT;
> }
> else {
> shift @tempdata;
> open(CURRENT,">>$name$n3.tx");
> print CURRENT @tempdata;
> close CURRENT;
> }
> }
Perhaps this will speed it up:
my $linelimit = 31999;
opendir DIR, '.' or die "Cannot open dir '.': $!";
my @tfiles = sort grep /\.txt$/, readdir DIR;
closedir DIR;
print "$_\n" for @tfiles;
for my $file ( @tfiles ) {
my ( $name ) = $file =~ /^(.+)\.txt$/;
print "$name.txt\n";
open INPUT_FILE, $file or die "can't open $file: $!";
my ( $heading, @sorted ) = <INPUT_FILE>;
print "Heading is $heading!\n";
@sorted =
map { s/[^\t]*\t//; $_ }
sort
map { (split /\t/)[1] . "\t$_" }
@sorted;
my $ext = 0;
while ( @sorted ) {
my $newone = (split /\t/, $sorted[0])[1];
my $len;
for ( @sorted ) {
last unless /^[^\t]*\t\Q$newone\E\t/;
$len++;
}
$len = $linelimit if $len > $linelimit;
open CURRENT, "> $name" . $ext++ . '.tx';
print CURRENT $heading, splice @sorted, 0, $len;
close CURRENT;
}
}
__END__
John
--
use Perl;
program
fulfillment
------------------------------
Date: Fri, 25 Oct 2002 12:54:32 +0200
From: Sven <un1@bluewin.ch>
Subject: Slow File Read and Regex
Message-Id: <un1-22632C.12543225102002@news.dplanet.ch>
Hi folks,
I experience a strange behaviour ever since I upgraded from Perl 5.6.1
to 5.8.0.
I'm reading a file line by line and checking every line againts a regex.
The performance drops a lot if you use /i to make the regex case
insensitive. Then again if you don't read from a file but cruise an
array, there's no difference.
Here's a little test script to illustrate this:
------------------------------------------------------------------------
#!/usr/bin/perl
# Create Sample File (sample.txt) and Array (@sample)
$line = "xxxxxxxxxxABCDxxxxxxxxxx\n";
@sample = ();
open(SAMPLE,'>sample.txt');
for (my $i=0;$i<20000;$i++) {
push @sample, $line;
print SAMPLE $line;
}
close(SAMPLE);
# Test
print "1) Time Case Insensitive Regex from File\n";
open(SAMPLE,'sample.txt');
$cnt = 0;
$go = time;
while (<SAMPLE>) { $cnt++ if /ABCD/; }
print "$cnt found in ".(time-$go)." secs\n\n";
close(SAMPLE);
print "2) Time Case Insensitive Regex from RAM\n";
$cnt = 0;
$go = time;
for ($i=0;$i<20000;$i++) {
$_ = $sample[$i];
$cnt++ if /ABCD/;
}
print "$cnt found in ".(time-$go)." secs\n\n";
print "3) Time Case Sensitive Regex from File\n";
open(SAMPLE,'sample.txt');
$cnt = 0;
$go = time;
while (<SAMPLE>) { $cnt++ if /ABCD/i; } # added /i to regex
print "$cnt found in ".(time-$go)." secs\n\n";
close(SAMPLE);
print "4) Time Case Sensitive Regex from RAM\n";
$cnt = 0;
$go = time;
for ($i=0;$i<20000;$i++) {
$_ = $sample[$i];
$cnt++ if /ABCD/i; # added /i to regex
}
print "$cnt found in ".(time-$go)." secs\n\n";
------------------------------------------------------------------------
As you see, test 1 and 3 are completely identical (but adding the /i)
and the same goes for 2 and 4.
Now see the output on my linux box:
1) Time Case Insensitive Regex from File
20000 found in 0 secs
2) Time Case Insensitive Regex from RAM
20000 found in 0 secs
3) Time Case Sensitive Regex from File
20000 found in 26 secs
4) Time Case Sensitive Regex from RAM
20000 found in 0 secs
What's going on at test 3 there? I'm really out of clues.
To give you an impression of my linux box: It's an old i586 operated by
RedHat 8.0 (which includes Perl 5.8.0 built for i386-linux-thread-multi)
on Kernel 2.4.18-17.8.0. The box is not running X, has only 128MB RAM
but is hardly ever swapping and most of the time >98% idle.
Thanks for any hint!!
Sven
------------------------------
Date: Fri, 25 Oct 2002 12:07:53 +0200
From: Josef =?iso-8859-1?Q?M=F6llers?= <josef.moellers@fujitsu-siemens.com>
Subject: Re: Tk help, please.
Message-Id: <3DB917F9.B5E8F6F1@fujitsu-siemens.com>
Richard S Beckett wrote:
> =
> Hello.
> =
> I'm creating my first GUI, using active state on win32. I seem to be ab=
le to
> find slightly better documentation for Tk, so I'm going with that.
> =
> I'm having a problem with the menu bar command. If I run the script as =
is, I
> get the following error:
> Failed to AUTOLOAD 'Tk::Frame::command' at script.pl line 31
[ ... ]
> # menu bar command
> $menu_bar->command(-label =3D> "Exit", -command =3D> sub{$main->destroy=
});
That should be "$menu_bar->Command(...);" with an upper case _C_!
-- =
Josef M=F6llers (Pinguinpfleger bei FSC)
If failure had no penalty success would not be a prize
-- T. Pratchett
------------------------------
Date: Fri, 25 Oct 2002 11:38:34 +0100
From: "Richard S Beckett" <spikey-wan@bigfoot.com>
Subject: Re: Tk help, please.
Message-Id: <apb70k$a3b$1@newshost.mot.com>
"Josef Möllers" <josef.moellers@fujitsu-siemens.com> wrote in message
news:3DB917F9.B5E8F6F1@fujitsu-siemens.com...
Richard S Beckett wrote:
>
> Hello.
>
> I'm creating my first GUI, using active state on win32. I seem to be able
to
> find slightly better documentation for Tk, so I'm going with that.
>
> I'm having a problem with the menu bar command. If I run the script as is,
I
> get the following error:
> Failed to AUTOLOAD 'Tk::Frame::command' at script.pl line 31
[ ... ]
> # menu bar command
> $menu_bar->command(-label => "Exit", -command => sub{$main->destroy});
That should be "$menu_bar->Command(...);" with an upper case _C_!
--
Josef Möllers (Pinguinpfleger bei FSC)
If failure had no penalty success would not be a prize
-- T. Pratchett
Nope. Tried that.
Got:
Assuming 'require Tk::Command;' at working.pl line 32
Can't locate Tk/Command.pm in @INC (@INC contains: D:/Perl/lib
D:/Perl/site/lib .) at D:/Perl/site/lib/Tk/Widget.pm line
259.
When I added "use Tk::Command;", I got this:
Can't locate Tk/Command.pm in @INC (@INC contains: D:/Perl/lib
D:/Perl/site/lib .) at working.pl line 6.
BEGIN failed--compilation aborted at working.pl line 6.
Thanks, again.
R.
------------------------------
Date: Fri, 25 Oct 2002 13:32:13 +0200
From: Josef =?iso-8859-1?Q?M=F6llers?= <josef.moellers@fujitsu-siemens.com>
Subject: Re: Tk help, please.
Message-Id: <3DB92BBD.E4F03863@fujitsu-siemens.com>
Richard S Beckett wrote:
> =
> "Josef M=F6llers" <josef.moellers@fujitsu-siemens.com> wrote in message=
> news:3DB917F9.B5E8F6F1@fujitsu-siemens.com...
> Richard S Beckett wrote:
> >
> > Hello.
> >
> > I'm creating my first GUI, using active state on win32. I seem to be =
able
> to
> > find slightly better documentation for Tk, so I'm going with that.
> >
> > I'm having a problem with the menu bar command. If I run the script a=
s is,
> I
> > get the following error:
> > Failed to AUTOLOAD 'Tk::Frame::command' at script.pl line 31
> [ ... ]
> > # menu bar command
> > $menu_bar->command(-label =3D> "Exit", -command =3D> sub{$main->destr=
oy});
> =
> That should be "$menu_bar->Command(...);" with an upper case _C_!
> =
> --
> Josef M=F6llers (Pinguinpfleger bei FSC)
> If failure had no penalty success would not be a prize
> -- T. Pratchett
> =
> Nope. Tried that.
Sorry, that was a misser on my side: I have played with Perl/Tk recently
and have made the kind of typing mistake I was thinking you had made,
too.
AFAIK there is no such thing as a "command" widget in Tk (at least the
Tcl 8.3.4 documentation doesn't show one).
I guess you have to apply "command" to $menu rather than $menu_bar.
Take a look here:
http://gd.tuwien.ac.at/languages/perl/Hajji-Perlkurs/part4/tkperl.html
Most comments are in German, though.
Have fun,
-- =
Josef M=F6llers (Pinguinpfleger bei FSC)
If failure had no penalty success would not be a prize
-- T. Pratchett
------------------------------
Date: Fri, 25 Oct 2002 08:30:26 -0400
From: "Tulan W. Hu" <twhu@lucent.com>
Subject: Re: Tk help, please.
Message-Id: <apbdh8$lpf@netnews.proxy.lucent.com>
"Richard S Beckett" <spikey-wan@bigfoot.com> wrote in
> I tried using PPM to install Tk::Frame::command, but got this:
> Installing package 'Tk-Frame-command'...
> Error installing package 'Tk-Frame-command': Could not locate a PPD file
for
> package Tk-Frame-command
You did not successfully install the package, so that you cannot use it.
> Also, does anyone have any useful information on how to position buttons,
> labels, etc within the window?
do a search in the comp.lang.perl.tk group.
I would create a layer of frames and position the widgets on them than put
all frames on the toplevel.
------------------------------
Date: Fri, 25 Oct 2002 12:33:46 +0100
From: Simon Andrews <simon.andrews@bbsrc.ac.uk>
Subject: Re: Trying to make a GUI.
Message-Id: <3DB92C1A.825F7C83@bbsrc.ac.uk>
Richard S Beckett wrote:
>
> Thanks guys.
>
> Yes, I have read the documentation, but I find it difficult to get useful
> information from it. For example, try using the active state docs to work
> out how to set the window size.
>
> I'd love to find some decent docs aimed for beginners, but I've had no luck
> so far.
Not free, but how about
"Learning Perl/Tk - Nancy Walsh ISBN 1-56592-314-6"
Not absolutely comprehensive, but enough to get you started. This may
also now have been superseded by...
"Mastering Perl/Tk - Nancy Walsh and Stephen Lidie ISBN 1-56592-716-8"
..but I haven't seen that one yet.
Also hang around in comp.lang.perl.tk which has some very knowledgeable
regulars.
Hope this helps
Simon.
------------------------------
Date: 25 Oct 2002 05:00:32 -0700
From: deita@inbox.lv (deita)
Subject: unix socket
Message-Id: <9899055d.0210250400.500ab258@posting.google.com>
hello,
my application creates local unix socket, writes some data and exits.
when i run the application the second time, i need to retrieve this
data from this file.
creating unix peer socket to this file leads to "connection refused"
error, with local unix socket "address already in use" error is
thrown.
is there the way to read data written to the unix socket in presious
session?
i create sockets with this code:
-------
$sock = IO::Socket::UNIX->new(
Type => SOCK_DGRAM,
Local => "temp.sock",
# Peer => "temp.sock",
) or die("error: $!");
-------
thanx.
------------------------------
Date: Fri, 25 Oct 2002 14:47:06 +0100
From: news@roaima.freeserve.co.uk
Subject: Re: unix socket
Message-Id: <q0ibpa.obc.ln@moldev.cmagroup.co.uk>
deita <deita@inbox.lv> asked:
> is there the way to read data written to the unix socket in presious
> session?
No
Chris
--
@s=split(//,"Je,\nhn ersloak rcet thuarP");$k=$l=@s;for(;$k;$k--){$i=($i+1)%$l
until$s[$i];$c=$s[$i];print$c;undef$s[$i];$i=($i+(ord$c))%$l}
------------------------------
Date: 25 Oct 2002 14:29:27 GMT
From: roberson@ibd.nrc.ca (Walter Roberson)
Subject: Re: unix socket
Message-Id: <apbkg7$k2b$1@canopus.cc.umanitoba.ca>
In article <9899055d.0210250400.500ab258@posting.google.com>,
deita <deita@inbox.lv> wrote:
:my application creates local unix socket, writes some data and exits.
:when i run the application the second time, i need to retrieve this
:data from this file.
There is your problem: sockets are NOT "files". Sockets have
no persistant state, only in-memory buffers. Socket contents do not,
for example, survive reboots.
:creating unix peer socket to this file leads to "connection refused"
:error, with local unix socket "address already in use" error is
:thrown.
That's correct. If you try to connect to a socket that has been
closed but not entirely torn down yet, that is the behaviour
you would see. If you are going to need to connect to the same
destination without worrying about delays while a previous connection
is torn down, then you need to set the socket option SO_REUSE .
:is there the way to read data written to the unix socket in presious
:session?
No. If you need to do that, you are using the wrong communication
mechanism. If it is acceptable that the contents will not survive
reboots, then a shared memory segment might be the way to go.
That will not, though, give you file semantics, so if your goal
is to have a persistant message store that gives out each message
-exactly- once, then you are going to need a different design.
--
I don't know if there's destiny,
but there's a decision! -- Wim Wenders (WoD)
------------------------------
Date: 25 Oct 2002 07:12:34 -0700
From: mullman@charter.net (Chris)
Subject: Re: Writing Microsoft Outlook Notes With Perl
Message-Id: <c71b7a2c.0210250612.1edc1359@posting.google.com>
mullman@charter.net (Chris) wrote in message news:<c71b7a2c.0210220638.71e61d3d@posting.google.com>...
> I've got this half-baked idea for writing a program that will
> dynamically generate Microsoft Outlook Notes from information gathered
> from a database. I know how to do everything except create the
> Outlook Note. Can anyone point me in the direction of information for
> accomplishing this? I've seen others do this (not with Perl) where
> the program will seek data from the weather service and write that
> data into an Outlook Note. That's similar to what I am trying to do.
>
> Any help will be greatly appreciated.
>
> Chris
UPDATE
============================
I have had quite a bit of success, however, I'm having a small problem
getting my data into the note and I think it's a de-referencing
problem but I hope one of the experts on this list can help educate
me. Here's what I've got so far:
#!/usr/bin/perl
use Net::NNTP;
use Date::Manip;
use Win32::OLE;
$ENV{TZ} = 'CST';
$today = &UnixDate("today","%a, %e %b %Y");
$nntp = Net::NNTP->new("news.ISP.net", Debug => 0) || die "Couldn't
connect to the server: $!";
($num,$first,$last,$name) = ($nntp->group("comp.lang.perl.misc"));
for (; $first <= $last; $first++)
{
$info = $nntp->head($first);
if (@{$info} ne "")
{
@msg_date = %{$nntp->xhdr( 'Date', $first )};
@subject = %{$nntp->xhdr( 'Subject', $first )};
@message_id = %{$nntp->xhdr( 'Message-ID', $first )};
if ($msg_date[1] =~ $today)
{
print ("DATE: $msg_date[1]\nMESS: $subject[1]");
# use existing instance if Outlook is already running
eval {$ex = Win32::OLE->GetActiveObject('Outlook.Application')};
die "Outlook not installed" if $@;
unless (defined $ex) {
$ex = Win32::OLE->new('Outlook.Application', sub
{$_[0]->Quit;})
or die "Oops, cannot start Outlook";
}
$olMAPI = $ex->GetNameSpace("MAPI") or die "Error getting name
space";
$notes = $olMAPI->Folders("Mailbox")->Folders("Notes") or die
"Error getting folder";
$myItem = $notes->Items->Add;
$myItem->{body} = @{$nntp->body($first)};
$myItem->Save;
undef $notes;
undef $olMAPI;
undef $ex;
}
else
{
print ("not today\n");
}
}#END if (@{$info} ne "")
}#END for (; $first <= $last; $first++)
$nntp->quit;
The problem is the line "$myItem->{body} = @{$nntp->body($first)};"
which is printing an integer instead of the actual body. I'd
appreciate any help on this. Please educate me on what I missed.
Chris
------------------------------
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 4028
***************************************
