This is a big patch porting Apache::Scoreboard to work with 2.0, with all
the tests working under the latest prefork and worker mpms on perl5.7.3.
Haven't tested it yet with 5.6.1.
Docs are coming. The scoreboard has changed a bit in 2.0 mainly because of
the threads. I've changed a few APIs and struct names and added a few new
APIs.
I've Apache::VMonitor almost perfectly working with it. It works but
still needs a few tweaks, since now we have threads and procs, so it
should be smart to work with both and present a usable monitor :)
Index: src/modules/perl/modperl_apache_includes.h
===================================================================
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_apache_includes.h,v
retrieving revision 1.9
diff -u -r1.9 modperl_apache_includes.h
--- src/modules/perl/modperl_apache_includes.h 29 Jan 2002 05:32:39 -0000 1.9
+++ src/modules/perl/modperl_apache_includes.h 15 Mar 2002 17:47:14 -0000
@@ -51,5 +51,6 @@
#include "util_filter.h"
#include "util_script.h"
+#include "scoreboard.h"
#endif /* MODPERL_APACHE_INCLUDES_H */
Index: src/modules/perl/modperl_types.h
===================================================================
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_types.h,v
retrieving revision 1.56
diff -u -r1.56 modperl_types.h
--- src/modules/perl/modperl_types.h 21 Feb 2002 01:45:34 -0000 1.56
+++ src/modules/perl/modperl_types.h 15 Mar 2002 17:47:14 -0000
@@ -231,4 +231,24 @@
char *path_info;
} modperl_uri_t;
+/* 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;
+
+
#endif /* MODPERL_TYPES_H */
Index: t/conf/extra.conf.in
===================================================================
RCS file: /home/cvs/modperl-2.0/t/conf/extra.conf.in,v
retrieving revision 1.2
diff -u -r1.2 extra.conf.in
--- t/conf/extra.conf.in 26 Feb 2002 19:12:04 -0000 1.2
+++ t/conf/extra.conf.in 15 Mar 2002 17:47:14 -0000
@@ -13,3 +13,12 @@
PerlResponseHandler ModPerl::Registry
PerlOptions +ParseHeaders
</Directory>
+
+# debug
+ExtendedStatus On
+
+ PerlModule Apache::Scoreboard
+ <Location /scoreboard>
+ SetHandler perl-script
+ PerlHandler Apache::Scoreboard::send
+ </Location>
Index: xs/maps/apache_functions.map
===================================================================
RCS file: /home/cvs/modperl-2.0/xs/maps/apache_functions.map,v
retrieving revision 1.45
diff -u -r1.45 apache_functions.map
--- xs/maps/apache_functions.map 10 Mar 2002 00:14:23 -0000 1.45
+++ xs/maps/apache_functions.map 15 Mar 2002 17:47:15 -0000
@@ -324,16 +324,22 @@
ap_close_piped_log
ap_open_piped_log
-!MODULE=Apache::Scoreboard
+MODULE=Apache::Scoreboard
ap_exists_scoreboard_image
ap_sync_scoreboard_image
-ap_update_child_status
+-ap_update_child_status_from_indexes
+-ap_reopen_scoreboard
+-ap_init_scoreboard
+-ap_calc_scoreboard_size
+-ap_create_sb_handle
-ap_time_process_request
-ap_create_scoreboard
ap_cleanup_scoreboard
ap_increment_counts
- ap_get_parent_scoreboard
- ap_get_servers_scoreboard
+ ap_get_scoreboard_worker
+ ap_get_scoreboard_process
+ ap_get_scoreboard_global
!MODULE=Apache::Hooks
ap_location_walk
Index: xs/maps/apache_types.map
===================================================================
RCS file: /home/cvs/modperl-2.0/xs/maps/apache_types.map,v
retrieving revision 1.6
diff -u -r1.6 apache_types.map
--- xs/maps/apache_types.map 10 Sep 2001 06:42:51 -0000 1.6
+++ xs/maps/apache_types.map 15 Mar 2002 17:47:15 -0000
@@ -26,8 +26,10 @@
ap_mgmt_type_e | IV
ap_mgmt_value | UNDEFINED
ap_scoreboard_e | IV
+struct scoreboard | UNDEFINED
struct process_score | UNDEFINED
struct worker_score | UNDEFINED
+struct global_score | UNDEFINED
struct ap_pod_t | UNDEFINED
ap_unix_identity_t | UNDEFINED
Index: xs/maps/modperl_functions.map
===================================================================
RCS file: /home/cvs/modperl-2.0/xs/maps/modperl_functions.map,v
retrieving revision 1.35
diff -u -r1.35 modperl_functions.map
--- xs/maps/modperl_functions.map 29 Jan 2002 17:11:06 -0000 1.35
+++ xs/maps/modperl_functions.map 15 Mar 2002 17:47:15 -0000
@@ -98,3 +98,53 @@
MODULE=Apache::SubProcess
# ap_subprocess_ won't work
modperl_spawn_proc_prog | MPXS_ | ... | spawn_proc_prog
+
+MODULE=Apache::Scoreboard PACKAGE=Apache::Scoreboard BOOT=1
+ mpxs_Apache__Scoreboard_send
+ mpxs_Apache__Scoreboard_freeze
+ mpxs_Apache__Scoreboard_thaw
+ mpxs_Apache__Scoreboard_image
+ mpxs_Apache__Scoreboard_parent_score | | self, idx=0
+ mpxs_Apache__Scoreboard_worker_score
+ mpxs_Apache__Scoreboard_pids
+ mpxs_Apache__Scoreboard_thread_numbers
+ mpxs_Apache__Scoreboard_parent_idx_by_pid
+ apr_uint32_t:DEFINE_up_time | | modperl_scoreboard_t *:self
+
+ mpxs_Apache__Scoreboard_add
+ mpxs_Apache__Scoreboard_print
+ mpxs_Apache__Scoreboard_add_sv
+ mpxs_Apache__Scoreboard_add_sv_sv
+ mpxs_Apache__Scoreboard_add_subst
+ mpxs_Apache__Scoreboard_subst_sp | | ...
+
+MODULE=Apache::Scoreboard PACKAGE=Apache::ScoreboardParentScore
+ mpxs_Apache__ScoreboardParentScore_next
+ mpxs_Apache__ScoreboardParentScore_worker_score
+ mpxs_Apache__ScoreboardParentScore_next_worker_score
+ mpxs_Apache__ScoreboardParentScore_next_live_worker_score
+ mpxs_Apache__ScoreboardParentScore_next_active_worker_score
+ pid_t :DEFINE_pid | | modperl_parent_score_t *:mps
+
+MODULE=Apache::Scoreboard PACKAGE=Apache::ScoreboardWorkerScore
+DEFINE_times | MPXS_Apache__ScoreboardWorkerScore_times | ...
+DEFINE_start_time | MPXS_Apache__ScoreboardWorkerScore_start_time | ...
+DEFINE_stop_time | MPXS_Apache__ScoreboardWorkerScore_stop_time | ...
+ mpxs_Apache__ScoreboardWorkerScore_req_time
+ mpxs_Apache__ScoreboardWorkerScore_status
+ apr_uint32_t :DEFINE_most_recent | | modperl_worker_score_t *:self
+ unsigned long:DEFINE_access_count | | modperl_worker_score_t *:self
+ unsigned long:DEFINE_bytes_served | | modperl_worker_score_t *:self
+ unsigned long:DEFINE_my_access_count | | modperl_worker_score_t *:self
+ unsigned long:DEFINE_my_bytes_served | | modperl_worker_score_t *:self
+ unsigned long:DEFINE_conn_bytes | | modperl_worker_score_t *:self
+ unsigned long:DEFINE_conn_count | | modperl_worker_score_t *:self
+ char * :DEFINE_client | | modperl_worker_score_t *:self
+ char * :DEFINE_request | | modperl_worker_score_t *:self
+ char * :DEFINE_vhost | | modperl_worker_score_t *:self
+
+
+!MODULE=Apache::Scoreboard PACKAGE=Apache::ScoreboardGlobalScore
+
+
+
Index: xs/maps/modperl_types.map
===================================================================
RCS file: /home/cvs/modperl-2.0/xs/maps/modperl_types.map,v
retrieving revision 1.3
diff -u -r1.3 modperl_types.map
--- xs/maps/modperl_types.map 19 Apr 2001 21:26:44 -0000 1.3
+++ xs/maps/modperl_types.map 15 Mar 2002 17:47:15 -0000
@@ -2,6 +2,10 @@
struct modperl_filter_t | Apache::OutputFilter
+struct modperl_scoreboard_t | Apache::Scoreboard
+struct modperl_worker_score_t | Apache::ScoreboardWorkerScore
+struct modperl_parent_score_t | Apache::ScoreboardParentScore
+
########## Perl types ##########
SV * | SV
--- /dev/null Thu Jan 1 07:30:00 1970
+++ xs/Apache/Scoreboard/Apache__Scoreboard.h Sat Mar 16 01:52:55 2002
@@ -0,0 +1,586 @@
+#include "scoreboard.h"
+#include "ap_mpm.h"
+
+#ifndef HZ
+#define HZ 100
+#endif
+
+/* 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 mpxs_Apache__Scoreboard_up_time(image) \
+ (apr_uint32_t)((apr_time_now() - image->sb->global->restart_time) /
+APR_USEC_PER_SEC);
+
+#define mpxs_Apache__ScoreboardWorkerScore_most_recent(mws) \
+ (apr_uint32_t)((apr_time_now() - mws->record.last_used) / APR_USEC_PER_SEC);
+
+#define mpxs_Apache__ScoreboardWorkerScore_access_count(mws)
+mws->record.access_count
+#define mpxs_Apache__ScoreboardWorkerScore_bytes_served(mws)
+mws->record.bytes_served
+#define mpxs_Apache__ScoreboardWorkerScore_my_access_count(mws)
+mws->record.my_access_count
+#define mpxs_Apache__ScoreboardWorkerScore_my_bytes_served(mws)
+mws->record.my_bytes_served
+#define mpxs_Apache__ScoreboardWorkerScore_conn_bytes(mws) mws->record.conn_bytes
+#define mpxs_Apache__ScoreboardWorkerScore_conn_count(mws) mws->record.conn_count
+#define mpxs_Apache__ScoreboardWorkerScore_client(mws) mws->record.client
+#define mpxs_Apache__ScoreboardWorkerScore_request(mws) mws->record.request
+#define mpxs_Apache__ScoreboardWorkerScore_vhost(mws) mws->record.vhost
+
+#define mpxs_Apache__ScoreboardParentScore_pid(ps) ps->record.pid
+
+/* 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)
+
+#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);
+}
+
+
+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';
+}
+
+static void mpxs_Apache__Scoreboard_BOOT(pTHX)
+{
+ 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));
+
+}
+
+#define WRITE_BUFF(buf, size, r) \
+ if (ap_rwrite(buf, size, r) < 0) { return APR_EGENERAL; }
+
+static MP_INLINE
+int mpxs_Apache__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;
+}
+
+static MP_INLINE
+SV *mpxs_Apache__Scoreboard_freeze(pTHX_ modperl_scoreboard_t *image)
+{
+ int i, psize, ssize, tsize;
+ char buf[SIZE16*2];
+ char *dptr, *data, *ptr = buf;
+ scoreboard *sb = image->sb;
+ SV *retval;
+
+ 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);
+ return retval;
+
+
+}
+
+
+static MP_INLINE
+SV *mpxs_Apache__Scoreboard_thaw(pTHX_ SV *Class, apr_pool_t *pool, SV *packet)
+{
+ modperl_scoreboard_t *image;
+ scoreboard *sb;
+ int psize, ssize;
+ char *ptr;
+
+ if (!(SvOK(packet) && SvCUR(packet) > (SIZE16*2))) {
+ return &PL_sv_undef;
+ }
+
+ 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;
+
+ return SvREFCNT_inc(mp_xs_Apache__Scoreboard_2obj(image));
+}
+
+static MP_INLINE
+modperl_scoreboard_t *mpxs_Apache__Scoreboard_image(pTHX_ SV *Class, apr_pool_t *pool)
+{
+ modperl_scoreboard_t *image;
+
+ image = (modperl_scoreboard_t *)apr_palloc(pool, sizeof(*image));
+
+ if (ap_exists_scoreboard_image()) {
+ image->sb = ap_scoreboard_image;
+ image->pool = pool;
+ }
+ else {
+ Perl_croak(aTHX_ "ap_scoreboard_image doesn't exist");
+ }
+
+ return image;
+
+}
+
+static MP_INLINE
+modperl_parent_score_t *mpxs_Apache__Scoreboard_parent_score(modperl_scoreboard_t
+*self, int idx)
+{
+ modperl_parent_score_t *mps;
+
+ if (self->sb->parent[idx].pid) {
+ mps = (modperl_parent_score_t *)apr_pcalloc(self->pool, (sizeof(*mps)));
+ mps->record = self->sb->parent[idx];
+ mps->idx = idx;
+ mps->sb = self->sb;
+ mps->pool = self->pool;
+ return mps;
+ }
+
+ return NULL;
+}
+
+static MP_INLINE
+modperl_worker_score_t *mpxs_Apache__Scoreboard_worker_score(pTHX_
+modperl_scoreboard_t *self,
+ int parent_idx,
+ int worker_idx)
+{
+ modperl_worker_score_t *mws;
+ mws = (modperl_worker_score_t *)apr_pcalloc(self->pool, (sizeof(*mws)));
+
+ mws->record = self->sb->servers[parent_idx][worker_idx];
+ mws->parent_idx = parent_idx;
+ mws->worker_idx = worker_idx;
+
+ return mws;
+}
+
+
+static MP_INLINE
+SV *mpxs_Apache__Scoreboard_pids(pTHX_ modperl_scoreboard_t *self)
+{
+ AV *av = newAV();
+ int i;
+ scoreboard *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));
+ }
+
+ return newRV_noinc((SV*)av);
+
+}
+
+/* XXX: need to move pid_t => apr_proc_t and work with pid->pid as in
+ * find_child_by_pid from scoreboard.c */
+static MP_INLINE
+int mpxs_Apache__Scoreboard_parent_idx_by_pid(pTHX_ modperl_scoreboard_t *self, pid_t
+pid)
+{
+ int i;
+ scoreboard *sb = self->sb;
+
+ for (i = 0; i < server_limit; i++) {
+ if (sb->parent[i].pid == pid) {
+ return i;
+ }
+ }
+
+ return -1;
+}
+
+
+/* return the thread numbers for a certain process idx */
+static MP_INLINE
+SV *mpxs_Apache__Scoreboard_thread_numbers(pTHX_ modperl_scoreboard_t *self, int
+parent_idx)
+{
+ AV *av = newAV();
+ int i;
+ scoreboard *sb = self->sb;
+
+ for (i = 0; i < thread_limit; ++i) {
+ // if (sb->servers[parent_idx][i].thread_num == NULL) {
+ // break;
+ // }
+ 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));
+ }
+
+ return newRV_noinc((SV*)av);
+
+}
+
+
+
+
+
+
+/* *** ParentScore *** */
+
+static MP_INLINE
+SV *mpxs_Apache__ScoreboardParentScore_next(pTHX_ modperl_parent_score_t *self)
+{
+ modperl_parent_score_t *next;
+ SV *retval = NULL;
+ int next_idx = self->idx + 1;
+
+ if (self->sb->parent[next_idx].pid) {
+ next = (modperl_parent_score_t *)apr_pcalloc(self->pool, sizeof(*next));
+ next->record = self->sb->parent[next_idx];
+ next->idx = next_idx;
+ next->sb = self->sb;
+ next->pool = self->pool;
+ retval = mp_xs_Apache__ScoreboardParentScore_2obj(next);
+ }
+
+ return retval ? SvREFCNT_inc(retval) : &PL_sv_undef;
+
+}
+
+static MP_INLINE
+modperl_worker_score_t
+*mpxs_Apache__ScoreboardParentScore_worker_score(modperl_parent_score_t *self)
+{
+ modperl_worker_score_t *mws;
+ mws = (modperl_worker_score_t *)apr_pcalloc(self->pool, sizeof(*mws));
+ mws->record = self->sb->servers[self->idx][0];
+ mws->parent_idx = self->idx;
+ mws->worker_idx = 0;
+ return mws;
+}
+
+
+
+static MP_INLINE
+SV *mpxs_Apache__ScoreboardParentScore_next_worker_score(pTHX_ modperl_parent_score_t
+*self,
+ modperl_worker_score_t *mws)
+{
+ modperl_worker_score_t *next;
+ SV *retval = NULL;
+ int next_idx = mws->worker_idx + 1;
+
+ if (next_idx < thread_limit) {
+ next = (modperl_worker_score_t *)apr_pcalloc(self->pool, sizeof(*next));
+ next->record = self->sb->servers[mws->parent_idx][next_idx];
+ next->parent_idx = mws->parent_idx;
+ next->worker_idx = next_idx;
+ retval = mp_xs_Apache__ScoreboardWorkerScore_2obj(next);
+ }
+
+ return retval ? SvREFCNT_inc(retval) : &PL_sv_undef;
+}
+
+static MP_INLINE
+SV *mpxs_Apache__ScoreboardParentScore_next_live_worker_score(pTHX_
+modperl_parent_score_t *self,
+ modperl_worker_score_t
+*mws)
+{
+ modperl_worker_score_t *next;
+ SV *retval = NULL;
+ int next_idx = mws->worker_idx;
+
+ while (++next_idx < thread_limit) {
+ if (LIVE_WORKER(self->sb->servers[mws->parent_idx][next_idx])) {
+ next = (modperl_worker_score_t *)apr_pcalloc(self->pool, sizeof(*next));
+ next->record = self->sb->servers[mws->parent_idx][next_idx];
+ next->parent_idx = mws->parent_idx;
+ next->worker_idx = next_idx;
+ retval = mp_xs_Apache__ScoreboardWorkerScore_2obj(next);
+ break;
+ }
+ }
+
+ return retval ? SvREFCNT_inc(retval) : &PL_sv_undef;
+
+}
+
+static MP_INLINE
+SV *mpxs_Apache__ScoreboardParentScore_next_active_worker_score(pTHX_
+modperl_parent_score_t *self,
+
+modperl_worker_score_t *mws)
+{
+ modperl_worker_score_t *next;
+ SV *retval = NULL;
+ int next_idx = mws->worker_idx;
+
+ while (++next_idx < thread_limit) {
+ if (ACTIVE_WORKER(self->sb->servers[mws->parent_idx][next_idx])) {
+ next = (modperl_worker_score_t *)apr_pcalloc(self->pool, sizeof(*next));
+ next->record = self->sb->servers[mws->parent_idx][next_idx];
+ next->parent_idx = mws->parent_idx;
+ next->worker_idx = next_idx;
+ retval = mp_xs_Apache__ScoreboardWorkerScore_2obj(next);
+ break;
+ }
+ }
+
+ return retval ? SvREFCNT_inc(retval) : &PL_sv_undef;
+
+}
+
+
+/* *** WorkerScore *** */
+
+static XS(MPXS_Apache__ScoreboardWorkerScore_times)
+{
+ dXSARGS;
+ modperl_worker_score_t *self;
+
+ if (items != 1) {
+ Perl_croak(aTHX_ "usage: $worker_score->times");
+ }
+ self = mp_xs_sv2_Apache__ScoreboardWorkerScore(ST(0));
+
+ SP -= items;
+
+ 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))));
+ }
+ }
+
+ PUTBACK;
+}
+
+
+static XS(MPXS_Apache__ScoreboardWorkerScore_start_time)
+{
+ dXSARGS;
+ modperl_worker_score_t *self;
+ apr_time_t tp;
+
+ if (items != 1) {
+ Perl_croak(aTHX_ "usage: $worker_score->start_time");
+ }
+ self = mp_xs_sv2_Apache__ScoreboardWorkerScore(ST(0));
+
+ SP -= items;
+
+ tp = self->record.start_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 )));
+ }
+
+ PUTBACK;
+}
+
+/* XXX: this should be merged back into
+ * mpxs_Apache__Scoreboard_WorkerScore_start_time as an ALIAS when
+ * WrapXS provides it
+ */
+static XS(MPXS_Apache__ScoreboardWorkerScore_stop_time)
+{
+ dXSARGS;
+ modperl_worker_score_t *self;
+ apr_time_t tp;
+
+ if (items != 1) {
+ Perl_croak(aTHX_ "usage: $worker_score->stop_time");
+ }
+ self = mp_xs_sv2_Apache__ScoreboardWorkerScore(ST(0));
+
+ SP -= items;
+
+ tp = self->record.stop_time;
+ /* fprintf(stderr, "stop_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 )));
+ }
+
+ PUTBACK;
+}
+
+static MP_INLINE
+long mpxs_Apache__ScoreboardWorkerScore_req_time(modperl_worker_score_t *self)
+{
+ long req_time;
+ if (self->record.start_time == 0L) {
+ req_time = 0L;
+ }
+ else {
+ req_time = (long)
+ ((self->record.stop_time - self->record.start_time) / 1000);
+ }
+ if (req_time < 0L || !self->record.access_count) {
+ req_time = 0L;
+ }
+
+ return req_time;
+
+}
+
+static MP_INLINE
+SV *mpxs_Apache__ScoreboardWorkerScore_status(pTHX_ modperl_worker_score_t *self)
+{
+ SV *sv = newSV(0);
+ sv_setnv(sv, (double)self->record.status);
+ sv_setpvf(sv, "%c", status_flags[self->record.status]);
+ SvNOK_on(sv); /* dual-var */
+ return sv;
+}
+
+/* Apache::ScoreboardGlobalScore functions */
+
--- /dev/null Thu Jan 1 07:30:00 1970
+++ xs/Apache/Scoreboard/Scoreboard_pm Thu Mar 14 00:44:51 2002
@@ -0,0 +1,56 @@
+use strict;
+use constant DEBUG => 0;
+
+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);
+}
_____________________________________________________________________
Stas Bekman JAm_pH -- Just Another mod_perl Hacker
http://stason.org/ mod_perl Guide http://perl.apache.org/guide
mailto:[EMAIL PROTECTED] http://ticketmaster.com http://apacheweek.com
http://singlesheaven.com http://perl.apache.org http://perlmonth.com/
---------------------------------------------------------------------
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
