This is the same module as posted earlier but now rewritten in XS. I've
tested it by putting the test file in the main test suite, since I cannot
test it yet in the sub-project dir, so I won't commit the test till it'll
be possible to run tests in the sub-projects:
--- /dev/null Thu Jan 1 07:30:00 1970
+++ Apache-Scoreboard/apxs/send.c Fri Apr 5 23:53:15 2002
@@ -0,0 +1,62 @@
+#define REMOTE_SCOREBOARD_TYPE "application/x-httpd-scoreboard"
+
+#ifndef Move
+#define Move(s,d,n,t) (void)memmove((char*)(d),(char*)(s), (n) * sizeof(t))
+#endif
+#ifndef Copy
+#define Copy(s,d,n,t) (void)memcpy((char*)(d),(char*)(s), (n) * sizeof(t))
+#endif
+
+#define SIZE16 2
+
+static void pack16(unsigned char *s, int p)
+{
+ short ashort = htons(p);
+ Move(&ashort, s, SIZE16, unsigned char);
+}
+
+static unsigned short unpack16(unsigned char *s)
+{
+ unsigned short ashort;
+ Copy(s, &ashort, SIZE16, char);
+ return ntohs(ashort);
+}
+
+
+#define WRITE_BUFF(buf, size, r) \
+ if (ap_rwrite(buf, size, r) < 0) { return APR_EGENERAL; }
+
+static int scoreboard_send(request_rec *r)
+{
+ int i, psize, ssize, tsize;
+ char buf[SIZE16*2];
+ char *ptr = buf;
+
+ for (i = 0; i < server_limit; i++) {
+ if (!ap_scoreboard_image->parent[i].pid) {
+ break;
+ }
+ }
+
+ psize = i * sizeof(process_score);
+ ssize = i * sizeof(worker_score);
+ tsize = psize + ssize + sizeof(global_score) + sizeof(buf);
+
+ pack16(ptr, psize);
+ ptr += SIZE16;
+ pack16(ptr, ssize);
+
+ ap_set_content_length(r, tsize);
+ r->content_type = REMOTE_SCOREBOARD_TYPE;
+
+ if (!r->header_only) {
+ WRITE_BUFF(&buf[0], sizeof(buf), r);
+ WRITE_BUFF(&ap_scoreboard_image->parent[0], psize, r);
+ WRITE_BUFF(&ap_scoreboard_image->servers[0], ssize, r);
+ WRITE_BUFF(&ap_scoreboard_image->global, sizeof(global_score), r);
+ }
+
+ return APR_SUCCESS;
+}
+
+
--- /dev/null Thu Jan 1 07:30:00 1970
+++ Apache-Scoreboard/Scoreboard.pm Sat Apr 6 02:33:44 2002
@@ -0,0 +1,305 @@
+package Apache::Scoreboard;
+
+use strict;
+use constant DEBUG => 0;
+
+BEGIN {
+ no strict;
+ $VERSION = '0.01';
+ @ISA = qw(DynaLoader);
+ if ($ENV{MOD_PERL}) {
+ __PACKAGE__->bootstrap($VERSION);
+ }
+ else {
+ require Apache::DummyScoreboard;
+ }
+}
+
+my $ua;
+
+sub http_fetch {
+ my($self, $url) = @_;
+
+ require LWP::UserAgent;
+ unless ($ua) {
+ no strict 'vars';
+ $ua = LWP::UserAgent->new;
+ $ua->agent(join '/', __PACKAGE__, $VERSION);
+ }
+
+ my $request = HTTP::Request->new('GET', $url);
+ my $response = $ua->request($request);
+ unless ($response->is_success) {
+ warn "request failed: ", $response->status_line if DEBUG;
+ return undef;
+ }
+
+ my $type = $response->header('Content-type');
+ unless ($type eq Apache::Scoreboard::REMOTE_SCOREBOARD_TYPE) {
+ warn "invalid scoreboard Content-type: $type" if DEBUG;
+ return undef;
+ }
+
+ $response->content;
+}
+
+sub fetch {
+ my($self, $pool, $url) = @_;
+ $self->thaw($pool, $self->http_fetch($url));
+}
+
+sub fetch_store {
+ my($self, $url, $file) = @_;
+ $self->store($self->http_fetch($url), $file);
+}
+
+sub store {
+ my($self, $frozen_image, $file) = @_;
+ open my $fh, ">$file" or die "open $file: $!";
+ print $fh $frozen_image;
+ close $fh;
+}
+
+sub retrieve {
+ my($self, $pool, $file) = @_;
+ open my $fh, $file or die "open $file: $!";
+ local $/;
+ my $data = <$fh>;
+ close $fh;
+ $self->thaw($pool, $data);
+}
+
+1;
+__END__
+
+=head1 NAME
+
+Apache::Scoreboard - Perl interface to the Apache scoreboard structure
+
+=head1 SYNOPSIS
+
+ use Apache::Scoreboard ();
+
+ #inside httpd
+ my $image = Apache::Scoreboard->image;
+
+ #outside httpd
+ my $image = Apache::Scoreboard->fetch("http://localhost/scoreboard";);
+
+=head1 DESCRIPTION
+
+Apache keeps track of server activity in a structure known as the
+I<scoreboard>. There is a I<slot> in the scoreboard for each child
+server, containing information such as status, access count, bytes
+served and cpu time. This same information is used by I<mod_status>
+to provide current server statistics in a human readable form.
+
+=head1 METHODS
+
+=over 4
+
+=item image
+
+This method returns an object for accessing the scoreboard structure
+when running inside the server:
+
+ my $image = Apache::Scoreboard->image;
+
+=item fetch
+
+This method fetches the scoreboard structure from a remote server,
+which must contain the following configuration:
+
+ PerlModule Apache::Scoreboard
+ <Location /scoreboard>
+ SetHandler perl-script
+ PerlHandler Apache::Scoreboard::send
+ order deny,allow
+ deny from all
+ #same config you have for mod_status
+ allow from 127.0.0.1 ...
+ </Location>
+
+If the remote server is not configured to use mod_perl or simply for a
+smaller footprint, see the I<apxs> directory for I<mod_scoreboard_send>:
+
+ LoadModule scoreboard_send_module libexec/mod_scoreboard_send.so
+
+ <Location /scoreboard>
+ SetHandler scoreboard-send-handler
+ order deny,allow
+ deny from all
+ allow from 127.0.0.1 ...
+ </Location>
+
+The image can then be fetched via http:
+
+ my $image = Apache::Scoreboard->fetch("http://remote-hostname/scoreboard";);
+
+=item fetch_store
+
+=item retrieve
+
+The I<fetch_store> method is used to fetch the image once from and
+remote server and save it to disk. The image can then be read by
+other processes with the I<retrieve> function.
+This way, multiple processes can access a remote scoreboard with just
+a single request to the remote server. Example:
+
+ Apache::Scoreboard->fetch_store($url, $local_filename);
+
+ my $image = Apache::Scoreboard->retrieve($local_filename);
+
+=item parent
+
+This method returns a reference to the first parent score entry in the
+list, blessed into the I<Apache::ParentScore> class:
+
+ my $parent = $image->parent;
+
+Iterating over the list of scoreboard slots is done like so:
+
+ for (my $parent = $image->parent; $parent; $parent = $parent->next) {
+ my $pid = $parent->pid; #pid of the child
+
+ my $server = $parent->server; #Apache::ServerScore object
+
+ ...
+ }
+
+=item pids
+
+Returns an array reference of all child pids:
+
+ my $pids = $image->pids;
+
+=back
+
+=head2 The Apache::ParentScore Class
+
+=over 4
+
+=item pid
+
+The parent keeps track of child pids with this field:
+
+ my $pid = $parent->pid;
+
+=item server
+
+Returns a reference to the corresponding I<Apache::ServerScore>
+structure:
+
+ my $server = $parent->server;
+
+=item next
+
+Returns a reference to the next I<Apache::ParentScore> object in the list:
+
+ my $p = $parent->next;
+
+=back
+
+=head2 The Apache::ServerScore Class
+
+=over 4
+
+=item status
+
+This method returns the status of child server, which is one of:
+
+ "_" Waiting for Connection
+ "S" Starting up
+ "R" Reading Request
+ "W" Sending Reply
+ "K" Keepalive (read)
+ "D" DNS Lookup
+ "L" Logging
+ "G" Gracefully finishing
+ "." Open slot with no current process
+
+=item access_count
+
+The access count of the child server:
+
+ my $count = $server->access_count;
+
+=item request
+
+The first 64 characters of the HTTP request:
+
+ #e.g.: GET /scoreboard HTTP/1.0
+ my $request = $server->request;
+
+=item client
+
+The ip address or hostname of the client:
+
+ #e.g.: 127.0.0.1
+ my $client = $server->client;
+
+=item bytes_served
+
+Total number of bytes served by this child:
+
+ my $bytes = $server->bytes_served;
+
+=item conn_bytes
+
+Number of bytes served by the last connection in this child:
+
+ my $bytes = $server->conn_bytes;
+
+=item conn_count
+
+Number of requests served by the last connection in this child:
+
+ my $count = $server->conn_count;
+
+=item times
+
+In a list context, returns a four-element list giving the user and
+system times, in seconds, for this process and the children of this
+process.
+
+ my($user, $system, $cuser, $csystem) = $server->times;
+
+In a scalar context, returns the overall CPU percentage for this server:
+
+ my $cpu = $server->times;
+
+=item start_time
+
+In a list context this method returns a 2 element list with the seconds and
+microseconds since the epoch, when the request was started. In scalar
+context it returns floating seconds like Time::HiRes::time()
+
+ my($tv_sec, $tv_usec) = $server->start_time;
+
+ my $secs = $server->start_time;
+
+=item stop_time
+
+In a list context this method returns a 2 element list with the seconds and
+microseconds since the epoch, when the request was finished. In scalar
+context it returns floating seconds like Time::HiRes::time()
+
+ my($tv_sec, $tv_usec) = $server->stop_time;
+
+ my $secs = $server->stop_time;
+
+=item req_time
+
+Returns the time taken to process the request in microseconds:
+
+ my $req_time = $server->req_time;
+
+=back
+
+=head1 SEE ALSO
+
+Apache::VMonitor(3), GTop(3)
+
+=head1 AUTHOR
+
+Doug MacEachern
--- /dev/null Thu Jan 1 07:30:00 1970
+++ Apache-Scoreboard/Scoreboard.xs Sat Apr 6 20:53:29 2002
@@ -0,0 +1,617 @@
+#define PERL_NO_GET_CONTEXT /* we want efficiency */
+/* #include "xs/modperl_xs_typedefs.h" */
+#include "mod_perl.h"
+#include "modperl_xs_sv_convert.h"
+#include "modperl_xs_typedefs.h"
+
+#include "scoreboard.h"
+
+/* scoreboard */
+typedef struct {
+ scoreboard *sb;
+ apr_pool_t *pool;
+} modperl_scoreboard_t;
+
+typedef struct {
+ worker_score record;
+ int parent_idx;
+ int worker_idx;
+} modperl_worker_score_t;
+
+typedef struct {
+ process_score record;
+ int idx;
+ scoreboard *sb;
+ apr_pool_t *pool;
+} modperl_parent_score_t;
+
+typedef modperl_scoreboard_t *Apache__Scoreboard;
+typedef modperl_worker_score_t *Apache__ScoreboardWorkerScore;
+typedef modperl_parent_score_t *Apache__ScoreboardParentScore;
+
+/* XXX: When documenting don't forget to add the new 'vhost' accessor */
+/* and port accessor if it gets added (need to add it here too) */
+
+int server_limit, thread_limit;
+
+static char status_flags[SERVER_NUM_STATUS];
+
+#define scoreboard_up_time(image) \
+ (apr_uint32_t)((apr_time_now() - image->sb->global->restart_time) /
+APR_USEC_PER_SEC);
+
+#define parent_score_pid(mps) mps->record.pid
+
+#define worker_score_most_recent(mws) \
+ (apr_uint32_t)((apr_time_now() - mws->record.last_used) / APR_USEC_PER_SEC);
+
+#define worker_score_access_count(mws) mws->record.access_count
+#define worker_score_bytes_served(mws) mws->record.bytes_served
+#define worker_score_my_access_count(mws) mws->record.my_access_count
+#define worker_score_my_bytes_served(mws) mws->record.my_bytes_served
+#define worker_score_conn_bytes(mws) mws->record.conn_bytes
+#define worker_score_conn_count(mws) mws->record.conn_count
+#define worker_score_client(mws) mws->record.client
+#define worker_score_request(mws) mws->record.request
+#define worker_score_vhost(mws) mws->record.vhost
+
+/* a worker that have served/serves at least one request and isn't
+ * dead yet */
+#define LIVE_WORKER(ws) ws.access_count != 0 || \
+ ws.status != SERVER_DEAD
+
+/* a worker that does something at this very moment */
+#define ACTIVE_WORKER(ws) ws.access_count != 0 || \
+ (ws.status != SERVER_DEAD && ws.status != SERVER_READY)
+
+
+
+
+
+static void status_flags_init(void)
+{
+ status_flags[SERVER_DEAD] = '.';
+ status_flags[SERVER_READY] = '_';
+ status_flags[SERVER_STARTING] = 'S';
+ status_flags[SERVER_BUSY_READ] = 'R';
+ status_flags[SERVER_BUSY_WRITE] = 'W';
+ status_flags[SERVER_BUSY_KEEPALIVE] = 'K';
+ status_flags[SERVER_BUSY_LOG] = 'L';
+ status_flags[SERVER_BUSY_DNS] = 'D';
+ status_flags[SERVER_CLOSING] = 'C';
+ status_flags[SERVER_GRACEFUL] = 'G';
+ status_flags[SERVER_IDLE_KILL] = 'I';
+}
+
+#include "apxs/send.c"
+
+MODULE = Apache::Scoreboard PACKAGE = Apache::Scoreboard PREFIX = scoreboard_
+
+BOOT:
+{
+ HV *stash;
+
+ /* XXX: this must be performed only once and before other threads are spawned.
+ * but not sure. could be that need to use local storage.
+ *
+ */
+ status_flags_init();
+
+ ap_mpm_query(AP_MPMQ_HARD_LIMIT_THREADS, &thread_limit);
+ ap_mpm_query(AP_MPMQ_HARD_LIMIT_DAEMONS, &server_limit);
+
+ stash = gv_stashpv("Apache::Const", TRUE);
+ newCONSTSUB(stash, "SERVER_LIMIT", newSViv(server_limit));
+
+ stash = gv_stashpv("Apache::Const", TRUE);
+ newCONSTSUB(stash, "THREAD_LIMIT", newSViv(thread_limit));
+
+ stash = gv_stashpv("Apache::Scoreboard", TRUE);
+ newCONSTSUB(stash, "REMOTE_SCOREBOARD_TYPE",
+ newSVpv(REMOTE_SCOREBOARD_TYPE, 0));
+}
+
+int
+scoreboard_send(r)
+ Apache::RequestRec r
+
+
+
+SV *
+freeze(image)
+ Apache::Scoreboard image
+
+ PREINIT:
+ int i, psize, ssize, tsize;
+ char buf[SIZE16*2];
+ char *dptr, *data, *ptr = buf;
+ scoreboard *sb;
+
+ CODE:
+ sb = image->sb;
+
+ for (i = 0; i < server_limit; i++) {
+ if (!sb->parent[i].pid) {
+ break;
+ }
+ }
+
+ psize = i * sizeof(process_score);
+ ssize = i * sizeof(worker_score);
+ tsize = psize + ssize + sizeof(global_score) + sizeof(buf);
+ /* fprintf(stderr, "sizes %d, %d, %d, %d, %d, %d\n",
+ i, psize, ssize, sizeof(global_score) , sizeof(buf), tsize); */
+
+ data = (char *)apr_palloc(image->pool, tsize);
+
+ pack16(ptr, psize);
+ ptr += SIZE16;
+ pack16(ptr, ssize);
+
+ /* fill the data buffer with the data we want to freeze */
+ dptr = data;
+ Move(buf, dptr, sizeof(buf), char);
+ dptr += sizeof(buf);
+ Move(&sb->parent[0], dptr, psize, char);
+ dptr += psize;
+ Move(&sb->servers[0], dptr, ssize, char);
+ dptr += ssize;
+ Move(&sb->global, dptr, sizeof(global_score), char);
+
+ /* an equivalent C function can return 'data', in case of XS it'll
+ * try to convert char *data to PV, using strlen(), which will
+ * lose data, since it won't continue past the first \0
+ * char. Therefore in this case we explicitly return SV* and using
+ * newSVpvn(data, tsize) to tell the exact size */
+ RETVAL = newSVpvn(data, tsize);
+
+ OUTPUT:
+ RETVAL
+
+Apache::Scoreboard
+thaw(CLASS, pool, packet)
+ SV *CLASS
+ APR::Pool pool
+ SV *packet
+
+ PREINIT:
+ modperl_scoreboard_t *image;
+ scoreboard *sb;
+ int psize, ssize;
+ char *ptr;
+
+ CODE:
+ if (!(SvOK(packet) && SvCUR(packet) > (SIZE16*2))) {
+ XSRETURN_UNDEF;
+ }
+
+ CLASS = CLASS; /* avoid warnings */
+
+ image = (modperl_scoreboard_t *)apr_palloc(pool, sizeof(*image));
+ sb = (scoreboard *)apr_palloc(pool, sizeof(scoreboard));
+ sb->parent = (process_score *)apr_palloc(pool, sizeof(process_score *));
+ sb->servers = (worker_score **)apr_palloc(pool, server_limit *
+sizeof(worker_score));
+ sb->global = (global_score *)apr_palloc(pool, sizeof(global_score *));
+
+ ptr = SvPVX(packet);
+ psize = unpack16(ptr);
+ ptr += SIZE16;
+ ssize = unpack16(ptr);
+ ptr += SIZE16;
+
+ Move(ptr, &sb->parent[0], psize, char);
+ ptr += psize;
+ Move(ptr, &sb->servers[0], ssize, char);
+ ptr += ssize;
+ Move(ptr, &sb->global, sizeof(global_score), char);
+
+ image->pool = pool;
+ image->sb = sb;
+
+ RETVAL = image;
+
+ OUTPUT:
+ RETVAL
+
+Apache::Scoreboard
+image(CLASS, pool)
+ SV *CLASS
+ APR::Pool pool
+
+ CODE:
+ RETVAL = (modperl_scoreboard_t *)apr_palloc(pool, sizeof(*RETVAL));
+
+ if (ap_exists_scoreboard_image()) {
+ RETVAL->sb = ap_scoreboard_image;
+ RETVAL->pool = pool;
+ }
+ else {
+ Perl_croak(aTHX_ "ap_scoreboard_image doesn't exist");
+ }
+
+ CLASS = CLASS; /* avoid warnings */
+
+ OUTPUT:
+ RETVAL
+
+Apache::ScoreboardParentScore
+parent_score(self, idx=0)
+ Apache::Scoreboard self
+ int idx
+
+ CODE:
+ if (self->sb->parent[idx].pid) {
+ RETVAL = (modperl_parent_score_t *)apr_pcalloc(self->pool, (sizeof(*RETVAL)));
+ RETVAL->record = self->sb->parent[idx];
+ RETVAL->idx = idx;
+ RETVAL->sb = self->sb;
+ RETVAL->pool = self->pool;
+ }
+ else {
+ XSRETURN_UNDEF;
+ }
+
+ OUTPUT:
+ RETVAL
+
+Apache::ScoreboardWorkerScore
+worker_score(self, parent_idx, worker_idx)
+ Apache::Scoreboard self
+ int parent_idx
+ int worker_idx
+
+ CODE:
+ RETVAL = (modperl_worker_score_t *)apr_pcalloc(self->pool, (sizeof(*RETVAL)));
+
+ RETVAL->record = self->sb->servers[parent_idx][worker_idx];
+ RETVAL->parent_idx = parent_idx;
+ RETVAL->worker_idx = worker_idx;
+
+ OUTPUT:
+ RETVAL
+
+SV *
+pids(self)
+ Apache::Scoreboard self
+
+ PREINIT:
+ AV *av = newAV();
+ int i;
+ scoreboard *sb;
+
+ CODE:
+ sb = self->sb;
+ for (i = 0; i < server_limit; i++) {
+ if (!(sb->parent[i].pid)) {
+ break;
+ }
+ /* fprintf(stderr, "pids: server %d: pid %d\n",
+ i, (int)(sb->parent[i].pid)); */
+ av_push(av, newSViv(sb->parent[i].pid));
+ }
+
+ RETVAL = newRV_noinc((SV*)av);
+
+ OUTPUT:
+ RETVAL
+
+# XXX: need to move pid_t => apr_proc_t and work with pid->pid as in
+# find_child_by_pid from scoreboard.c
+
+int
+parent_idx_by_pid(self, pid)
+ Apache::Scoreboard self
+ pid_t pid
+
+ PREINIT:
+ int i;
+ scoreboard *sb;
+
+ CODE:
+ sb = self->sb;
+ RETVAL = -1;
+
+ for (i = 0; i < server_limit; i++) {
+ if (sb->parent[i].pid == pid) {
+ RETVAL = i;
+ break;
+ }
+ }
+
+ OUTPUT:
+ RETVAL
+
+SV *
+thread_numbers(self, parent_idx)
+ Apache::Scoreboard self
+ int parent_idx
+
+ PREINIT:
+ AV *av = newAV();
+ int i;
+ scoreboard *sb;
+
+ CODE:
+ sb = self->sb;
+
+ for (i = 0; i < thread_limit; ++i) {
+ /* fprintf(stderr, "thread_num: server %d, thread %d pid %d\n",
+ i, sb->servers[parent_idx][i].thread_num,
+ (int)(sb->parent[parent_idx].pid)); */
+
+ av_push(av, newSViv(sb->servers[parent_idx][i].thread_num));
+ }
+
+ RETVAL = newRV_noinc((SV*)av);
+
+ OUTPUT:
+ RETVAL
+
+apr_uint32_t
+scoreboard_up_time(self)
+ Apache::Scoreboard self
+
+MODULE = Apache::Scoreboard PACKAGE = Apache::ScoreboardParentScore PREFIX =
+parent_score_
+
+Apache::ScoreboardParentScore
+next(self)
+ Apache::ScoreboardParentScore self
+
+ PREINIT:
+ int next_idx;
+
+ CODE:
+ next_idx = self->idx + 1;
+
+ if (self->sb->parent[next_idx].pid) {
+ RETVAL = (modperl_parent_score_t *)apr_pcalloc(self->pool, sizeof(*RETVAL));
+ RETVAL->record = self->sb->parent[next_idx];
+ RETVAL->idx = next_idx;
+ RETVAL->sb = self->sb;
+ RETVAL->pool = self->pool;
+ }
+ else {
+ XSRETURN_UNDEF;
+ }
+
+ OUTPUT:
+ RETVAL
+
+Apache::ScoreboardWorkerScore
+worker_score(self)
+ Apache::ScoreboardParentScore self
+
+ CODE:
+ RETVAL = (modperl_worker_score_t *)apr_pcalloc(self->pool, sizeof(*RETVAL));
+ RETVAL->record = self->sb->servers[self->idx][0];
+ RETVAL->parent_idx = self->idx;
+ RETVAL->worker_idx = 0;
+
+ OUTPUT:
+ RETVAL
+
+Apache::ScoreboardWorkerScore
+next_worker_score(self, mws)
+ Apache::ScoreboardParentScore self
+ Apache::ScoreboardWorkerScore mws
+
+ PREINIT:
+ int next_idx;
+
+ CODE:
+ next_idx = mws->worker_idx + 1;
+ if (next_idx < thread_limit) {
+ RETVAL = (modperl_worker_score_t *)apr_pcalloc(self->pool, sizeof(*RETVAL));
+ RETVAL->record = self->sb->servers[mws->parent_idx][next_idx];
+ RETVAL->parent_idx = mws->parent_idx;
+ RETVAL->worker_idx = next_idx;
+ }
+ else {
+ XSRETURN_UNDEF;
+ }
+
+ OUTPUT:
+ RETVAL
+
+
+Apache::ScoreboardWorkerScore
+next_live_worker_score(self, mws)
+ Apache::ScoreboardParentScore self
+ Apache::ScoreboardWorkerScore mws
+
+ PREINIT:
+ int next_idx;
+ int found = 0;
+
+ CODE:
+ next_idx = mws->worker_idx;
+
+ while (++next_idx < thread_limit) {
+ if (LIVE_WORKER(self->sb->servers[mws->parent_idx][next_idx])) {
+ RETVAL = (modperl_worker_score_t *)apr_pcalloc(self->pool,
+sizeof(*RETVAL));
+ RETVAL->record = self->sb->servers[mws->parent_idx][next_idx];
+ RETVAL->parent_idx = mws->parent_idx;
+ RETVAL->worker_idx = next_idx;
+ found++;
+ break;
+ }
+ }
+
+ if (!found) {
+ XSRETURN_UNDEF;
+ }
+
+ OUTPUT:
+ RETVAL
+
+
+
+Apache::ScoreboardWorkerScore
+next_active_worker_score(self, mws)
+ Apache::ScoreboardParentScore self
+ Apache::ScoreboardWorkerScore mws
+
+ PREINIT:
+ int next_idx;
+ int found = 0;
+
+ CODE:
+ next_idx = mws->worker_idx;
+ while (++next_idx < thread_limit) {
+ if (ACTIVE_WORKER(self->sb->servers[mws->parent_idx][next_idx])) {
+ RETVAL = (modperl_worker_score_t *)apr_pcalloc(self->pool,
+sizeof(*RETVAL));
+ RETVAL->record = self->sb->servers[mws->parent_idx][next_idx];
+ RETVAL->parent_idx = mws->parent_idx;
+ RETVAL->worker_idx = next_idx;
+ found++;
+ break;
+ }
+ }
+
+ if (!found) {
+ XSRETURN_UNDEF;
+ }
+
+ OUTPUT:
+ RETVAL
+
+pid_t
+parent_score_pid(self)
+ Apache::ScoreboardParentScore self
+
+MODULE = Apache::Scoreboard PACKAGE = Apache::ScoreboardWorkerScore PREFIX =
+worker_score_
+
+void
+times(self)
+ Apache::ScoreboardWorkerScore self
+
+ PPCODE:
+ if (GIMME == G_ARRAY) {
+ /* same return values as CORE::times() */
+ EXTEND(sp, 4);
+ PUSHs(sv_2mortal(newSViv(self->record.times.tms_utime)));
+ PUSHs(sv_2mortal(newSViv(self->record.times.tms_stime)));
+ PUSHs(sv_2mortal(newSViv(self->record.times.tms_cutime)));
+ PUSHs(sv_2mortal(newSViv(self->record.times.tms_cstime)));
+ }
+ else {
+#ifdef _SC_CLK_TCK
+ float tick = sysconf(_SC_CLK_TCK);
+#else
+ float tick = HZ;
+#endif
+ if (self->record.access_count) {
+ /* cpu %, same value mod_status displays */
+ float RETVAL = (self->record.times.tms_utime +
+ self->record.times.tms_stime +
+ self->record.times.tms_cutime +
+ self->record.times.tms_cstime);
+ XPUSHs(sv_2mortal(newSVnv((double)RETVAL/tick)));
+ }
+ else {
+
+ XPUSHs(sv_2mortal(newSViv((0))));
+ }
+ }
+
+
+void
+start_time(self)
+ Apache::ScoreboardWorkerScore self
+
+ ALIAS:
+ stop_time = 1
+
+ PREINIT:
+ apr_time_t tp;
+
+ PPCODE:
+ ix = ix; /* warnings */
+ tp = (XSANY.any_i32 == 0) ?
+ self->record.start_time : self->record.stop_time;
+
+ /* fprintf(stderr, "start_time: %5" APR_TIME_T_FMT "\n", tp); */
+
+ /* do the same as Time::HiRes::gettimeofday */
+ if (GIMME == G_ARRAY) {
+ EXTEND(sp, 2);
+ PUSHs(sv_2mortal(newSViv(tp / APR_USEC_PER_SEC)));
+ PUSHs(sv_2mortal(newSViv(tp / APR_USEC_PER_SEC - tp % APR_USEC_PER_SEC )));
+ }
+ else {
+ EXTEND(sp, 1);
+ PUSHs(sv_2mortal(newSVnv((double)tp / APR_USEC_PER_SEC )));
+ }
+
+long
+req_time(self)
+ Apache::ScoreboardWorkerScore self
+
+ CODE:
+ if (self->record.start_time == 0L) {
+ RETVAL = 0L;
+ }
+ else {
+ RETVAL = (long)
+ ((self->record.stop_time - self->record.start_time) / 1000);
+ }
+ if (RETVAL < 0L || !self->record.access_count) {
+ RETVAL = 0L;
+ }
+
+ OUTPUT:
+ RETVAL
+
+SV *
+worker_score_status(self)
+ Apache::ScoreboardWorkerScore self
+
+ CODE:
+ RETVAL = newSV(0);
+ sv_setnv(RETVAL, (double)self->record.status);
+ sv_setpvf(RETVAL, "%c", status_flags[self->record.status]);
+ SvNOK_on(RETVAL); /* dual-var */
+
+ OUTPUT:
+ RETVAL
+
+
+
+unsigned long
+worker_score_access_count(self)
+ Apache::ScoreboardWorkerScore self
+
+unsigned long
+worker_score_bytes_served(self)
+ Apache::ScoreboardWorkerScore self
+
+unsigned long
+worker_score_my_access_count(self)
+ Apache::ScoreboardWorkerScore self
+
+unsigned long
+worker_score_my_bytes_served(self)
+ Apache::ScoreboardWorkerScore self
+
+unsigned long
+worker_score_conn_bytes(self)
+ Apache::ScoreboardWorkerScore self
+
+unsigned short
+worker_score_conn_count(self)
+ Apache::ScoreboardWorkerScore self
+
+char *
+worker_score_client(self)
+ Apache::ScoreboardWorkerScore self
+
+char *
+worker_score_request(self)
+ Apache::ScoreboardWorkerScore self
+
+char *
+worker_score_vhost(self)
+ Apache::ScoreboardWorkerScore self
+
+apr_uint32_t
+worker_score_most_recent(self)
+ Apache::ScoreboardWorkerScore self
--- /dev/null Thu Jan 1 07:30:00 1970
+++ Apache-Scoreboard/Makefile.PL Sat Apr 6 21:42:43 2002
@@ -0,0 +1,95 @@
+#use strict;
+#use warnings FATAL => 'all';
+
+use lib qw(lib ../lib ../Apache-Test/lib);
+use ModPerl::MM qw(test clean);
+
+*MY::test = \&Apache::TestMM::test;
+*MY::clean = \&Apache::TestMM::clean;
+
+use constant HAS_APACHE_TEST => eval {require Apache::Test};
+
+# enable 'make test|clean'
+#use Apache::TestMM qw(test clean);
+
+# enable 'make test|clean'
+#if (HAS_APACHE_TEST) {
+# require Apache::TestMM;
+# Apache::TestMM->import(qw(test clean));
+#} else {
+# warn "consider installing Apache::Test\n";
+#}
+
+# prerequisites
+my %require =
+ (
+ "Apache::Test" => "", # any version will do?
+ );
+
+my @scripts = ();
+
+if (HAS_APACHE_TEST) {
+ # accept the configs from command line
+ Apache::TestMM::filter_args();
+ Apache::TestMM::generate_script('t/TEST');
+ push @scripts, 't/TEST';
+}
+
+ModPerl::MM::WriteMakefile(
+ NAME => 'Apache::Scoreboard',
+ VERSION_FROM => 'Scoreboard.pm',
+ PREREQ_PM => \%require,
+ clean => {
+ FILES => "@{ clean_files() }",
+ },
+);
+
+sub clean_files {
+ return [@scripts];
+}
+
+
+__END__
+
+use ExtUtils::MakeMaker;
+
+use strict;
+use Apache::src ();
+
+my $src = Apache::src->new;
+
+WriteMakefile(
+ 'NAME' => 'Apache::Scoreboard',
+ 'VERSION_FROM' => 'Scoreboard.pm',
+ 'INC' => $src->inc,
+ 'DEFINE' => $src->define,
+ 'TYPEMAPS' => $src->typemaps,
+ 'dist' => {
+ #PREOP => 'pod2text Scoreboard.pm > README',
+ },
+ 'macro' => {
+ CVSROOT => 'modperl.com:/local/cvs_repository',
+ },
+);
+
+sub MY::postamble {
+ return <<'EOF';
+
+cvs_tag :
+ cvs -d $(CVSROOT) tag v$(VERSION_SYM) .
+ @echo update Scoreboard.pm VERSION now
+EOF
+}
+
+sub MY::top_targets {
+ my $self = shift;
+ my $string = $self->MM::top_targets;
+
+ $string .= <<'EOF';
+dummy:
+ cd Dummy && $(PERL) Makefile.PL -g
+
+EOF
+
+ $string;
+}
--- /dev/null Thu Jan 1 07:30:00 1970
+++ Apache-Scoreboard/typemap Sat Apr 6 02:00:04 2002
@@ -0,0 +1,9 @@
+Apache::RequestRec T_APACHEOBJ
+APR::Pool T_PTROBJ
+Apache::Scoreboard T_PTROBJ
+Apache::ScoreboardWorkerScore T_PTROBJ
+Apache::ScoreboardParentScore T_PTROBJ
+pid_t T_IV
+apr_uint32_t T_IV
+#float T_FLOAT
+
__________________________________________________________________
Stas Bekman JAm_pH ------> Just Another mod_perl Hacker
http://stason.org/ mod_perl Guide ---> http://perl.apache.org
mailto:[EMAIL PROTECTED] http://use.perl.org http://apacheweek.com
http://modperlbook.org http://apache.org http://ticketmaster.com
---------------------------------------------------------------------
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
