Megatest

;;     but WITHOUT ANY WARRANTY; without even the implied warranty of
;;     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;     GNU General Public License for more details.
;; 
;;     You should have received a copy of the GNU General Public License
;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.
;;

(module whodunit

 *

(import scheme chicken data-structures extras)
(use posix srfi-69)

(define *numsamples* (or (and (> (length (argv)) 1)
                              (string->number (cadr (argv))))
                         3))

(define (topdata)
  (with-input-from-pipe
   (conc "top -b -n " *numsamples* " -d 0.1")
   read-lines))

(define (cleanup-data topdat)list
(define (cleanup-data topdat)
  (let loop ((hed (car topdat))
              (tal (cdr topdat))
              (res '()))
    (let* ((line-list (string-split hed))
           (nums      (map (lambda (indat)(or (string->number indat) indat)) line-list))
           (not-data  (or (null? nums)
                          (not (number? (car nums)))))
           (new-res   (if not-data res (cons nums res))))
      (if (null? tal)
          new-res
          (loop (car tal)(cdr tal) new-res)))))


;; sum up
(define (sum-up data ht)
  (for-each
   (lambda (indat)
     (let ((pid (car indat))
           (usr (cadr indat))
           (cpu (list-ref indat 8)))
       (hash-table-set! ht usr (+ cpu (hash-table-ref/default ht usr 0)))))
   data))

)
(import whodunit)

(print "Getting " *numsamples* " samples of cpu usage data.")
(define data (cleanup-data (topdata)))
(define pidhash  (make-hash-table))
(define userhash (make-hash-table))
(sum-up data userhash)

;; sum up and normalize the 
(for-each
 (lambda (indat)
   (let ((pid (car indat))
         (usr (cadr indat))
         (cpu (list-ref indat 8)))
     (hash-table-set! userhash usr (+ cpu (hash-table-ref/default userhash usr 0)))))
 data)

(for-each
 (lambda (usr)
   (let* ((usage (inexact->exact (round (/ (hash-table-ref userhash usr) *numsamples*)))))
   (print usr
          (if (< (string-length usr) 8) "\t\t" "\t")
     (if (> usage 0)
	 (print usr (if (< (string-length usr) 8) "\t\t" "\t") usage))))
          (inexact->exact (round (/ (hash-table-ref userhash usr) *numsamples*)))))
 (sort (hash-table-keys userhash)
       (lambda (a b)
         (> (hash-table-ref userhash a)
            (hash-table-ref userhash b)))))
	    (hash-table-ref userhash b)))))