Megatest

Check-in [6531c14950]
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
Overview
Comment:fix to pgdb sync
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.6569-refactor-server-key-chk
Files: files | file ages | folders
SHA1: 6531c149500473c3712c6e1e1f6afe8e7c7c47f0
User & Date: pjhatwal on 2021-01-19 18:49:07
Other Links: branch diff | manifest | tags
Context
2021-01-19
18:53
fix to pgdb sync check-in: a4dbd963fb user: pjhatwal tags: v1.6569-refactor-server-key-chk
18:49
fix to pgdb sync check-in: 6531c14950 user: pjhatwal tags: v1.6569-refactor-server-key-chk
12:00
adde debug statement in pgdb sync oonly for top level test check-in: c5588eff69 user: pjhatwal tags: v1.6569-refactor-server-key-chk
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Modified sretrieve.scm from [e7efdf8d00] to [c73e7e987b].

︙
635
636
637
638
639
640
641
642

643
644
645
646
647
648
649
650
651
652



653
654
655
656
657
658
659

635
636
637
638
639
640
641

642
643
644
645
646
647
648
649



650
651
652
653
654
655
656
657
658
659








-
+







-
-
-
+
+
+








           (let* ((parent-dir target-path)
                  (last-dir-name (if  (pathname-extension target-path)  
                                      (conc(pathname-file target-path) "." (pathname-extension target-path))
                                      (pathname-file target-path)))
                  (curr-dir (current-directory))   
                  (start-dir (conc (current-directory) "/" last-dir-name))
                  (execlude (make-exclude-pattern (string-split restrictions ",")))
                   (tmpfile (conc "/tmp/" (current-user-name) "/my-pipe-" (current-process-id))))
                   (tmpfile (conc "/tmp/my-pipe-" (current-process-id))))
                    (if  (file-exists? start-dir)
                    (begin
                         (sauth:print-error (conclast-dir-name " already exist in your work dir."))
                         (sauth:print-error  "Nothing has been retrieved!!  "))
                     (begin
                   ;    (sretrieve:do-as-calling-user
                   ; (lambda ()
                    
                  (if (not (file-exists?  (conc "/tmp/" (current-user-name)))) 
		      (create-directory (conc "/tmp/" (current-user-name)) #t))
                  ; (print tmpfile) 
                  ;(if (not (file-exists?  (conc "/tmp/" (current-user-name)))) 
		  ;    (create-directory (conc "/tmp/" (current-user-name)) #t))
                          (change-directory parent-dir)
                            (create-fifo  tmpfile)
                                  (process-fork 
    				   (lambda()
                                       (sleep 1) 
       					(with-output-to-file tmpfile
         				(lambda ()
︙

Modified tasks.scm from [98319a9934] to [3d51bed530].

︙
757
758
759
760
761
762
763
764

765
766
767
768
769
770
771

757
758
759
760
761
762
763

764
765
766
767
768
769
770
771








-
+








	       (comment    (db:get-value-by-header row header "comment"))
	       (fail-count (db:get-value-by-header row header "fail_count"))
	       (pass-count (db:get-value-by-header row header "pass_count"))
         (db-contour (db:get-value-by-header row header "contour"))
	       (contour    (if (args:get-arg "-prepend-contour") 
                                 (if (and db-contour (not (equal? db-contour ""))  (string? db-contour )) 
                                           (begin 
                                            (debug:print-info 1 *default-log-port*  "db-contour") 
                                            (debug:print-info 10 *default-log-port*  "db-contour" db-contour) 
 						db-contour)
					    (args:get-arg "-contour"))))
         (run-tag (if (args:get-arg "-run-tag")
                            (args:get-arg "-run-tag")
									""))
         (last-update (db:get-value-by-header row header "last_update"))
	       (keytarg    (if (or (args:get-arg "-prepend-contour") (args:get-arg "-prefix-target"))
︙
786
787
788
789
790
791
792
793

794
795
796
797
798
799
800

786
787
788
789
790
791
792

793
794
795
796
797
798
799
800








-
+








           (smallest-time (hash-table-ref/default smallest-last-update-time "smallest-time" #f)))
     (if (and  (> last-update pgdb-last-update) (or (not smallest-time) (< last-update smallest-time)))
        (hash-table-set! smallest-last-update-time "smallest-time" last-update)))
		(pgdb:refresh-run-info
		 dbh
		 new-run-id
		 state status owner event-time comment fail-count pass-count area-id last-update publish-time)
     (debug:print-info 0 *default-log-port* "Working on run-id " run-id " pgdb-id "  new-run-id )
     (debug:print-info 4 *default-log-port* "Working on run-id " run-id " pgdb-id "  new-run-id )
     (if (not (equal? run-tag ""))
      (task:add-run-tag dbh new-run-id run-tag))
		new-run-id) 
      
	      (if (equal? state "deleted")
          (begin 
          (debug:print-info 1 *default-log-port*  "Warning: Run with id " run-id " was created after previous sync and deleted before the sync") #f)
︙
968
969
970
971
972
973
974
975

976
977
978
979
980
981
982

968
969
970
971
972
973
974

975
976
977
978
979
980
981
982








-
+








				(begin
                                  ;(print pgdb-run-id)    
                                 (pgdb:get-test-id dbh pgdb-run-id test-name item-path))
                                 #f)))
	 ;; "id"           "run_id"        "testname"  "state"      "status"      "event_time"
	 ;; "host"         "cpuload"       "diskfree"  "uname"      "rundir"      "item_path"
	 ;; "run_duration" "final_logf"    "comment"   "shortdir"   "attemptnum"  "archived"
         (if (or (not (item-path)) (string-null? item-path))
         (if (or (not item-path) (string-null? item-path))
             (debug:print-info 0 *default-log-port* "Working on Run id : " run-id "and test name : " test-name)) 
         (if pgdb-run-id
           (begin
	   (if pgdb-test-id ;; have a record
	     (begin ;; let ((key-name (conc run-id "/" test-name "/" item-path)))
	       (debug:print-info 4 *default-log-port*  "Updating existing test with run-id: " run-id " and test-id: " test-id " pgdb run id: " pgdb-run-id "  pgdb-test-id "  pgdb-test-id)
         (let* ((pgdb-last-update (pgdb:get-test-last-update dbh pgdb-test-id)))
︙
1013
1014
1015
1016
1017
1018
1019
1020

1021
1022
1023
1024
1025
1026
1027

1013
1014
1015
1016
1017
1018
1019

1020
1021
1022
1023
1024
1025
1026
1027








-
+








	   #f)
           (if (not (pgdb:is-area-taged-with-a-tag dbh (vector-ref tag-info 0)  (vector-ref area-info 0)))  
	   (pgdb:insert-area-tag  dbh   (vector-ref tag-info 0)  (vector-ref area-info 0))))))

(define (tasks:sync-run-data dbh cached-info run-ids area-info smallest-last-update-time) 
  (for-each
     (lambda (run-id)
      (debug:print-info 1 *default-log-port*   "Check if run with " run-id " needs to be synced" )
      (debug:print-info 4 *default-log-port*   "Check if run with " run-id " needs to be synced" )
       (tasks:run-id->mtpg-run-id dbh cached-info run-id area-info smallest-last-update-time))
run-ids))


;; get runs changed since last sync
;; (define (tasks:sync-test-data dbh cached-info area-info)
;;   (let* ((
︙

This page was generated in about 0.118s by Fossil 2.24 [452f8e1ffc] 2024-03-26 15:36:00