Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 127 lines (114 sloc) 3.692 kb
60c9a5a @tokuhirom initial import
authored
1 use strict;
2 use warnings;
3 use IO::Socket::INET;
4
5 {
6 package Gearman::Client::Status;
7
8 sub new {
9 my $class = shift;
10 my %args = @_==1 ? %{$_[0]} : @_;
11 my $self = bless {
12 host => '127.0.0.1',
13 port => '7003',
14 %args
15 }, $class;
16 my $sock = IO::Socket::INET->new(
17 PeerAddr => $self->{host},
18 PeerPort => $self->{port}
19 ) // die "cannet open port: $!$@";
20 $self->{sock} = $sock;
21 return $self;
22 }
23
24 sub get_version {
25 my ($self) = @_;
26 my $sock = $self->{sock};
27 print {$sock} "version\n";
28 my $ver = <$sock>;
29 return $ver;
30 }
31
32 # FUNCTION\tTOTAL\tRUNNING\tAVAILABLE_WORKERS
33 sub get_stats {
34 my ($self) = @_;
35 my $word = "status\n";
36 my $sock = $self->{sock};
37 print {$sock} $word;
38 my @cols;
39 while (my $line = <$sock>) {
40 last if $line eq ".\n";
41 push @cols, [split /\s/, $line];
42 }
43 return wantarray ? @cols : \@cols;
44 }
45
46 # FD IP-ADDRESS CLIENT-ID : FUNCTION ...
47 # 7 127.0.0.1 lywnwtelzjztcrbbemxnmtsgvkayxv : hoge
48 sub get_workers {
49 my ($self, ) = @_;
50 my $word = "workers\n";
51 my $sock = $self->{sock};
52 print {$sock} $word;
53 my @cols;
54 while (my $line = <$sock>) {
55 last if $line eq ".\n";
56 if ($line =~ /^(\d+)\s+(\S+)\s+(\S+)\s+:\s*(.*)\n$/) {
57 push @cols, [$1, $2, $3, $4];
58 } else {
59 warn "SKIP $line";
60 last;
61 }
62 }
63 return wantarray ? @cols : \@cols;
64 }
65 }
66
67 my $host = $ENV{GEARMAN_STAT_HOST} || '127.0.0.1';
68 my $port = $ENV{GEARMAN_STAT_PORT} || 7003;
69
70 my $client = Gearman::Client::Status->new(host => $host, port => $port);
71
72 my $app = sub {
73 my $html = <<'...';
74 <!doctype html>
75 <html>
76 <head>
77 <title>Gearman Status</title>
78 <style type='text/css'>
79 body{ font-family: 'Trebuchet MS';color: #444;background: #f9f9f9;}
80 h1 {background: #eee;border: 1px solid #ddd;padding: 3px;text-shadow: #ccc 1px 1px 0;color: #756857;text-transform:uppercase;}
81 h2 {padding: 3px;text-shadow: #ccc 1px 1px 0;color: #ACA39C;text-transform:uppercase;border-bottom: 1px dotted #ddd;display: inline-block;}
82 hr {color: transparent;}
83 table{width: 100%;border: 1px solid #ddd;border-spacing:0px;}
84 table th {border-bottom: 1px dotted #ddd;background: #eee;padding: 5px;font-size: 15px;text-shadow: #fff 1px 1px 0;}
85 table td {text-align: center;padding: 5px;font-size: 13px;color: #444;text-shadow: #ccc 1px 1px 0;}
86 </style>
87 </head>
88 <body>
89 <h1>Gearman Server Status</h1>
90 ...
91 $html .= q{<div class="version">Server Version: } . $client->get_version() . "</div>\n";
92
93 $html .= <<'...';
94 <h2>Workers</h2>
95 <table border='0'>
96 <tr><th>File Descriptor</th><th>IP Address</th><th>Client ID</th><th>Function</th></tr>
97 ...
98 for my $row ($client->get_workers()) {
99 $html .= sprintf(qq{<tr><td>%d</td><td>%s</td><td>%s</td><td>%s</td></tr>\n}, @$row);
100 }
101 $html .= <<'...';
102 </table>
103
104 <h2>Status</h2>
105 <table border='0'>
106 <tr><th>Function</th><th>Total</th><th>Running</th><th>Available Workers</th></tr>
107 ...
108 for my $row ($client->get_stats()) {
109 $html .= sprintf(qq{<tr><td>%s</td><td>%s</td><td>%s</td><td>%s</td></tr>\n}, @$row);
110 }
111 $html .= <<'...';
112 </table>
113 </body>
114 </html>
115 ...
116
117 return [
118 200,
119 [
120 'Content-Type' => 'text/html; charset=utf-8',
121 'Content-Length' => length($html)
122 ],
123 [$html]
124 ];
125 };
126
Something went wrong with that request. Please try again.