You probably want the daemon to listen on some port with IO::Socket::UNIX or IO::Socket::INET. If you want to get modern, have POE do the heavy lifting. Its cookbook has examples which would probably take little work to adapt to your requirements.

You can't really have a daemon watch for keyboard activity. A daemon has no controlling terminal, so whose keystrokes should it watch? The point of a daemon is that whoever wants to use it should connect in a known way. It's up to the client to produce the socket message on an event. That way the daemon doesn't need to know anything about the client.

thanks for your reply, but I messed up on my terminology, I shouldn't have stated the one process would be a daemon, I actually meant that although it would constantly run, it would take a tty session, not run in the background (as opposed to the other which would briefly run then stop.

I was thinking of using signals such as in perlipc, but I couldn't find any simple examples in the perlipc doc.

use Tk;

my $mw = MainWindow->new();

$mw->send('Foo' => $file_name);
[download]

use Tk;

my $main_window = MainWindow->new(-title => 'My other prog');
$main_window->appname('Foo');

MainLoop;

sub Tk::Receive{
    shift;
    my $string = shift;

    if ($string =~ /pattern/){
       # Do somthing.    
    }
    else { die 'Wrong arg Received'}
}
[download]

That looks like exactly what I need - I'll play with it later and let you know. thanks!

Yes this is exactly what I need. Thanks! I haven't been able to get it working though, as I've never done anything in Tk before.

The second program runs fine, but when running the first program, it says "Failed to AUTOLOAD 'MainWindow::send" (under windows) or "send to non-secure perl/Tk application rejected" (under linux).

I found this in the perl/tk FAQ:

the script that receives from a Tk::send must run with taint
checking turned on (i.e. with the -T switch thrown) and 
it must untaint all commands received from the other process. 

Apparently this error has to do with me not untainting my data? I tried running the scripts with -T, but its still not working. I'm a newbie to this tainting concept.

Any idea of how to get around this problem?

Here are two progs that works under linux, I have no way to test under windows. You should read "perldoc perlsec" for info about security and tainted data. You untaint data with regexps, remember to be careful.

#!/usr/bin/perl -w

use strict;
use Tk;

my $mw = MainWindow->new();

my $file_name = 'Some file';

$mw->send('Foo' => $file_name);

#!/usr/bin/perl -Tw

use strict;
use Tk;

my $main_window = MainWindow->new(-title => 'My other prog');
$main_window->appname('Foo');

MainLoop;

sub Tk::Receive{
    shift;
    my $string = shift;

    if (my ($file) = $string =~ /^([^-]+)$/){
        print "Got: $file\n";
        exit 0;
    }
    else {
        print "Wrong arg Received\n";
        exit 1;
    }
}
[download]

########## server ####################################
#!/usr/bin/perl
use warnings;
use strict;
use POSIX 'setsid';
use IO::Socket;

$|++;
my $server = new IO::Socket::INET (
      LocalHost => 'localhost',
      LocalPort => '7070',
      Proto => 'tcp',
      Listen => 1,
      Reuse => 1,
             );
 die "Could not create socket: $!\n" unless $server;
$server->autoflush(1);

daemonize();

open(LOG,">/tmp/7070.log") or die "$\n";

while(1){
   while ( my $client = $server->accept() ){
      sysread($client, my $buf, 100);
      syswrite(LOG, "$buf\n");
      LOG->flush;
      }
}

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

sub daemonize {
  chdir '/' or die "Can't chdir to /: $!";
  open STDIN, '/dev/null' or die "Can't read /dev/null: $!";
  open STDOUT, '>/dev/null'
          or die "Can't write to /dev/null: $!";
  defined(my $pid = fork)       or die "Can't fork: $!";
  exit if $pid;
  setsid or die "Can't start a new session: $!";
  open STDERR, '>&STDOUT'       or die "Can't dup stdout: $!";
}
__END__
#################################
#################################
#################################

