[29994] in Perl-Users-Digest
Perl-Users Digest, Issue: 1237 Volume: 11
daemon@ATHENA.MIT.EDU (Perl-Users Digest)
Sun Jan 27 18:09:41 2008
Date: Sun, 27 Jan 2008 15:09:05 -0800 (PST)
From: Perl-Users Digest <Perl-Users-Request@ruby.OCE.ORST.EDU>
To: Perl-Users@ruby.OCE.ORST.EDU (Perl-Users Digest)
Perl-Users Digest Sun, 27 Jan 2008 Volume: 11 Number: 1237
Today's topics:
Re: Chat client/server print failed <deadpickle@gmail.com>
Re: Chat client/server print failed <zentara@highstream.net>
Is it incorrect for a module to "use" subroutines from <news@lawshouse.org>
Re: Parse transcripts on speaker's name and grab subseq <rvtol+news@isolution.nl>
Perl code to convert from CSH to BASH?? <ahmad.abdulghany@gmail.com>
Re: Perl code to convert from CSH to BASH?? <news@lawshouse.org>
Regexp to search over several lines in one string d99alu@efd.lth.se
Re: Regexp to search over several lines in one string <rvtol+news@isolution.nl>
Re: Regexp to search over several lines in one string <noreply@gunnar.cc>
Re: Regexp to search over several lines in one string <someone@example.com>
Re: Regexp to search over several lines in one string <stoupa@practisoft.cz>
Re: Regexp to search over several lines in one string <rvtol+news@isolution.nl>
Re: Regexp to search over several lines in one string <rvtol+news@isolution.nl>
Re: Regexp to search over several lines in one string <noreply@gunnar.cc>
Re: Regexp to search over several lines in one string <noreply@gunnar.cc>
Digest Administrivia (Last modified: 6 Apr 01) (Perl-Users-Digest Admin)
----------------------------------------------------------------------
Date: Sun, 27 Jan 2008 09:38:21 -0800 (PST)
From: deadpickle <deadpickle@gmail.com>
Subject: Re: Chat client/server print failed
Message-Id: <742541a1-dca1-4f90-a3d9-cc8aedea8301@c23g2000hsa.googlegroups.com>
THanks alot, those scripts are very simple compared to that confusing
script I was trying to write. What I am trying to do is send the user
name to the server so that it can be added to the client list. I dont
quit get how to do this and could use some help.
The client:
#!/usr/bin/perl
use warnings;
use strict;
use Glib qw(TRUE FALSE);
use Gtk2 -init;
use IO::Socket;
#-------------------Global variables-------------------
my $host = 'Deadpickle-hobo';
my $port = 12345;
my $socket;
my $user;
#-------------------Main Window-------------------
my $window = Gtk2::Window->new;
$window->signal_connect( delete_event => sub { exit } );
$window->set_default_size( 300, 200 );
my $vbox = Gtk2::VBox->new;
$window->add($vbox);
my $scroller = Gtk2::ScrolledWindow->new;
$vbox->add($scroller);
my $textview = Gtk2::TextView->new;
$textview ->set_editable (0);
$textview ->can_focus(0);
my $buffer = $textview->get_buffer;
$buffer->create_mark( 'end', $buffer->get_end_iter, FALSE );
$buffer->signal_connect(insert_text => sub {
$textview->scroll_to_mark( $buffer->get_mark('end'), 0.0,
TRUE, 0, 0.5 );
});
$scroller->add($textview);
my $entry = Gtk2::Entry->new();
$vbox->pack_start( $entry, FALSE, FALSE, 0 );
$vbox->set_focus_child ($entry); # keeps cursor in entry
$window->set_focus_child ($entry); # keeps cursor in entry
# allows for sending each line with an enter keypress
my $send_sig = $entry->signal_connect ('key-press-event' => sub {
my ($widget,$event)= @_;
if( $event->keyval() == 65293){ # a return key press
my $text = $entry->get_text;
if(defined $socket){ print $socket $user.'->'. $text,
"\n";}
$entry->set_text('');
$entry->set_position(0);
}
});
#If you store the ID returned by signal_connect, you can temporarily
#block your signal handler with
# $object->signal_handler_block ($handler_id)
# and unblock it again when you're done with
## $object->signal_handler_unblock ($handler_id).
# we want to block/unblock the enter keypress depending
# on the state of the socket
$entry->signal_handler_block($send_sig); #not connected yet
$entry->set_editable(0);
$window->show_all;
#start the dialog window
dialog();
Gtk2->main;
exit;
#-------------------Login Dialog-------------------
sub dialog{
my $dialog_window = Gtk2::Window->new('toplevel');
$dialog_window->signal_connect(delete_event => sub {Gtk2-
>main_quit});
my $dialog_table = Gtk2::Table->new(2, 2, FALSE);
my $dialog_label1 = Gtk2::Label->new('Chat Login:');
my $dialog_label2 = Gtk2::Label->new('User:');
my $chat_user = Gtk2::Entry->new();
$chat_user->set_text('');
my $dialog_button1 = Gtk2::Button->new('Connect');
$dialog_table->attach_defaults($dialog_label1, 0, 1, 0, 1);
$dialog_table->attach_defaults($chat_user, 1, 2, 0, 1);
$dialog_table->attach_defaults($dialog_button1, 1, 2, 1, 2);
#connect to the server
$dialog_button1->signal_connect( clicked => sub {
$user = $chat_user->get_text;
$dialog_window->destroy;
init_connect();
});
$dialog_window->add($dialog_table);
$dialog_window->show_all;
return;
}
#------------------Connect to server---------------------
sub init_connect{
$socket = IO::Socket::INET->new(
PeerAddr => $host,
PeerPort => $port,
Proto => 'tcp',
);
if( ! defined $socket){
my $buffer = $textview->get_buffer;
$buffer->insert( $buffer->get_end_iter, "ERROR: Can't
connect to port $port on $host as $user: $!\n" );
return;
}
# install an io watch for this stream and
# return immediately to the main caller, who will return
# immediately to the event loop. the callback will be
# invoked whenever something interesting happens.
Glib::IO->add_watch( fileno $socket, [qw/in hup err/],
\&watch_callback, $socket );
#turn on entry widget
$entry->set_editable(1);
$entry->grab_focus;
$entry->signal_handler_unblock ($send_sig);
#send the username to the server for handling
print $socket "$user\n";
Gtk2->main_iteration while Gtk2->events_pending;
}
#-------------------Watch for Events-------------------
sub watch_callback {
my ( $fd, $condition, $fh ) = @_;
if ( $condition >= 'in' ) {
# there's data available for reading. we have no
# guarantee that all the data is there, just that
# some is there. however, we know that the child
# will be writing full lines, so we'll assume that
# we have lines and will just use <>.
my $data = scalar <$fh>;
if ( defined $data ) {
# do something useful with the text.
my $buffer = $textview->get_buffer;
$buffer->insert( $buffer->get_end_iter, $data );
}
}
if ( $condition >= 'hup' or $condition >= 'err' ) {
# End Of File, Hang UP, or ERRor. that means
# we're finished.
# stop ability to send
$entry->set_editable(0);
$entry->signal_handler_block ($send_sig);
my $buffer = $textview->get_buffer;
$buffer->insert( $buffer->get_end_iter, "Server connection
lost !!\n" );
#close socket
$fh->close;
$fh = undef;
#allow for new connection
#$button->set_label('Connect');
#$button->set_sensitive(1);
#$button->grab_focus;
#Gtk2->main_iteration while Gtk2->events_pending;
}
if ($fh) {
# the file handle is still open, so return TRUE to
# stay installed and be called again.
# print "still connected\n";
# possibly have a "connection alive" indicator
return TRUE;
}
else {
# we're finished with this job. start another one,
# if there are any, and uninstall ourselves.
return FALSE;
}
}
the server:
#!/usr/bin/perl
use warnings;
use strict;
use IO::Socket;
use threads;
use threads::shared;
my $user;
$|++;
print "$$ Server started\n";; # do a "top -p -H $$" to monitor server
threads
our @clients : shared;
@clients = ();
my $server = new IO::Socket::INET(
Timeout => 7200,
Proto => "tcp",
LocalPort => 12345,
Reuse => 1,
Listen => 3
);
while (1) {
my $client;
do {
$client = $server->accept;
} until ( defined($client) );
$server->recv($user, 300);
my $peerhost = $client->peerhost();
print "accepted a client $client, $peerhost, username = $user \n";
my $fileno = fileno $client;
push (@clients, $fileno);
#spawn a thread here for each client
my $thr = threads->new( \&process_it, $client, $fileno,
$peerhost )->detach();
}
# end of main thread
sub process_it {
my ($lclient,$lfileno,$lpeer) = @_; #local client
if($lclient->connected){
# Here you can do your stuff
# I use have the server talk to the client
# via print $client and while(<$lclient>)
print $lclient "$lpeer->Welcome to server\n";
while(<$lclient>){
# print $lclient "$lpeer->$_\n";
print "clients-> @clients\n";
foreach my $fn (@clients) {
open my $fh, ">&=$fn" or warn $! and die;
print $fh "$_"
}
}
}
#close filehandle before detached thread dies out
close( $lclient);
#remove multi-echo-clients from echo list
@clients = grep {$_ !~ $lfileno} @clients;
}
------------------------------
Date: Sun, 27 Jan 2008 18:34:42 GMT
From: zentara <zentara@highstream.net>
Subject: Re: Chat client/server print failed
Message-Id: <1nipp31nrnev1ldgo9copge248pd4co6jk@4ax.com>
On Sun, 27 Jan 2008 09:38:21 -0800 (PST), deadpickle
<deadpickle@gmail.com> wrote:
>THanks alot, those scripts are very simple compared to that confusing
>script I was trying to write. What I am trying to do is send the user
>name to the server so that it can be added to the client list. I dont
>quit get how to do this and could use some help.
Well what you need to do, is watch the first few sockets transactions,
which will pass the username and password. Then the server should accept
the connection only if the correct username/password is sent.
So you should probably do the popup asking for username/password, right
at the program start. Then when you try to establish the socket
connection, send the user=$username|pass=$password to the server.
If the server likes it, it will send the welcome message.
I don't feel like writing it now for you, but I do have a Tk version at
http://perlmonks.org?node_id=387351
It uses Net::EasyTCP, which is different than a pure socket connection,
but you can see how the password system works.
To be honest, you will never learn how this stuff works, until
you spend a few hours ( I spent 20 ) experimenting with the code.
Otherwise you will constantly be asking us to do your troubleshooting.
Jump in there, and send user/pass combo, and see what happens.
When you can receive the user/pass at the server, what is the next step?
You verify it. If verified, you connect as normal. otherwise don't allow
the connection.
Goodluck, and happy hacking,
zentara
--
I'm not really a human, but I play one on earth.
http://zentara.net/japh.html
------------------------------
Date: Sun, 27 Jan 2008 22:50:37 +0000
From: Henry Law <news@lawshouse.org>
Subject: Is it incorrect for a module to "use" subroutines from itself?
Message-Id: <1201474233.29804.0@proxy00.news.clara.net>
I have some code of which this is the relevant part:
package NFB::Utilities::Common;
# ...
our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'}}, qw(
db_connect get_file_gm_info
# etc ... ('all' is defined but I've snipped it)
) );
# ... other subs
sub db_connect {
# ...etc
}
sub get_file_gm_info {
# 'db_connect' is actually in this module. The call
# is left over from when the sub was developed in-line.
use NFB::Utilities::Common qw(db_connect);
}
I'm trying the code newly-installed on a Fedora Core 6 system running
Perl 5.8.8 and it fails to compile, complaining that (in the above
example) "db_connect" is not exported by the NFB::Utilities::Common
module". It's clear that it is exported. Commenting out the offending
lines, where the module uses subroutines from itself, fixes the problem.
That's OK: I can easily find and remove the offending lines. But the
code runs clean on an FC5 machine also running perl 5.8.8, and on my
Windows machine running ActiveState 5.8.8, so I'm worried that I'm
chasing a secondary error, actually caused by something else.
Does anyone have any insight on this? Seen it yourselves, perhaps?
--
Henry Law Manchester, England
------------------------------
Date: Sun, 27 Jan 2008 13:35:13 +0100
From: "Dr.Ruud" <rvtol+news@isolution.nl>
Subject: Re: Parse transcripts on speaker's name and grab subsequent paragraphs
Message-Id: <fni1cl.qg.1@news.isolution.nl>
Tad J McClellan schreef:
> __DATA__
> JOE: Hello, Jane.
>
> How are you?
>
> Has it been a good day?
>
> JANE: Hey, Joe.
>
> It's been good for me.
>
> JOE: Great.
Yesterday I asked
BOB: How are you?
;)
--
Affijn, Ruud
"Gewoon is een tijger."
------------------------------
Date: Sun, 27 Jan 2008 00:56:13 -0800 (PST)
From: Ahmad <ahmad.abdulghany@gmail.com>
Subject: Perl code to convert from CSH to BASH??
Message-Id: <5d5ed7f1-9b50-494b-a1e9-b5509b911826@k39g2000hsf.googlegroups.com>
Hi,
I was trying to write a Perl code to be used to convert CSH scripts to
BASH. I target to translate .cshrc file to .bashrc one.
My question is: In converting "path" setting statement i was trying
to use "join" and "split" functions.
For example:
set path = (/bin /usr/bin /sbin $HOME/bin ) ===> export PATH=$PATH:/
bin:/usr/bin:/sbin:$HOME/bin
I wrote the part of Perl code like that ($a is holding the line to be
converted):
$a=~s/[()]//g ; # To remove parentheses
$a=~s/set\s+path\s+=(.+)/export PATH=\$PATH:/g;
$b=join(':',split(/\s+/,$1);
$a.=$b;
print FID $a;
And it worked fine, but as you see, the code is very long to convert a
very small part.. Is it possible to include and evaluate function
within the RE replacement side?
Something like that: $a=s/....../....FUNCTION TO BE EVALUATED (e.g.
join.....)..../eg;
How can i do it?
Thanks a lot in advance,
Regards,
Ahmad
P.S. If anyone knows an easiest way to convert from csh to bash, or
had already written a script that does that, please tell me about it..
Thanks a lot.
------------------------------
Date: Sun, 27 Jan 2008 16:07:00 +0000
From: Henry Law <news@lawshouse.org>
Subject: Re: Perl code to convert from CSH to BASH??
Message-Id: <1201450016.31294.0@damia.uk.clara.net>
Ahmad wrote:
> For example:
>
> set path = (/bin /usr/bin /sbin $HOME/bin ) ===> export PATH=$PATH:/
> bin:/usr/bin:/sbin:$HOME/bin
>
> I wrote the part of Perl code like that ($a is holding the line to be
> converted):
Don't do that. (1) Better to use variables that mean something; (2) $a
and $b are used in the "sort" statement and are, by convention, reserved
for that use.
<snipped wordy code ...>
> How can i do it?
Having not a lot better to do this afternoon I had a look at this.
Remember that converting the "set path" statement isn't the only thing
you need to. I don't know csh but I know at least that you'll need to
convert the shebang, and probably a whole lot of other lines as well.
So you're really writing a loop that reads in the csh line by line and
converts each one as appropriate. Here's a starter; it does the "export
path" statement as you requested, and also the shebang. You can add
more "elsif" sections for the other things you need to convert.
#! /usr/bin/perl
use strict;
use warnings;
while ( my $line = <DATA> ) {
if ( $line =~ /^set\s+path\s?=\s?\((.*)\)/ ) {
# Process lines containing set path = ( /some/stuff )
# (You could refine the pattern inside the capturing brackets;
# something like [\w\s/\$] comes to mind)
my @path_elements = split /\s+/,$1;
print "export PATH=\$PATH:", join( ':', @path_elements ), "\n";
} elsif ( $line =~ m|^\#!/usr/bin/csh| ) {
# Process the shebang line
print "\#!/usr/bin/bash\n";
} else {
print $line;
}
}
__DATA__
#!/usr/bin/csh
#
set path = (/bin /usr/bin /sbin $HOME/bin )
--
Henry Law Manchester, England
------------------------------
Date: Sun, 27 Jan 2008 04:18:53 -0800 (PST)
From: d99alu@efd.lth.se
Subject: Regexp to search over several lines in one string
Message-Id: <8d2c1999-68ba-474e-a744-fc7b199b9487@j20g2000hsi.googlegroups.com>
Hi!
I have a string, and I want to remove everything behind the ">"
character. The string contains new line characters that I don't want
to remove.
my $string = "line1
line2>
line3";
Why don't I get a match and replacement with this?
$string =~ s/^([^>]*>)/$1/;
I would expect the string to contain:
"line1
line2>"
But it still contains "line3"!!!
Why is this?
Any suggestions for how to do this in an other 8working) manner?
Best Regards,
Andreas - Sweden
------------------------------
Date: Sun, 27 Jan 2008 13:39:14 +0100
From: "Dr.Ruud" <rvtol+news@isolution.nl>
Subject: Re: Regexp to search over several lines in one string
Message-Id: <fni1m3.eg.1@news.isolution.nl>
d99alu@efd.lth.se schreef:
> I have a string, and I want to remove everything behind the ">"
> character. The string contains new line characters that I don't want
> to remove.
s/(?:<=>).*//s;
See perldoc perlre, search for "look-behind".
--
Affijn, Ruud
"Gewoon is een tijger."
------------------------------
Date: Sun, 27 Jan 2008 14:11:22 +0100
From: Gunnar Hjalmarsson <noreply@gunnar.cc>
Subject: Re: Regexp to search over several lines in one string
Message-Id: <603e81F1p1mtvU1@mid.individual.net>
d99alu@efd.lth.se wrote:
> I have a string, and I want to remove everything behind the ">"
> character. The string contains new line characters that I don't want
> to remove.
>
> my $string = "line1
> line2>
> line3";
>
> Why don't I get a match and replacement with this?
>
> $string =~ s/^([^>]*>)/$1/;
It does match, but since you capture everything, and insert the captured
string using $1, nothing gets changed.
> I would expect the string to contain:
>
> "line1
> line2>"
>
> But it still contains "line3"!!!
>
> Why is this?
Because your regex does not match the "line3" portion of the string.
> Any suggestions for how to do this in an other 8working) manner?
One way to remove everything after the '>' character would be:
$string =~ s/[^>]+$//;
However, that removes the newline between "line2>" and "line3" as well...
This removes everything after '>' but newlines:
$string =~ s{([^>]+)$}{
my $rm = $1;
$rm =~ s/.+//g;
$rm;
}e;
--
Gunnar Hjalmarsson
Email: http://www.gunnar.cc/cgi-bin/contact.pl
------------------------------
Date: Sun, 27 Jan 2008 15:06:03 GMT
From: "John W. Krahn" <someone@example.com>
Subject: Re: Regexp to search over several lines in one string
Message-Id: <v51nj.30453$yQ1.8225@edtnps89>
Dr.Ruud wrote:
> d99alu@efd.lth.se schreef:
>
>> I have a string, and I want to remove everything behind the ">"
>> character. The string contains new line characters that I don't want
>> to remove.
>
> s/(?:<=>).*//s;
ITYM: s/(?<=>).*//s;
John
--
Perl isn't a toolbox, but a small machine shop where you
can special-order certain sorts of tools at low cost and
in short order. -- Larry Wall
------------------------------
Date: Sun, 27 Jan 2008 16:39:03 +0100
From: "Petr Vileta" <stoupa@practisoft.cz>
Subject: Re: Regexp to search over several lines in one string
Message-Id: <fni8k1$1fbc$1@ns.felk.cvut.cz>
d99alu@efd.lth.se wrote:
> Hi!
>
> I have a string, and I want to remove everything behind the ">"
> character. The string contains new line characters that I don't want
> to remove.
>
> my $string = "line1
> line2>
> line3";
>
> Why don't I get a match and replacement with this?
>
> $string =~ s/^([^>]*>)/$1/;
>
> I would expect the string to contain:
>
> "line1
> line2>"
>
$string =~ s/^([^>]*>).*$/$1/s;
line1
line2>
--
Petr Vileta, Czech republic
(My server rejects all messages from Yahoo and Hotmail. Send me your
mail from another non-spammer site please.)
Please reply to <petr AT practisoft DOT cz>
------------------------------
Date: Sun, 27 Jan 2008 16:59:40 +0100
From: "Dr.Ruud" <rvtol+news@isolution.nl>
Subject: Re: Regexp to search over several lines in one string
Message-Id: <fnidm2.194.1@news.isolution.nl>
John W. Krahn schreef:
> Dr.Ruud:
>> d99alu:
>>> I have a string, and I want to remove everything behind the ">"
>>> character. The string contains new line characters that I don't want
>>> to remove.
>>
>> s/(?:<=>).*//s;
>
> ITYM: s/(?<=>).*//s;
Yes. (aaargh, oops again)
--
Affijn, Ruud
"Gewoon is een tijger."
------------------------------
Date: Sun, 27 Jan 2008 17:11:00 +0100
From: "Dr.Ruud" <rvtol+news@isolution.nl>
Subject: Re: Regexp to search over several lines in one string
Message-Id: <fnidvp.1ag.1@news.isolution.nl>
Dr.Ruud schreef:
> d99alu:
>> I have a string, and I want to remove everything behind the ">"
>> character. The string contains new line characters that I don't want
>> to remove.
>
> s/(?:<=>).*//s;
>
> See perldoc perlre, search for "look-behind".
I also forgot the newline. Maybe this does what you need:
s/(?<=>).*/\n/s;
(doesn't keep any of the original newlines; even adds one when none was
there)
--
Affijn, Ruud
"Gewoon is een tijger."
------------------------------
Date: Sun, 27 Jan 2008 19:02:49 +0100
From: Gunnar Hjalmarsson <noreply@gunnar.cc>
Subject: Re: Regexp to search over several lines in one string
Message-Id: <603vagF1pec8fU1@mid.individual.net>
Petr Vileta wrote:
>
> $string =~ s/^([^>]*>).*$/$1/s;
The '$' character is redundant after .*
--
Gunnar Hjalmarsson
Email: http://www.gunnar.cc/cgi-bin/contact.pl
------------------------------
Date: Sun, 27 Jan 2008 22:48:13 +0100
From: Gunnar Hjalmarsson <noreply@gunnar.cc>
Subject: Re: Regexp to search over several lines in one string
Message-Id: <604ch6F1n0mbbU1@mid.individual.net>
Gunnar Hjalmarsson wrote:
> d99alu@efd.lth.se wrote:
>> I have a string, and I want to remove everything behind the ">"
>> character. The string contains new line characters that I don't want
>> to remove.
>>
>> my $string = "line1
>> line2>
>> line3";
>>
>> Why don't I get a match and replacement with this?
>>
>> $string =~ s/^([^>]*>)/$1/;
>
> It does match, but since you capture everything, and insert the captured
> string using $1, nothing gets changed.
I have a feeling that the code above actually is an attempt to do:
if ( $string =~ /^([^>]*>)/ ) {
$string = $1;
}
That replaces the content of _$string_ with what was captured in the
regex. However, it's accomplished via the m// operator, while you were
using the s/// operator.
I recommend that you read up on both those operators in "perldoc perlop".
--
Gunnar Hjalmarsson
Email: http://www.gunnar.cc/cgi-bin/contact.pl
------------------------------
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.
NOTE: due to the current flood of worm email banging on ruby, the smtp
server on ruby has been shut off until further notice.
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 V11 Issue 1237
***************************************
