Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl: the Markov chain saw
 
PerlMonks  

Tk-tool for remote access on win-services

by tos (Deacon)
on Nov 23, 2004 at 12:30 UTC ( #409878=snippet: print w/ replies, xml ) Need Help??

Description: At my workplace i've to do with a bunch of win-servers. Several partially selfwritten services have to be observed for proper working. Therefore i wrote this little Tk-application. With dstat ("dienst-status") services on different win-servers can be observed, stopped and startet. Imho it's a nice example for the far-reaching capabilities of Tk::HList and Win32::Service. dstat.obs (envvar $OBSDIR) contains the servers and services which are to be observed.
#!/usr/bin/perl 

#$Id: dstat,v 0.9 2004/11/23 10:53:32 tos Exp tos $
# gvim: tabstop=3, syntax=perl

use strict;
use warnings;

use URI::File;
use Tk;
use Tk::After;
use Tk::HList;
use Tk::ItemStyle;
use Data::Dumper;
use Win32::Service;

my %RegHash;
use Win32::TieRegistry(TiedHash => \%RegHash, Delimiter=>"/");
my $reg = \%RegHash;

# init vars {{{1

my $cycle = 10000; # milliseconds

my (@fonts) =     (
                '-*-Helvetica-Medium-R-Normal--*-180-*-*-*-*-*-*',
                '-*-Courier-Medium-R-Normal--*-180-*-*-*-*-*-*',
                '-*-times-medium-r-normal--*-240-*-*-*-*-*-*',
                '-Adobe-Courier-Bold-O-Normal--*-120-*-*-*-*-*-*',
                'fixed',
            );

my(@colors) = qw(red gray green blue yellow red cyan black);

my @statCode = (
     ['undefined', 'grey'],
     ['stopped', 'red'],
     ['start pending', 'blue'],
     ['stop pending', 'orange'],
     ['running', 'green'],
     ['continue pending', 'grey'],
     ['pause pending', 'grey'],
     ['paused', 'lightblue'],
);

# }}}1

# widget-related {{{1
my $top = MainWindow->new;

my $h = $top->Scrolled     (qw/HList -header 1 
                                            -columns 5 
                                            -width 90 
                                            -height 40/,
                                            -selectbackground => '#dec
+435'
                                )->pack(qw/-fill both -expand 1/);

my $i;
foreach (qw(server serviceName status displayName description)) {
    $h->header('create', $i++, -text => $_);
}

my @st = (    $top->ItemStyle('text', 
                    -background => 'gray70', 
                    -foreground => 'black', 
                    -selectforeground => 'darkblue', 
                    -font => $fonts[0]),
                $top->ItemStyle('text', 
                    -background => 'gray80', 
                    -foreground => 'black', 
                    -selectforeground => 'darkblue', 
                    -font => $fonts[0])
            );

my $services = readObs();
$top->Button(-text => "erfrischen",
                                -height => 0.3,
                                -command => 
                                sub { updtTable($services); },
                                -font => $fonts[0])
                    ->pack(-side => 'left');

$top->bind('<q>' =>
            sub {
                      exit;
            }); 
# }}}1

getStat($services);
initTable($services);

$top->repeat($cycle, sub{updtTable($services)});

MainLoop;

sub readObs { # {{{1 ------------------------------------------------

    my $AoA;
    my $obsDir =     $ENV{"OBSDIR"} 
                        || "//tux/tos/tc/lab/dvlp/tos/too";

    print "\$obsDir: $obsDir\n";
    open I, "$obsDir/dstat.obs";
    $i = 0;
    while (<I>) {
                    next if /^(#|\s*$)/;
                    s/\s*//g;
                    chomp;
                    @{$AoA->[$i]} = split ',';
                    push @{$AoA->[$i++]}, {};
                    
    }
    close I;
    $AoA;

} # getStat }}}1

sub getStat { # {{{1 ------------------------------------------------

    $top->configure(-cursor => 'watch');

    # @a: (serverName, serviceName, statusStructure, 
    #                    displayName, description)

    my $a = shift;
    foreach (@$a) {

        Win32::Service::GetStatus($_->[0], $_->[1], $_->[2]);

        my $x = $reg                
                            ->{"//" . $_->[0]}
                            ->{"HKEY_LOCAL_MACHINE"}
                            ->{"System"}
                            ->{"ControlSet001"}
                            ->{"Services"}
                            ->{$_->[1]};

        $_->[3] = $x->{"/DisplayName"},"\n";
        $_->[4] = $x->{"/description"},"\n";

    }
    $top->configure(-cursor => 'arrow');

} # getStat }}}1

sub updtTable { # {{{1------------------------------------------------

    # @a: (serverName, serviceName, statusStructure, 
    #                    displayName, description)

    my $a = shift;
    getStat($a);

    my $i = 0;
    for (@$a) {
                
                # itemConfigure auf die 2. Säule liefert mir ein AoA.
                # [3][4] ist 'ne gesegnete hRef auf Tk::Menubutton
                # itemConfigure on second column returns an AoA.
                # [3][4] is a blessed hRef on Tk::Menubutton

                my $mb = $h->itemConfigure($i, 2)->[3][4];
                #print Data::Dumper->Dump([$y], [qw($y)]);

                my $stat = $_->[2]{CurrentState};

                # modifiziere nun ((Menu)button)methodisch die Eigen-
                # schaften
                # modifying properties "((menu)button)methodically" 

                my $x = $mb->configure(-text, $statCode[$stat][0]);
                $x = $mb->configure(-bg, $statCode[$stat][1]);

                $x = $h->itemConfigure($i, 3);
                #print Data::Dumper->Dump([$x], [qw($x)]);

                $h->itemConfigure($i, 3, -text => $_->[3]);
                $h->itemConfigure($i, 4, -text => $_->[4]);

                $i++;
    }

} # updtTable }}}1

sub initTable { # {{{1------------------------------------------------

    # @a: (serverName, DienstName, StatusStruktur, 
    #                    AnzeigeName, Beschreibung)

    my $a = shift;
    my $t;

    for (@$a) {
    
        my $e = $h->addchild("");
        $t = not $t;
        
        for my $col (0 .. 4) {
    
            my $btn;
    
            my $style_type = 'text';
            my $style = $h->ItemStyle($style_type);
    
            if ($col == 2 ) {
                $style_type = 'window';
    
                my $hostNam = $_->[0];
                my $serviceNam = $_->[1];
                
                my $stat = $_->[$col]{CurrentState};
            
                $btn = $h->Menubutton(qw/-relief raised -tearoff 0/,
                                -text => $statCode[$stat][0], 
                                -background => $statCode[$stat][1], 
                                -font => $fonts[0],
                                -activebackground => 'cyan', 
                                -direction => 'right');

                $btn->command(    
                    -label => 'run', 
                    -command => sub {
                                    Win32::Service::StartService(
                                        $hostNam, 
                                        $serviceNam
                                    );
                                    });

                $btn->command(
                    -label => 'stop', 
                    -command => sub {
                                    Win32::Service::StopService(
                                        $hostNam, 
                                            $serviceNam
                                            );
                                        });

            } else {
                
                $style_type = 'text';

            };
    
            $h->itemCreate ($e, $col, 
                            ($style_type eq 'window'
                                ? do {
                                        (
                                            -itemtype => 'window', 
                                            -widget => $btn,
                                        );
                                    }
                                : do {
                                        (
                                            -text => $_->[$col],
                                            -style => $st[$t],
                                        );
                                    }
                            ),
                        );
        }
    }
} # table }}}1
example for a dstat.obs
# cat dstat.obs
jet03a, W32Time
jet03a, netman
jet03a, AudioSrv

sys-10102, W32Time
sys-10102, AudioSrv
sys-10102, stisvc
Comment on Tk-tool for remote access on win-services
Select or Download Code

Back to Snippets Section

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: snippet [id://409878]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others musing on the Monastery: (3)
As of 2014-07-14 00:03 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    When choosing user names for websites, I prefer to use:








    Results (252 votes), past polls