[200_64] Telemetry优化 (#3301)

Co-authored-by: Sisyphus <clio-agent@sisyphuslabs.ai>

Author: Yuki-Nagori

TeXmacs/progs/generic/generic-edit.scm

@@ -752,21 +752,17 @@ TODO: 在文本模式中，可以自动识别剪贴板中的内容，并智能
   (if (string-starts? (qt-clipboard-format) "image")
       (begin
         (ocr-paste)
-        (when (not (community-stem?))
-          (track-event "OCR_RECOGNIZE" '())))
+        (track-event "OCR_RECOGNIZE" '()))
       (with mode (get-env "mode")
         (cond ((== mode "prog")
                (clipboard-paste-import "code" "primary")
-               (when (not (community-stem?))
-                 (track-event "MAGIC_PASTE" '(("mode" . "prog")))))
+               (track-event "MAGIC_PASTE" '(("mode" . "prog"))))
               ((== mode "math")
                (clipboard-paste-import "latex" "primary")
-               (when (not (community-stem?))
-                 (track-event "MAGIC_PASTE" '(("mode" . "math")))))
+               (track-event "MAGIC_PASTE" '(("mode" . "math"))))
               (else
                (smart-format-paste)
-               (when (not (community-stem?))
-                 (track-event "MAGIC_PASTE" '(("mode" . "text"))))))))
+               (track-event "MAGIC_PASTE" '(("mode" . "text")))))))
   (when (defined? 'tutorial-notify-action)
     (tutorial-notify-action "ocr-paste")))
 

TeXmacs/progs/init-research.scm

@@ -477,8 +477,10 @@
     (use-modules (telemetry init-telemetry))
     (init-telemetry))
   (lambda args
-    (display (string-append "[telemetry] error: init failed: "
-                            (object->string args) "\n"))))
+    (let ((msg (string-append "[telemetry] error: init failed: "
+                              (object->string args) "\n")))
+      (display msg (current-error-port))
+      (force-output (current-error-port)))))
 (texmacs-banner)
 (display "Initialization done\n")
 

TeXmacs/progs/telemetry/init-telemetry.scm

@@ -12,39 +12,74 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (texmacs-module (telemetry init-telemetry)
-  (:use (telemetry telemetry-track)
-        (telemetry telemetry-utils)))
+  (:use (telemetry telemetry-track) (telemetry telemetry-utils))
+) ;texmacs-module
 
 (import (scheme base))
 
 (define telemetry-scheduled? #f)
 
 (define (telemetry-scheduler-step)
   (when (telemetry-enabled?)
-    (telemetry-flush-if-needed))
-  (telemetry-delayed))
+    (telemetry-flush-if-needed)
+  ) ;when
+  (telemetry-delayed)
+) ;define
 
 (define (telemetry-delayed)
-  (delayed
-    (:pause (telemetry-get-flush-interval))
-    (telemetry-scheduler-step)))
+  (delayed (:pause (telemetry-get-flush-interval)) (telemetry-scheduler-step))
+) ;define
+
+(define (telemetry-clean-orphans)
+  ;; 启动时清理：删除不在 meta 列表中的孤儿 jsonl
+  (let* ((meta (telemetry-read-meta))
+         (valid-files (map (lambda (e) (assoc-ref e "filename")) meta))
+         (dir-url (system->url (telemetry-main-dir)))
+         (pattern (url-append dir-url (url-wildcard "*.jsonl")))
+         (files (url->list (url-expand (url-complete pattern "fr"))))
+        ) ;
+    (for-each (lambda (f)
+                (let ((fname (url->string (url-tail f))))
+                  (when (and (string-starts? fname "detail-telemetry-")
+                          (not (member fname valid-files))
+                        ) ;and
+                    (catch #t (lambda () (path-unlink (url->system f))) (lambda args #f))
+                  ) ;when
+                ) ;let
+              ) ;lambda
+      files
+    ) ;for-each
+  ) ;let*
+) ;define
 
 (define-public (init-telemetry)
   (if telemetry-scheduled?
     (display "[telemetry] init: already initialized\n")
     (if (telemetry-enabled?)
       (begin
+        (telemetry-clean-orphans)
         (set! telemetry-scheduled? #t)
         (display (string-append "[telemetry] init: enabled, buffer="
-                                (number->string (telemetry-get-buffer-size))
-                                ", interval="
-                                (number->string (telemetry-get-flush-interval))
-                                "ms\n"))
-        (on-exit
-          (catch #t
-            (lambda () (telemetry-flush-if-needed))
-            (lambda args
-              (display (string-append "[telemetry] error: exit flush failed: "
-                                      (object->string args) "\n")))))
-        (telemetry-delayed))
-      (display "[telemetry] init: disabled\n"))))
+                   (number->string (telemetry-get-buffer-size))
+                   ", interval="
+                   (number->string (telemetry-get-flush-interval))
+                   "ms\n"
+                 ) ;string-append
+        ) ;display
+        (on-exit (catch #t
+                   (lambda () (telemetry-flush-if-needed))
+                   (lambda args
+                     (display (string-append "[telemetry] error: exit flush failed: "
+                                (object->string args)
+                                "\n"
+                              ) ;string-append
+                     ) ;display
+                   ) ;lambda
+                 ) ;catch
+        ) ;on-exit
+        (telemetry-delayed)
+      ) ;begin
+      (display "[telemetry] init: disabled\n")
+    ) ;if
+  ) ;if
+) ;define-public

TeXmacs/progs/telemetry/telemetry-track.scm

@@ -11,17 +11,15 @@
 ;;
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(texmacs-module (telemetry telemetry-track)
-  (:use (telemetry telemetry-utils)))
+(texmacs-module (telemetry telemetry-track) (:use (telemetry telemetry-utils)))
 
 (import (scheme base)
   (liii base)
-  (liii json)
   (liii os)
   (liii path)
   (liii string)
   (liii list)
-)
+) ;import
 
 (define-public *telemetry-event-queue* '())
 
@@ -31,133 +29,113 @@
     (if (and (string? event-type) (not (string-null? event-type)))
       (begin
         (set! *telemetry-event-queue*
-          (cons (telemetry-make-event event-type properties)
-                *telemetry-event-queue*))
+          (cons (telemetry-make-event event-type properties) *telemetry-event-queue*)
+        ) ;set!
         (let ((len (length *telemetry-event-queue*)))
-          (display (string-append "[telemetry] track: " event-type
-                                  " (queue: " (number->string len)
-                                  "/" (number->string (telemetry-get-buffer-size)) ")\n"))
+          (display (string-append "[telemetry] track: "
+                     event-type
+                     " (queue: "
+                     (number->string len)
+                     "/"
+                     (number->string (telemetry-get-buffer-size))
+                     ")\n"
+                   ) ;string-append
+          ) ;display
           (if (> len telemetry-max-queue-size)
-            (set! *telemetry-event-queue*
-              (list-head *telemetry-event-queue* telemetry-max-queue-size)))
-          (if (>= len (telemetry-get-buffer-size))
-            (telemetry-flush)))
-        #t)
-      #f)))
-
-(define-public (telemetry-queue-length)
-  (length *telemetry-event-queue*))
+            (begin
+              (set! *telemetry-event-queue*
+                (list-head *telemetry-event-queue* telemetry-max-queue-size)
+              ) ;set!
+              (display (string-append "[telemetry] warn: queue truncated to "
+                         (number->string telemetry-max-queue-size)
+                         "\n"
+                       ) ;string-append
+              ) ;display
+            ) ;begin
+          ) ;if
+          (if (>= len (telemetry-get-buffer-size)) (telemetry-flush))
+        ) ;let
+        #t
+      ) ;begin
+      #f
+    ) ;if
+  ) ;if
+) ;define-public
+
+(define-public (telemetry-queue-length) (length *telemetry-event-queue*))
 
 (define-public (telemetry-flush-if-needed)
   (if (not (telemetry-enabled?))
     #t
-    (if (not (null? *telemetry-event-queue*))
-      (telemetry-flush)
-      #t)))
+    (if (not (null? *telemetry-event-queue*)) (telemetry-flush) #t)
+  ) ;if
+) ;define-public
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Flush implementation: lightweight append-only file writes
-;; Complex logic (size limits, stale filtering) handled by liii subprocess
+;; Flush implementation: independent jsonl files + atomic meta update
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(define telemetry-lock-timeout-seconds 30)
-
-(define (telemetry-lock-info owner now)
-  `(("owner" . ,owner) ("created_at" . ,now)))
-
-(define (telemetry-read-lock-info)
-  (catch #t
-    (lambda ()
-      (let ((text (string-load (system->url (telemetry-lock-info-path)))))
-        (if (and (string? text) (> (string-length text) 0))
-          (string->json text)
-          #f)))
-    (lambda args #f)))
-
-(define (telemetry-lock-expired? now)
-  (let ((info (telemetry-read-lock-info)))
-    (if info
-      (let ((created (json-ref-number info "created_at" 0)))
-        (> (- now created) telemetry-lock-timeout-seconds))
-      #t)))
-
-(define (telemetry-remove-lock)
-  (catch #t
-    (lambda ()
-      (path-unlink (telemetry-lock-info-path) #t)
-      (rmdir (telemetry-lock-path)))
-    (lambda args #f)))
-
-(define (telemetry-acquire-lock)
-  (telemetry-ensure-dir)
-  (let ((owner (telemetry-lock-owner))
-        (now (inexact->exact (truncate (current-time)))))
-    (catch #t
-      (lambda ()
-        (mkdir (telemetry-lock-path))
-        (string-save
-          (json->string (telemetry-lock-info owner now))
-          (system->url (telemetry-lock-info-path)))
-        owner)
-      (lambda args
-        (if (telemetry-lock-expired? now)
-          (begin
-            (telemetry-remove-lock)
-            (catch #t
-              (lambda ()
-                (mkdir (telemetry-lock-path))
-                (string-save
-                  (json->string (telemetry-lock-info owner now))
-                  (system->url (telemetry-lock-info-path)))
-                owner)
-              (lambda args2 #f)))
-          #f)))))
-
-(define (telemetry-release-lock owner)
-  (let ((info (telemetry-read-lock-info)))
-    (if (and info
-          (string=? (json-ref-string info "owner" "") owner))
-      (telemetry-remove-lock)
-      (begin
-        (display (string-append "[telemetry] warn: lock owner mismatch, skipping release "
-                                "(expected " owner ", got "
-                                (if info (json-ref-string info "owner" "") "none") ")\n"))
-        #f))))
-
 (define-public (telemetry-write-pending events)
   (if (null? events)
     #t
-    (let ((path (telemetry-pending-path))
-          (lines (map json->string events)))
+    (let* ((filename (telemetry-generate-filename))
+           (filepath (telemetry-full-path filename))
+           (lines (map telemetry->json events))
+          ) ;
       (catch #t
         (lambda ()
-           (let ((text (string-append (string-join lines "\n") "\n")))
-             (string-append-to-file text (system->url path))
-            (display (string-append "[telemetry] flush: "
-                                    (number->string (length events))
-                                    " events -> "
-                                    path "\n"))
-            #t))
+          (let ((text (string-append (string-join lines "\n") "\n")))
+            (string-save text (system->url filepath))
+            (if (telemetry-meta-add-entry filename)
+              (begin
+                (display (string-append "[telemetry] flush: "
+                           (number->string (length events))
+                           " events -> "
+                           filename
+                           "\n"
+                         ) ;string-append
+                ) ;display
+                #t
+              ) ;begin
+              (begin
+                (display (string-append "[telemetry] error: meta update failed for "
+                           filename
+                           "\n"
+                         ) ;string-append
+                ) ;display
+                #f
+              ) ;begin
+            ) ;if
+          ) ;let
+        ) ;lambda
         (lambda args
-          (display (string-append "[telemetry] error: write failed: "
-                                  (object->string args) "\n"))
-          #f)))))
+          (display (string-append "[telemetry] error: write failed: " (object->string args) "\n")
+          ) ;display
+          #f
+        ) ;lambda
+      ) ;catch
+    ) ;let*
+  ) ;if
+) ;define-public
 
 (define-public (telemetry-flush)
   (if (null? *telemetry-event-queue*)
     #t
-    (let ((owner (telemetry-acquire-lock)))
-      (if owner
-        (let ((ok? (telemetry-write-pending (reverse *telemetry-event-queue*))))
-          (if ok?
-            (begin
-              (set! *telemetry-event-queue* '())
-              (telemetry-release-lock owner)
-              #t)
-            (begin
-              (display (string-append "[telemetry] error: flush failed, keeping "
-                                      (number->string (length *telemetry-event-queue*))
-                                      " events in memory queue\n"))
-              (telemetry-release-lock owner)
-              #f)))
-        #f))))
+    (let ((ok? (telemetry-write-pending (reverse *telemetry-event-queue*))))
+      (if ok?
+        (begin
+          (set! *telemetry-event-queue* '())
+          #t
+        ) ;begin
+        (begin
+          (display (string-append "[telemetry] error: flush failed, keeping "
+                     (number->string (length *telemetry-event-queue*))
+                     " events in memory queue\n"
+                   ) ;string-append
+          ) ;display
+          #f
+        ) ;begin
+      ) ;if
+    ) ;let
+  ) ;if
+) ;define-public