Random Bits of Open Code

Check-in [efd8e83582]
Login

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Merged from 79c8 and tweaked a bit
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1:efd8e8358221f1cb324effb1ace289eaf56f5422
User & Date: mrwellan 2019-05-20 21:27:39
Context
2019-05-20
22:10
Switch to PERSIST mode and turn off exit on line check-in: 90dced0839 user: mrwellan tags: trunk
21:27
Merged from 79c8 and tweaked a bit check-in: efd8e83582 user: mrwellan tags: trunk
19:44
pull in modularize-debug changes check-in: 5b014bb206 user: mrwellan tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to ringchart/Makefile.

25
26
27
28
29
30
31
32
33
34
35
36
37
jobs.db : output.db
	echo Please copy output.db to jobs.db

output.db : process $(INPUTFILES)
	process get-jobs $(INPUTFILES)


%.log : $(INPUT_DIR)/%.gz process
	process get-jobs $(INPUT_DIR)/$*.gz 2>&1 | tee $@

# Additional deps

runstats : src/cstats.scm







|





25
26
27
28
29
30
31
32
33
34
35
36
37
jobs.db : output.db
	echo Please copy output.db to jobs.db

output.db : process $(INPUTFILES)
	process get-jobs $(INPUTFILES)


%.log : $(INPUT_DIR)/%.gz
	process get-jobs $(INPUT_DIR)/$*.gz 2>&1 | tee $@

# Additional deps

runstats : src/cstats.scm

Changes to ringchart/process.scm.

1



2

3
4
5
6
7
8
9
10
11
12
..
39
40
41
42
43
44
45
46


47
48
49
50
51
52
53
54
55

56

57
58
59
60

61



62
63
64
65
66

67

68
69
70
71
72
73
74
...
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133

134
135
136
137
138
139
140

141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
...
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190

191
192
193
194
195
196









197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214

215

216
217
218
219
220
221
222
...
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
(use posix numbers



     ;; sql-de-lite

     sqlite3
     regex 
     srfi-69 srfi-13 matchable)

(define (help)
  (print "Usage: process-nbjobs <cmd> [file ...]")
  (print "   where cmd is one of:")
  (print "     fake-jobs   : make fake jobs database in output.db")
  (print "     get-jobs    : read files from commandline into output.db"))

................................................................................
    ;;                                         0       1       2        3          4        5      6     7       8       9          10         11           12
    (dups-stmt . ,(prepare db "SELECT jobid,iteration,user,submit_time,queue_name,num_cpus,mem,duration,host,start_time,finish_time,exit_status,cores_consumed FROM jobs
                                        WHERE jobid=? AND
                                              user=? AND
                                              host=? AND
                                              start_time=? AND
                                              submit_time=?;"))
    (del-stmt  . ,(prepare db "DELETE FROM jobs WHERE id=?;"))))



(define (finalize-statements stmts)
  (map finalize! (map cdr stmts)))

