(import 
  big-chicken
  regex 
  sqlite3
)

(define (copy-database workweek)
  (print "Copy megatest.db to mt_archive/" workweek "/megatest.db")
  (if (file-exists? (conc "mt_archive/" workweek "/megatest.db"))
    (begin (print "Archive already exists.  Exiting") (quit))
  )
  (if (not (file-exists? (conc "mt_archive/" workweek)))
    (begin 
      (print "Create archive dir")
      (create-directory (conc "mt_archive/" workweek) #t)
    )
    (print "Archive dir already exists")
  )
  (copy-file "megatest.db" (conc "mt_archive/" workweek "/megatest.db"))
  (with-output-to-file (conc "mt_archive/" workweek "/megatest.config") 
    (lambda() (print "[include ../../megatest.config]"))
  )
  ;;(create-symbolic-link "megatest.config" (conc "mt_archive/" workweek "/megatest.config"))
  ;;(create-symbolic-link "configs" (conc "mt_archive/" workweek "/configs"))
  ;;(create-symbolic-link "runconfigs.config" (conc "mt_archive/" workweek "/runconfigs.config"))
)

(define (delete-orphan-tests db)
  (execute db (conc "DELETE FROM tests where run_id NOT IN (select distinct id from runs)"))
)
 
(define (delete-orphan-steps db)
  (execute db (conc "DELETE FROM test_steps where test_id NOT IN (select distinct id from tests)"))
)

(define (vacuum-db db)
  (execute db (conc "VACUUM;"))
)

(define (trim-runs file operand timestamp)
  (print "Trim Runs from " file " where timestamp is " operand " " timestamp)
  (let* ((db (open-database file))
         (cmd (conc "DELETE FROM runs WHERE event_time " operand " " timestamp)))
    (print (database? db))
    (print "CMD: " cmd)
    (with-transaction db 
      (lambda () 
        (execute db cmd)
        (delete-orphan-tests db)
        (delete-orphan-steps db)
      )
    )
    (vacuum-db db)
  )
)

(let* ((workweek (string-chomp (call-with-input-pipe "date +%yww%V" (lambda (port) (read-string #f  port))  ) ))
       (fortyfive-days-ago (- (current-seconds) (* 60 60 24 45)) )
       ;;(user (get-environment-variable "USER"))
       (area "libanatmpltsqa")
       (user (current-user-name))
       (path (string-translate (current-directory) "/" ".")))
  (print "Path: " path)
  (print "User: " user)
  (print "Megatest.db: "  (conc "/tmp/" user "/megatest_localdb/" area "/" path "/megatest.db") )
  (print "Megatest_ref.db: "  (conc "/tmp/" user "/megatest_localdb/" area "/" path "/megatest_ref.db") )
  ;;(quit)
  (copy-database workweek)
  (trim-runs "megatest.db" "<" fortyfive-days-ago)
  (trim-runs (conc "/tmp/" user "/megatest_localdb/" area "/" path "/megatest.db") "<" fortyfive-days-ago)
  (trim-runs (conc "/tmp/" user "/megatest_localdb/" area "/" path "/megatest_ref.db") "<" fortyfive-days-ago)
  (trim-runs (conc "mt_archive/" workweek "/megatest.db") ">=" fortyfive-days-ago)
)



