X-Git-Url: http://www.dxcluster.org/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FDXCommandmode.pm;h=d48de1c87a17d3edac8e27f358e3a21e46c2dd86;hb=20b0104deaeab77fa7ab1444dbcedfcdbf5865f8;hp=d8e1ac1048c1d4bb226280e9f8adc8803b820851;hpb=0121434f428d8e7d1f31a9d69a4ee250b952b468;p=spider.git diff --git a/perl/DXCommandmode.pm b/perl/DXCommandmode.pm index d8e1ac10..d48de1c8 100644 --- a/perl/DXCommandmode.pm +++ b/perl/DXCommandmode.pm @@ -15,6 +15,7 @@ use DXUtil; use DXChannel; use DXUser; use DXVars; +use DXDebug; use strict; use vars qw( %Cache $last_dir_mtime @cmd); @@ -28,16 +29,20 @@ $last_dir_mtime = 0; # the last time one of the cmd dirs was modified sub start { - my $self = shift; + my ($self, $line) = @_; my $user = $self->{user}; my $call = $self->{call}; - my $name = $self->{name}; - $name = $call if !defined $name; - $self->msg('l2',$name); + my $name = $user->{name}; + + $self->{name} = $name ? $name : $call; + $self->msg('l2',$self->{name}); $self->send_file($main::motd) if (-e $main::motd); $self->msg('pr', $call); $self->state('prompt'); # a bit of room for further expansion, passwords etc - $self->{priv} = 0; # set the connection priv to 0 - can be upgraded later + $self->{priv} = $user->priv; + $self->{priv} = 0 if $line =~ /^(ax|te)/; # set the connection priv to 0 - can be upgraded later + $self->{consort} = $line; # save the connection type + $self->sort('U'); # set the channel type } # @@ -88,7 +93,19 @@ sub normal # sub process { + my $t = time; + my @chan = DXChannel->get_all(); + my $chan; + + foreach $chan (@chan) { + next if $chan->sort ne 'U'; + # send a prompt if no activity out on this channel + if ($t >= $chan->t + $main::user_interval) { + $chan->prompt() if $chan->{state} =~ /^prompt/o; + $chan->t($t); + } + } } # @@ -162,7 +179,7 @@ sub eval_file { my $path = shift; my $cmdname = shift; my $package = valid_package_name($cmdname); - my $filename = "$path/$cmdname"; + my $filename = "$path/$cmdname.pl"; my $mtime = -M $filename; # return if we can't find it @@ -184,7 +201,14 @@ sub eval_file { #wrap the code into a subroutine inside our unique package my $eval = qq{package DXChannel; sub $package { $sub; }}; - print "eval $eval\n"; + if (isdbg('eval')) { + my @list = split /\n/, $eval; + my $line; + foreach (@list) { + dbg('eval', $_, "\n"); + } + } + #print "eval $eval\n"; { #hide our variables within this block my($filename,$mtime,$package,$sub); @@ -201,7 +225,7 @@ sub eval_file { my @r; my $c = qq{ \@r = \$self->$package(\@_); }; - print "c = $c\n"; + dbg('eval', "cluster cmd = $c\n"); eval $c; ; if ($@) { delete_package($package);