(define (get-jobs fname)
  (for-each
   (lambda (fname)
     (let* ((zipped   (string-match (regexp ".*\\.gz$") fname)) ;; true is gzip, false is plain
	    (db       (create-get-db "output.db")))

       (print "Processing " fname)

       (let* ((stmts     (make-statements db))
	      (stmt      (alist-ref 'stmt stmts))
	      (dups-stmt (alist-ref 'dups-stmt stmts))
	      (del-stmt  (alist-ref 'del-stmt  stmts))

	      (allids    (get-all-job-ids db (make-hash-table))))



         ;;(print allids)
         ;;(format #t "~A~%" (hash-table-keys allids))
	 ((if zipped with-input-from-pipe with-input-from-file)
	  (if zipped (conc "zcat " fname) fname)
	   (lambda ()

	     (process-file db del-stmt dups-stmt stmt allids))))))

   (filter file-exists? (cdr (command-line-arguments))))) ;; first item on command line is the command

(define (make-fake-jobs)
  (let* ((db (create-get-db "output.db"))
	 (stmts (make-statements db))
	 (instmt (alist-ref 'stmt stmts))
	 (one-month  (* 30 24 3600))
................................................................................
			   (fold-row (lambda (val res)(or val res)) #f db "SELECT id FROM people WHERE uid=?;" mgr)
			   -1)))
	   (execute db "INSERT INTO people (uid,mgr_id) VALUES (?,?);" peep mgr-id))))
     peeps)
    (finalize! db)))


(define (process-file db del-stmt dups-stmt stmt alljobids)
  (let ((start-time (current-seconds)))
    (with-transaction
     db
     (lambda ()
       (let loop ((inl (read-line))
		  (lnum 0)
		  (coll 0))
	 (if (not (eof-object? inl))
	     (let* ((nbstatusline (string-split-fields "," inl #:infix))) ;;  Jobid,User,Workstation,StartTime,FinishTime,ExitStatus,SubmitTime,ActualClassReservation,Qslot,Iteration,CoresConsumption

	       (if (eq? (modulo lnum 10000) 0)
		   (print lnum " lines, " (let ((delta (- (current-seconds) start-time)))
				     (if (> delta 0)
					 (inexact->exact (round (/ lnum delta)))
					 0))
			  " lines/sec processed, "
			  coll " collisions"))

	       ;; (jobid      user     machine  starttime           finishtime          exitstatus submittime          resourcestring           qslot coresconsumed) 
	       ;; (5356087142 grthdk76 dlxc1433 02/23/2019 21:01:39 02/24/2019 07:11:04 0          02/23/2019 21:01:22 cores=1;memory=32;slot=1 /adg/spckt/rtl)
	       ;; "5357334480,psomaraj,,        02/24/2019 13:32:04,02/24/2019 13:32:04,-7,02/24/2019 13:31:59,"",/adg/lvd/pd,0.0"
	       ;; (435746369 tiwariv 02/24/2019 14:55:41 02/24/2019 14:55:41 -7 02/24/2019 14:55:20 cores=8;memory=64;slot=1 /ptm/pdmg)
	       (let ((collision 
		      (match nbstatusline ;; 
			     ((jobid user machine starttime finishtime exitstatus submittime resourcestring qslot iteration coresconsumed) 
			      (process-one del-stmt dups-stmt stmt alljobids inl jobid user machine starttime finishtime exitstatus submittime resourcestring qslot iteration coresconsumed))
			     ((jobid user machine starttime finishtime exitstatus submittime resourcestring qslot iteration)
			      (process-one del-stmt dups-stmt stmt alljobids inl jobid user machine starttime finishtime exitstatus submittime resourcestring qslot iteration #f))
			     (else
			      (with-output-to-port (current-error-port)
				(lambda ()
				  (print "ERROR: Failed to parse: " inl))) ;; nbstatusline)
			      1 ;; a bad line is a collison I guess
			      ))))
		 (loop(read-line)(+ lnum 1)(+ coll collision))))))))))
................................................................................
   (string-split str ";")))

#;(define (get-all-job-ids db ht)
  (for-each-row
   (lambda (id)
     (hash-table-set! ht id #t))
   db
   "SELECT id FROM jobs;")
  ht)

(define (get-all-job-ids db ht)
  (fold-row
   (lambda (id id)
     (hash-table-set! ht id #t))
   #f
   db
   "SELECT id FROM jobs;")
  ht)

(define (string->seconds str inl)
  (handle-exceptions
   exn
   (print "ERROR: cannot convert " str " to seconds. Input line is: \"" inl "\"")
   (string->number (time->string (string->time str "%m/%d/%Y %H:%M:%S") "%s"))))

(define (get-dups dups-stmt jobid user machine starttime-seconds submittime-seconds) ;; blindly get all dups

  (fold-row
   (lambda (res . row)
     (cons row res))
   '()
   dups-stmt
   jobid user machine starttime-seconds submittime-seconds))










;; return 1 if a collision, else return 0
;;      (process-one del-stmt dups-stmt stmt     alljobids inl jobid    user machine starttime finishtime exitstatus submittime resourcestring qslot iteration coresconsumed))
(define (process-one del-stmt dups-stmt add-stmt alljobids inl jobid-in user machine starttime finishtime exitstatus submittime resourcestring qslot iteration-in coresconsumed)
  (let ((estatus (string->number exitstatus))
	(jobid   jobid-in)
        (iteration (string->number iteration-in)))
    (cond
     ((not estatus)(print "BAD Entry: " inl) 1)
     (else ;; (not (member estatus '(7)))
      (let* ((resourcedat        (resource-string->alist resourcestring))
	     (cores              (or (alist-ref 'cores resourcedat) -1)) 
	     (memory             (or (alist-ref 'memory resourcedat) -1))
	     (starttime-seconds  (string->seconds starttime  inl))
	     (finishtime-seconds (string->seconds finishtime inl))
	     (submittime-seconds (string->seconds submittime inl))
	     (duration           (- finishtime-seconds starttime-seconds)))
	(if (hash-table-exists? alljobids jobid)

	    (let* ((dups (get-dups dups-stmt jobid user machine starttime-seconds submittime-seconds)))

	      (cond
	       ((null? dups) ;; same jobid but a different record
		(handle-exceptions
		 exn
		 (begin (print "Second try failed") 0)
		 (execute add-stmt jobid iteration user submittime-seconds qslot cores memory duration (if (string= machine "") "foo" machine) starttime-seconds finishtime-seconds exitstatus (or coresconsumed 0))
		 0))
................................................................................
              ;;(print "Non-Duplicate: " inl)
	      (handle-exceptions
	       exn
	       (begin (print "Exception: " inl) (print ((condition-property-accessor 'exn 'message) exn)) (print add-stmt))
	       (execute add-stmt jobid iteration user submittime-seconds qslot cores memory duration (if (string= machine "") "foo" machine) starttime-seconds finishtime-seconds exitstatus (or coresconsumed 0) ))
	      (hash-table-set! alljobids jobid #t)
	      0)))))))
     #;(else (print "BAD Exit: " inl))
  
(define (init-db db)
  (for-each
   (lambda (stmt)
     (execute db stmt))
   (list "CREATE TABLE IF NOT EXISTS jobs
                 (id integer primary key,
|
>
>
>
|
>
|
|
|







 







|
>
>








|
>
|
>
|



>
|
>
>
>




|
>
|
>







 







|









>
|






>







|

|







 







|








|









>






>
>
>
>
>
>
>
>
>



|












|
|
>

>







 







|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
..
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
...
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
...
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
...
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
(use
 ;; big-chicken
 srfi-1
 ;; (chicken process-context)
 ;; sql-de-lite
 posix
 sqlite3
 regex 
 srfi-69 srfi-13 matchable)

(define (help)
  (print "Usage: process-nbjobs <cmd> [file ...]")
  (print "   where cmd is one of:")
  (print "     fake-jobs   : make fake jobs database in output.db")
  (print "     get-jobs    : read files from commandline into output.db"))

................................................................................
    ;;                                         0       1       2        3          4        5      6     7       8       9          10         11           12
    (dups-stmt . ,(prepare db "SELECT jobid,iteration,user,submit_time,queue_name,num_cpus,mem,duration,host,start_time,finish_time,exit_status,cores_consumed FROM jobs
                                        WHERE jobid=? AND
                                              user=? AND
                                              host=? AND
                                              start_time=? AND
                                              submit_time=?;"))
    (del-stmt  . ,(prepare db "DELETE FROM jobs WHERE id=?;"))
    (sel-stmt  . ,(prepare db "SELECT jobid FROM jobs WHERE jobid=?;"))
   ))

(define (finalize-statements stmts)
  (map finalize! (map cdr stmts)))

(define (get-jobs fname)
  (for-each
   (lambda (fname)
     (let* ((zipped   (string-match (regexp ".*\\.gz$") fname)) ;; true is gzip, false is plain
	    (db       (create-get-db "output.db"))
           )
       ;; (print "Processing " fname)
       (let* (
              (stmts     (make-statements db))
	      (stmt      (alist-ref 'stmt stmts))
	      (dups-stmt (alist-ref 'dups-stmt stmts))
	      (del-stmt  (alist-ref 'del-stmt  stmts))
	      (sel-stmt  (alist-ref 'sel-stmt  stmts))
	      ;;(allids    (get-all-job-ids db (make-hash-table)))
	      (allids    (make-hash-table))
             )
         ;; (print "After let in get-jobs")
         ;;(print allids)
         ;;(format #t "~A~%" (hash-table-keys allids))
	 ((if zipped with-input-from-pipe with-input-from-file)
	  (if zipped (conc "zcat " fname) fname)
	  (lambda ()
	    (print "Processing input file: " fname)
	    (process-file db del-stmt dups-stmt stmt sel-stmt allids)
	    )))))
   (filter file-exists? (cdr (command-line-arguments))))) ;; first item on command line is the command

(define (make-fake-jobs)
  (let* ((db (create-get-db "output.db"))
	 (stmts (make-statements db))
	 (instmt (alist-ref 'stmt stmts))
	 (one-month  (* 30 24 3600))
................................................................................
			   (fold-row (lambda (val res)(or val res)) #f db "SELECT id FROM people WHERE uid=?;" mgr)
			   -1)))
	   (execute db "INSERT INTO people (uid,mgr_id) VALUES (?,?);" peep mgr-id))))
     peeps)
    (finalize! db)))


(define (process-file db del-stmt dups-stmt stmt sel-stmt alljobids)
  (let ((start-time (current-seconds)))
    (with-transaction
     db
     (lambda ()
       (let loop ((inl (read-line))
		  (lnum 0)
		  (coll 0))
	 (if (not (eof-object? inl))
	     (let* ((nbstatusline (string-split-fields "," inl #:infix))) ;;  Jobid,User,Workstation,StartTime,FinishTime,ExitStatus,SubmitTime,ActualClassReservation,Qslot,Iteration,CoresConsumption
               ;; (if (eq? lnum 20) (quit))
	       (if (eq? (modulo lnum 1000) 0)
		   (print lnum " lines, " (let ((delta (- (current-seconds) start-time)))
				     (if (> delta 0)
					 (inexact->exact (round (/ lnum delta)))
					 0))
			  " lines/sec processed, "
			  coll " collisions"))
               ;;(if (< lnum 100) (flush-output))
	       ;; (jobid      user     machine  starttime           finishtime          exitstatus submittime          resourcestring           qslot coresconsumed) 
	       ;; (5356087142 grthdk76 dlxc1433 02/23/2019 21:01:39 02/24/2019 07:11:04 0          02/23/2019 21:01:22 cores=1;memory=32;slot=1 /adg/spckt/rtl)
	       ;; "5357334480,psomaraj,,        02/24/2019 13:32:04,02/24/2019 13:32:04,-7,02/24/2019 13:31:59,"",/adg/lvd/pd,0.0"
	       ;; (435746369 tiwariv 02/24/2019 14:55:41 02/24/2019 14:55:41 -7 02/24/2019 14:55:20 cores=8;memory=64;slot=1 /ptm/pdmg)
	       (let ((collision 
		      (match nbstatusline ;; 
			     ((jobid user machine starttime finishtime exitstatus submittime resourcestring qslot iteration coresconsumed) 
			      (process-one del-stmt dups-stmt sel-stmt stmt alljobids inl jobid user machine starttime finishtime exitstatus submittime resourcestring qslot iteration coresconsumed))
			     ((jobid user machine starttime finishtime exitstatus submittime resourcestring qslot iteration)
			      (process-one del-stmt dups-stmt sel-stmt stmt alljobids inl jobid user machine starttime finishtime exitstatus submittime resourcestring qslot iteration #f))
			     (else
			      (with-output-to-port (current-error-port)
				(lambda ()
				  (print "ERROR: Failed to parse: " inl))) ;; nbstatusline)
			      1 ;; a bad line is a collison I guess
			      ))))
		 (loop(read-line)(+ lnum 1)(+ coll collision))))))))))
................................................................................
   (string-split str ";")))

#;(define (get-all-job-ids db ht)
  (for-each-row
   (lambda (id)
     (hash-table-set! ht id #t))
   db
   "SELECT jobid FROM jobs;")
  ht)

(define (get-all-job-ids db ht)
  (fold-row
   (lambda (id id)
     (hash-table-set! ht id #t))
   #f
   db
   "SELECT jobid FROM jobs;")
  ht)

(define (string->seconds str inl)
  (handle-exceptions
   exn
   (print "ERROR: cannot convert " str " to seconds. Input line is: \"" inl "\"")
   (string->number (time->string (string->time str "%m/%d/%Y %H:%M:%S") "%s"))))

(define (get-dups dups-stmt jobid user machine starttime-seconds submittime-seconds) ;; blindly get all dups
  ;;(print "Checking database for " jobid " " user " " machine " " starttime-seconds " " submittime-seconds )
  (fold-row
   (lambda (res . row)
     (cons row res))
   '()
   dups-stmt
   jobid user machine starttime-seconds submittime-seconds))

(define (job-exists? sel-stmt alljobids job-id)
  (or (hash-table-exists? alljobids job-id)
      (let ((res (fold-row (lambda (res . rem)
			     (or res rem))
			   #f sel-stmt job-id)))
	(if (not (null? res))
	    (hash-table-set! alljobids job-id #t))
	res)))

;; return 1 if a collision, else return 0
;;      (process-one del-stmt dups-stmt stmt     alljobids inl jobid    user machine starttime finishtime exitstatus submittime resourcestring qslot iteration coresconsumed))
(define (process-one del-stmt dups-stmt sel-stmt add-stmt alljobids inl jobid-in user machine starttime finishtime exitstatus submittime resourcestring qslot iteration-in coresconsumed)
  (let ((estatus (string->number exitstatus))
	(jobid   jobid-in)
        (iteration (string->number iteration-in)))
    (cond
     ((not estatus)(print "BAD Entry: " inl) 1)
     (else ;; (not (member estatus '(7)))
      (let* ((resourcedat        (resource-string->alist resourcestring))
	     (cores              (or (alist-ref 'cores resourcedat) -1)) 
	     (memory             (or (alist-ref 'memory resourcedat) -1))
	     (starttime-seconds  (string->seconds starttime  inl))
	     (finishtime-seconds (string->seconds finishtime inl))
	     (submittime-seconds (string->seconds submittime inl))
	     (duration           (- finishtime-seconds starttime-seconds))
	     (job-exists         (job-exists? sel-stmt alljobids jobid)))
	(if job-exists
	    (let* ((dups (get-dups dups-stmt jobid user machine starttime-seconds submittime-seconds)))
              ;;(print dups)
	      (cond
	       ((null? dups) ;; same jobid but a different record
		(handle-exceptions
		 exn
		 (begin (print "Second try failed") 0)
		 (execute add-stmt jobid iteration user submittime-seconds qslot cores memory duration (if (string= machine "") "foo" machine) starttime-seconds finishtime-seconds exitstatus (or coresconsumed 0))
		 0))
................................................................................
              ;;(print "Non-Duplicate: " inl)
	      (handle-exceptions
	       exn
	       (begin (print "Exception: " inl) (print ((condition-property-accessor 'exn 'message) exn)) (print add-stmt))
	       (execute add-stmt jobid iteration user submittime-seconds qslot cores memory duration (if (string= machine "") "foo" machine) starttime-seconds finishtime-seconds exitstatus (or coresconsumed 0) ))
	      (hash-table-set! alljobids jobid #t)
	      0)))))))
#;(else (print "BAD Exit: " inl))
  
(define (init-db db)
  (for-each
   (lambda (stmt)
     (execute db stmt))
   (list "CREATE TABLE IF NOT EXISTS jobs
                 (id integer primary key,