############ client #############################
#!/usr/bin/perl
use warnings;
use strict;
use IO::Socket;

$|++;

while(1){

my $sock = new IO::Socket::INET (
      PeerAddr => 'localhost',
      PeerPort => '7070',
      Proto => 'tcp',
         );
  die "Could not create socket: $!\n" unless $sock;

$sock->autoflush(1);

# Send a transmission 
  print $sock time,"\n";
  print time,"\n";
  close ($sock);

sleep(1);
}
exit 0;
[download]

Uh oh, unexpected problem here...

I can't merge your excellent IO::Socket code with my code that uses Tk, can I?

Because your example loops waiting for client messages, whereas my current code using Tk needs to go off to Tk::MainLoop, right?

Maybe for this application, it would be better for me to get the Tk send method to work (but I am stuck at the moment; see my reply above)

hmmmmmm.....any ideas?

Oh Yeah, you can use sockets with Tk, you just need to use fileevent to listen. I'll whip up a little demo, and post in later today.

---

I'm not really a human, but I play one on earth. flash japh

Well that example worked perfectly right off the bat - and it didn't require Tk or any modules that I didn't have preinstalled already.

Great work - thanks!!!

You can also add a repeat sub to repeatedly check the latest time stamp in the text widget, and raise an alarm if one is missing.

#!/usr/bin/perl
use strict;
use warnings;
use IO::Socket;
use Tk;

$|=1;
$SIG{PIPE} = 'IGNORE';

my $listen = IO::Socket::INET->new(
    Proto       => 'tcp',
    LocalPort   => 7070,
    Listen      => 1,
    Reuse       => 1,
) or die "Can't create listen socket : $!\n";

my $mw = MainWindow->new();

my $text = $mw->Scrolled('Text',
                  -background =>'black',
                  -foreground => 'yellow',
                 )->pack();

my $subframe = $mw->Frame()->pack();

$subframe->Button(-text => 'Clear',
         -command => sub {
                      $text->delete('1.0','end');
                   })->pack(-side=>'left');

$subframe->Button(-text => 'Save Log',
         -command => sub {   })->pack(-side=>'left');

$subframe->Button(-text => 'Exit',
         -command => sub { exit  })->pack(-side=>'right');


$mw->fileevent($listen, 'readable', sub { new_connection($listen) });

my $repeater = $mw->repeat(10000, 
          sub{ $text->insert('end',"Checking stuff";
                #do stuff here
                });


Tk::MainLoop;

sub new_connection {
    my ($listen) = @_;
    my $client = $listen->accept() or warn "Can't accept connection";
    $client->autoflush(1);
    $mw->fileevent($client, 'readable', sub { handle_connection($clien
+t) });
    #$client->print("Connected\n"); 
    $text->insert('end', "Connected\t");
    $text->see('end');
}

sub handle_connection {
    my ($client) = @_;
    my $message = <$client>;
    if (defined $message and $message !~ /^quit/) {
     $message =~ s/[\r\n]+$//;
     #$client->print("Got message [$message]\n"); #echo back if wanted
+ 
     $text->insert('end', "Got message [$message]\t");
     $text->see('end');
    }
    else {
       $text->insert('end', "Connection Closed\n");
       $text->see('end');
       $client->close();
    }
}
[download]

Thanks again for the excellent script. It works great in linux (kinda quirky in windows for some reason though).

Regarding the previous script above of yours (with the deamonized server), how would I change the IP's if I want the client script to talk to the server script running on a different box? I couldn't get it working on different boxes...

Just change the "localhost" to the numerical IP address that you want. For the server, set it to the ip address of the ethernet card, or whatever is exposed to the net, like 207.199.045.345. Do the same on the client. You may have firewall problems too. Whatever port you have opened, must be allowed to pass through the firewall, that goes for intranets too. A good firewall, also controls ports on the "local network".

---

I'm not really a human, but I play one on earth. flash japh