Random Bits of Open Code

Check-in [79c8aa68fd]
Login

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

Overview
Comment:Removed process from default makefile rule, modified to run only 20 records for easier testing. Super slow for duplicate records. Not fully working
Timelines: family | ancestors | margs-chicken-5
Files: files | file ages | folders
SHA1:79c8aa68fd7d80ac1669211adb6dcd7b4b93a00d
User & Date: jmoon18 2019-05-15 23:35:23
Context
2019-05-15
23:35
Removed process from default makefile rule, modified to run only 20 records for easier testing. Super slow for duplicate records. Not fully working Leaf check-in: 79c8aa68fd user: jmoon18 tags: margs-chicken-5
2019-05-13
20:34
Initial cut at stacked team charts. Not fully working yet check-in: 490491d199 user: jmoon18 tags: margs-chicken-5
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
..
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
(use posix numbers


     ;; sql-de-lite
     sqlite3
     regex 
     srfi-69 srfi-13 matchable)

(define (help)
  (print "Usage: process-nbjobs <cmd> [file ...]")
................................................................................
    ;;                                         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))
|
>
>







 







|
>
>








|
>

>
|



>
|
>
>
>





|
>







 







|









>
|






>







|

|







 







|








|









>









|












|
>
>
>
>
>
>
>
>
>
>


>







1
2
3
4
5
6
7
8
9
10
..
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
75
76
77
78
79
80
81
82
83
84
85
...
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
158
159
160
161
162
163
164
165
166
167
168
169
170
...
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
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
(import
     big-chicken srfi-1
     (chicken process-context)
     ;; sql-de-lite
     sqlite3
     regex 
     srfi-69 srfi-13 matchable)

(define (help)
  (print "Usage: process-nbjobs <cmd> [file ...]")
................................................................................
    ;;                                         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 ()
	     (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))

;; 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))
         ;;(foo (fold-row (lambda (id id) 
         ;;                 ;;(print "Setting hash for: " jobid)
         ;;                 (hash-table-set! alljobids jobid #t)) 
         ;;               #f sel-stmt jobid))
         (foo2 (begin (hash-table-set! alljobids (car (first-row sel-stmt jobid)) #t) jobid))
         )
         ;;(print "Foo2: " foo2 " Jobid: " jobid " SELECT: " (first-row sel-stmt jobid))
         ;;(print "Hash: " (hash-table-exists? alljobids jobid))
         ;;(repl)
        ;;(print (hash-table-keys alljobids))
	(if (hash-table-exists? alljobids jobid)
	    (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))