dxfmakros/tests/test_hm_recformat.lsp

;; ============================================================
;; test_hm_recformat.lsp - Regressionstest fuer das AUFZEICHNUNGSFORMAT
;; (rec = recorded): baut die 5 VarioFoerderer-Linienzuege der Anlage HundM
;; aus den Journalen nach, die in der Kundenzeichnung stehen.
;;
;; ABGRENZUNG zu TEST_HUNDM05 (tests/test_hundm05.lsp): dort werden dieselben
;; 5 Ketten aus einer SPEC gebaut (tests/testdata/hundm05.json, das neue
;; Eingabeformat) - das ist der Test fuer den Bau-Pfad und der, der
;; routinemaessig laeuft. HIER geht es um etwas anderes: das Journal kommt
;; roh aus der XDATA einer echten Zeichnung. Damit ist dies der einzige Test,
;; der belegt, dass ein BESTEHENDER VF_n-Block weiter abspielbar bleibt -
;; also dass Doppelklick-Editieren und 2D/3D-Konvertierung an Altbestand
;; funktionieren (Invariante I1 in doc/TODO-plan-vf-interactive.md). Ein
;; spec-gebautes Journal kann das nicht zeigen, es kommt aus dem Uebersetzer.
;;
;; Darum in tests/alltests.json auf "disabled": true - er baut dieselbe
;; Geometrie wie TEST_HUNDM05 und kostet doppelte CAD-Zeit. Bei Aenderungen
;; am Journal-Format, an den vfl-in-*-Wrappern oder am XDATA-Layout aber
;; bewusst einschalten: dann ist er der Test, der zaehlt.
;;
;; Datenquelle: tests/testdata/hm_recformat.json, erzeugt von
;;   python lib/vf_journal_export.py data/polylines.dxf \
;;          tests/testdata/hm_recformat.json --csv results/HundM_export.csv
;; Das sind die EINGABE-JOURNALE der echten Ketten - ausgelesen aus der XDATA
;; (App SSG_VF_EDIT, Marker "linienzug") der VF_n-Bloecke in data/polylines.dxf,
;; also genau die Werte, mit denen die Ketten in BricsCAD gebaut wurden.
;;
;; JSON-Aufbau (FLACH, weil ssg-load-json zeilenweise liest - Details in
;; tests/testdata/object_data.md Abschnitt 8):
;;   Kopf-Objekt   (traegt "test_id"): test_id, anlagetyp, modus,
;;                 anzahl_eingaben, block, dxf_handle, startpunkt_mm,
;;                 rotation_grad, beschreibung, sivas_* , erwartung_hinweis
;;   Eingabe-Objekt (traegt "typ"):   point_abs | point_rel | real | int |
;;                 string | step - in exakter Frage-Reihenfolge
;; Ein Kopf-Objekt beginnt eine Kette, die folgenden Eingabe-Objekte gehoeren
;; dazu (hmrec:gruppiere).
;;
;; WARUM REPLAY UND KEINE EINGABE-MOCKS (Unterschied zu test_linienzug.lsp):
;; test_linienzug.lsp ersetzt getpoint/getstring/getint/getreal durch Mocks und
;; rechnet Punkte aus "dL"+"hz" selbst aus. Das geht nur, weil
;; linienzug_tests.json zu JEDEM Segment ein "hz" mitfuehrt. Ein echtes Journal
;; tut das nicht: vfl-in-abstand journalisiert die Fahrtrichtung NUR beim
;; allerersten Segment der Kette, jedes weitere erbt sie vom Vorgaenger. Ein
;; Mock kann diese geerbte Richtung nicht kennen - er wuerde einen Punkt in der
;; falschen Richtung liefern und die Projektion in vfl-neue-linie-messen ergaebe
;; eine falsche (bis auf 0 zusammenfallende) Laenge. Darum wird hier derselbe
;; Weg genommen, den die Produktion beim Editieren/Konvertieren nutzt:
;; vfl-journal-replay-start + vf-linienzug-modus (siehe vfl-konvertiere-ent in
;; Lisp/vf_linienzug.lsp). Die vfl-in-*-Wrapper ziehen ihre Werte dann direkt
;; aus der Replay-Queue - inklusive der Sonderregel fuer "hz".
;;
;; Voraussetzungen:
;;   - SSG_LIB geladen (VarioFoerderer inkl. vf_linienzug, Gefaellestrecke,
;;     ssg_core, ssg_dbg)
;;   - Umgebungsvariable DXFMAKRO gesetzt
;;
;; Speichert (via SSG_RUN_ALL_TESTS bei "save":"dxf"):
;;   tests/output/hm_recformat_tests.dxf
;;   tests/output/hm_recformat_results.json  (via hm_recformat:export-results)
;;
;; Aufruf in BricsCAD:
;;   (load (strcat (getenv "DXFMAKRO") "/tests/test_hm_recformat.lsp"))
;;   TEST_HM_RECFORMAT          ; in der aktuellen Dimension (ssg-ils-dim-aktuell)
;;   TEST_HM_RECFORMAT_2D       ; erzwungen 2D
;;   TEST_HM_RECFORMAT_3D       ; erzwungen 3D
;;
;; Debug-Datei (nur wenn eingeschaltet): (dbg-schalter-on "hm_recformat")
;; schreibt hm_recformat.dbg ins DXFM_LOG-Verzeichnis (Journal je Kette als JSON).
;; ============================================================


;; ============================================================
;; Ergebnis-JSON
;; ============================================================

;; --- JSON-Hilfen fuer Diagnosefelder (Strings/String-Listen) ---
;; Die extra-Felder in hmrec:result-json werden ROH in das JSON gesetzt,
;; ein Text muss also selbst seine Anfuehrungszeichen mitbringen und die
;; JSON-Sonderzeichen maskieren.
(defun hmrec:json-escape (s / out i c)
  (setq out "" i 1)
  (while (<= i (strlen s))
    (setq c (substr s i 1))
    (setq out (cond ((= c "\"") (strcat out "\\\""))
                    ((= c "\\") (strcat out "\\\\"))
                    ((= c "\n") (strcat out " "))
                    (T (strcat out c))))
    (setq i (1+ i)))
  out)

(defun hmrec:json-str (s)
  (if s (strcat "\"" (hmrec:json-escape s) "\"") "null"))

(defun hmrec:json-liste (lst / s first)
  (setq s "[" first T)
  (foreach x lst
    (if (not first) (setq s (strcat s ", ")))
    (setq s (strcat s (hmrec:json-str x))  first nil))
  (strcat s "]"))

;; --- Headless-Diagnose der Produktion lesen ---
;; vfl-headless-abbruch (Lisp/vf_linienzug.lsp) legt bei erschoepfter
;; Replay-Queue Art der Eingabe, Glied-Nummer und Eingabe-Nummer ab. Das ist
;; die eigentliche Desync-Auskunft - ohne sie weiss man nur, DASS Werte offen
;; blieben, nicht WO der Ablauf abgewichen ist.
(defun hmrec:headless-fehler-text ( / f)
  (if (and (boundp '*vfl-headless-fehler*) *vfl-headless-fehler*)
    (progn
      (setq f *vfl-headless-fehler*)
      (strcat (cdr (assoc "was" f)) " @ " (cdr (assoc "ort" f))))
    nil))

;; Zaehler der trotz allem erreichten Live-Eingaben (muss 0 bleiben).
(defun hmrec:prompts ()
  (if (and (boundp '*hmrec-prompts*) *hmrec-prompts*) *hmrec-prompts* 0))


;; "dimension" haelt fest, in welcher Dimension (2D/3D) gebaut wurde. Das ist
;; KEINE Eigenschaft der Eingabedaten: hm_recformat.json beschreibt die Ketten
;; dimensionsfrei. Womit unsere Makros bauen, entscheidet ssg-ils-dim-aktuell -
;; unsere Bibliothek hat von jedem Block eine _2D- und eine _3D-Variante.
;; extra: Alist zusaetzlicher Felder ((name . wert-string)), wird als
;; JSON-Zahlen/Strings so uebernommen, wie sie uebergeben werden.
(defun hmrec:result-json (test-id kind status block-name block-handle
                            insert-point attribs extra /
                            json tag val first)
  (setq json (strcat "  {\n"
    "    \"test_id\": \"" test-id "\",\n"
    "    \"kind\": \"" kind "\",\n"
    "    \"status\": \"" status "\",\n"
    "    \"dimension\": \""
      (if (and (boundp '*hmrec-dimension*) *hmrec-dimension*)
        *hmrec-dimension* "?") "\",\n"
    "    \"block_name\": \"" (if block-name block-name "") "\",\n"
    "    \"block_handle\": \"" (if block-handle block-handle "") "\",\n"
    "    \"insert_point\": ["
      (if insert-point
        (strcat (rtos (car insert-point) 2 1) ", "
                (rtos (cadr insert-point) 2 1) ", "
                (rtos (if (caddr insert-point) (caddr insert-point) 0.0) 2 1))
        "0.0, 0.0, 0.0")
    "],\n"))
  (foreach f extra
    (setq json (strcat json "    \"" (car f) "\": " (cdr f) ",\n")))
  (setq json (strcat json "    \"actual_attributes\": {"))
  (setq first T)
  (foreach att attribs
    (setq tag (car att) val (cdr att))
    (if (not first) (setq json (strcat json ",")))
    (setq json (strcat json "\n      \"" tag "\": \"" (if val val "") "\""))
    (setq first nil))
  (setq json (strcat json "\n    }\n  }"))
  json
)


;; --- Aus einer Block-ENAME ein Ergebnis-JSON erzeugen ---
;; status: "executed" bei sauberem Lauf; ein abweichender Status (z.B. bei
;; einem Queue-Desync) wird durchgereicht, die Block-Angaben bleiben dabei
;; erhalten - sonst waere der betroffene Block im Ergebnis nicht auffindbar.
(defun hmrec:ent-json-status (test-id kind status ent extra / ed)
  (if ent
    (progn
      (setq ed (entget ent))
      (hmrec:result-json test-id kind status
                        (cdr (assoc 2 ed)) (cdr (assoc 5 ed)) (cdr (assoc 10 ed))
                        (ssg-attrib-read ent) extra))
    (hmrec:result-json test-id kind "failed" nil nil nil nil extra))
)

(defun hmrec:ent-json (test-id kind ent extra)
  (hmrec:ent-json-status test-id kind "executed" ent extra)
)


;; --- Letzten INSERT mit Blocknamen-Praefix suchen ---
;; AutoLISP kennt KEIN entprev (nur entnext und entlast) - rueckwaerts durch
;; die Zeichnung laufen geht also nicht. Gesucht wird darum VORWAERTS, wobei
;; der letzte Treffer gewinnt. Ein blosses (entlast) genuegt nicht: nach dem
;; Bau koennen weitere Objekte entstehen (z.B. Beschriftungstexte), entlast
;; ist dann nicht der gesuchte Block - genau daran scheiterte der Testlauf.
;; ab-ent = Stand der Zeichnung VOR dem Bau. Damit prueft die Suche nur die
;; neu entstandenen Objekte: schnell, und sie kann nicht versehentlich den
;; Block eines frueheren Baus liefern (siehe Kommentar bei -ab).
(defun hmrec:insert-prefix-p (ent pref / ed bn)
  (setq ed (entget ent)  bn (cdr (assoc 2 ed)))
  (and ed (= (cdr (assoc 0 ed)) "INSERT") bn
       (>= (strlen bn) (strlen pref))
       (= (substr bn 1 (strlen pref)) pref)))

;; Vorwaertslauf ab ab-ent (nil = ganze Zeichnung); der LETZTE Treffer
;; gewinnt. Der entget-Test faengt ein inzwischen ungueltiges ab-ent ab
;; (entget liefert dann nil, entnext wuerde einen Fehler werfen).
(defun hmrec:suche-vorwaerts (pref ab-ent / ent found)
  (setq ent (if (and ab-ent (entget ab-ent)) (entnext ab-ent) (entnext)))
  (while ent
    (if (hmrec:insert-prefix-p ent pref) (setq found ent))
    (setq ent (entnext ent)))
  found)

(defun hmrec:last-insert-prefix-ab (pref ab-ent / ent)
  (if ab-ent
    ;; MIT Marker nur die neu entstandenen Objekte pruefen - und BEWUSST
    ;; ohne entlast-Kurzschluss: hat dieser Bau keinen Block erzeugt, waere
    ;; entlast der Block eines FRUEHEREN Baus und das Ergebnis wuerde der
    ;; falschen Kette zugeordnet. Kein Treffer = kein Block, das ist die
    ;; richtige Antwort.
    (hmrec:suche-vorwaerts pref ab-ent)
    (progn
      ;; Ohne Marker: erst entlast (der haeufige Fall, das gerade
      ;; eingefuegte Objekt), sonst die ganze Zeichnung.
      (setq ent (entlast))
      (if (and ent (hmrec:insert-prefix-p ent pref))
        ent
        (hmrec:suche-vorwaerts pref nil)))))

(defun hmrec:last-insert-prefix (pref)
  (hmrec:last-insert-prefix-ab pref nil))


;; ============================================================
;; JSON-Eintraege -> Ketten
;; ============================================================

;; Das flache JSON-Array in Ketten gruppieren: ein Objekt mit "test_id" ist
;; ein Kopf und beginnt eine neue Kette, die folgenden Objekte mit "typ" sind
;; ihre Eingaben (Reihenfolge = Frage-Reihenfolge, bleibt erhalten).
;; Rueckgabe: Liste von (kopf eingaben-liste).
(defun hmrec:gruppiere (daten / ketten kopf eingaben)
  (setq ketten '() kopf nil eingaben '())
  (foreach obj daten
    (cond
      ((ssg-val obj "test_id")
        (if kopf
          (setq ketten (cons (list kopf (reverse eingaben)) ketten)))
        (setq kopf obj eingaben '()))
      ((ssg-val obj "typ")
        (if kopf (setq eingaben (cons obj eingaben))))
    )
  )
  (if kopf (setq ketten (cons (list kopf (reverse eingaben)) ketten)))
  (reverse ketten)
)


;; --- Wert als String lesen (auch wenn er als Zahl im JSON steht) ---
;; Die Menue-Antworten sind Strings ("1"/"2"/"90"/"30"). Steht in einer von
;; Hand gepflegten Datei versehentlich 1 statt "1", wuerde ein Zahlenwert in
;; die Replay-Queue wandern und der Vergleich (= antwort "1") schlagen fehl -
;; darum hier immer nach String wandeln.
(defun hmrec:als-string (v)
  (cond
    ((null v) "")
    ((= (type v) 'STR) v)
    ((= (type v) 'INT) (itoa v))
    ((= (type v) 'REAL) (rtos v 2 6))
    (T "")
  )
)


;; --- Einen Eingabe-Eintrag in Journal-Eintraege uebersetzen ---
;; Journal-Format (vfl-entry->string in Lisp/vf_linienzug.lsp):
;;   ("PT" x y z) / ("REAL" . r) / ("DL" . r) / ("INT" . i) / ("STR" . s) /
;;   ("STEP" . label)
;; Ein "point_rel" wird zu EINEM oder ZWEI Eintraegen: immer die Laenge (DL),
;; zusaetzlich die Fahrtrichtung (REAL) nur dort, wo sie im Journal steht
;; (allererstes Segment der Kette, siehe Kopfkommentar).
;; Rueckgabe: Liste von Journal-Eintraegen (kann leer sein).
(defun hmrec:eintrag->journal (e / typ w hz)
  (setq typ (ssg-val e "typ"))
  (cond
    ((= typ "point_abs")
      (setq w (ssg-val e "wert"))
      (if (and w (listp w) (>= (length w) 3))
        (list (cons "PT" (mapcar 'float w)))
        nil))
    ((= typ "point_rel")
      (setq w (ssg-val e "dL") hz (ssg-val e "hz"))
      (cond
        ((not (numberp w)) nil)
        ((numberp hz) (list (cons "DL" (float w)) (cons "REAL" (float hz))))
        (T (list (cons "DL" (float w))))))
    ((= typ "real")
      (setq w (ssg-val e "wert"))
      (if (numberp w) (list (cons "REAL" (float w))) nil))
    ((= typ "int")
      (setq w (ssg-val e "wert"))
      (if (numberp w) (list (cons "INT" (fix w))) nil))
    ((= typ "string")
      (list (cons "STR" (hmrec:als-string (ssg-val e "wert")))))
    ((= typ "step")
      (list (cons "STEP" (hmrec:als-string (ssg-val e "wert")))))
    (T nil)
  )
)


;; --- Alle Eingaben einer Kette in ein Vorwaerts-Journal uebersetzen ---
;; Vorwaerts = Bau-Reihenfolge, genau so erwartet es vfl-journal-replay-start.
(defun hmrec:journal-bauen (eingaben / out)
  (setq out '())
  (foreach e eingaben
    (foreach j (hmrec:eintrag->journal e)
      (setq out (cons j out))))
  (reverse out)
)


;; --- Nicht verbrauchte Werte in der Replay-Queue zaehlen ---
;; STEP-Marker zaehlen nicht mit: vfl-replay-pop ueberspringt sie, sie sind
;; also kein offener Wert. Bleibt hier etwas uebrig, ist der Bau-Ablauf vom
;; aufgezeichneten abgewichen (Desync) - das MUSS auffallen.
(defun hmrec:queue-rest ( / n)
  (setq n 0)
  (if (and (boundp '*vfl-replay-queue*) *vfl-replay-queue*)
    (foreach e *vfl-replay-queue*
      (if (/= (car e) "STEP") (setq n (1+ n)))))
  n
)


;; ============================================================
;; Eine Kette bauen
;; ============================================================

;; Spielt das Journal einer Kette ab. Ablauf wie vfl-konvertiere-ent
;; (Lisp/vf_linienzug.lsp): Queue setzen, vf-linienzug-modus laufen lassen,
;; danach den entstandenen VF_n-Block einsammeln.
;;
;; vl-catch-all-apply ist hier BEWUSST gesetzt (anders als im interaktiven
;; Editier-Pfad vfl-edit-ent): bricht eine Kette ab, muss die Testschleife
;; ueber die restlichen Ketten weiterlaufen. Der Preis ist derselbe wie beim
;; Batch-Konverter - der *error*-Handler in vf-linienzug-modus (der die
;; Teil-Geometrie zu einem Block wickelt) kommt dann nicht zum Zug und die
;; Teilgeometrie bleibt lose in der Zeichnung liegen. Der Testfall wird darum
;; klar als "failed" samt Fehlertext gemeldet.
;; *error* wird um den Aufruf herum gesichert: nach einem abgefangenen Abbruch
;; steht dort noch der Handler-Lambda von vf-linienzug-modus (es kommt nicht
;; mehr zu dessen (setq *error* old-error)) - ohne Restore wuerde die naechste
;; Kette auf einem Handler mit toten dynamischen Bindungen aufsetzen.
(defun hmrec:build-linienzug (kopf eingaben / tid journal anz offen err ent
                                 alt-error extra hl-fehler meldungen vor-ent)
  (setq tid (ssg-val kopf "test_id"))
  (setq journal (hmrec:journal-bauen eingaben))
  (setq anz (length journal))
  (princ (strcat "\n  [LINIENZUG] " tid " -> " (itoa (length eingaben))
                 " Eingaben, " (itoa anz) " Journal-Eintraege"))
  (if (ssg-val kopf "beschreibung")
    (princ (strcat "\n              " (ssg-val kopf "beschreibung"))))
  (if (and (boundp '*hmrec-dbg*) *hmrec-dbg*)
    (progn
      (dbgmsg (strcat "KETTE " tid " JOURNAL " (vfl-journal->json journal)))
      (dbgflush)))

  (cond
    ;; Ohne Journal (oder ohne Startpunkt an erster Stelle) nichts bauen: ein
    ;; Replay ohne PT wuerde den Startpunkt interaktiv erfragen und die ganze
    ;; Kette an der falschen Stelle aufbauen.
    ((null journal)
      (princ (strcat "\n  FEHLER: " tid " - keine Eingaben lesbar."
                     " Stehen die Zahlen-Arrays in EINER Zeile?"
                     " (ssg-cfg-parse-array kann keine umgebrochenen lesen)"))
      (hmrec:result-json tid "linienzug" "failed" nil nil nil nil
        (list (cons "eingaben_gesamt" (itoa anz))
              (cons "eingaben_offen" (itoa anz)))))

    ((/= (car (car journal)) "PT")
      (princ (strcat "\n  FEHLER: " tid " - erster Eintrag ist kein"
                     " Startpunkt (point_abs), nichts gebaut."))
      (hmrec:result-json tid "linienzug" "failed" nil nil nil nil
        (list (cons "eingaben_gesamt" (itoa anz))
              (cons "eingaben_offen" (itoa anz)))))

    (T
      ;; Stand der Zeichnung VOR dem Bau: der fertige VF_-Block wird danach
      ;; ab hier gesucht (siehe hmrec:last-insert-prefix-ab).
      (setq vor-ent (entlast))
      (setq alt-error *error*)
      (vfl-journal-reset)
      (vfl-journal-replay-start journal)
      (setq err (vl-catch-all-apply 'vf-linienzug-modus '()))
      (setq offen (hmrec:queue-rest))
      ;; Diagnose VOR dem Reset sichern: vfl-journal-reset loescht
      ;; *vfl-headless-fehler* und *vfl-meldungen* mit (beide gehoeren zum
      ;; einzelnen Lauf, nicht zur Sitzung).
      (setq hl-fehler (hmrec:headless-fehler-text))
      (setq meldungen (if (boundp '*vfl-meldungen*) *vfl-meldungen* nil))
      (setq *error* alt-error)
      (vfl-journal-reset)
      (setq extra (list (cons "eingaben_gesamt" (itoa anz))
                        (cons "eingaben_offen" (itoa offen))
                        (cons "prompts" (itoa (hmrec:prompts)))
                        (cons "headless_fehler" (hmrec:json-str hl-fehler))
                        (cons "meldungen" (hmrec:json-liste meldungen))))
      (cond
        ;; Der Headless-Riegel der Produktion hat gegriffen: die Journal-Daten
        ;; passen nicht zum tatsaechlichen Bau-Ablauf. Praeziser als "failed",
        ;; weil hl-fehler Glied UND Eingabe-Nummer nennt.
        (hl-fehler
          (princ (strcat "\n  DESYNC: " tid " - " hl-fehler))
          (hmrec:ent-json-status tid "linienzug" "desync"
                                   (hmrec:last-insert-prefix-ab "VF_" vor-ent) extra))
        ((vl-catch-all-error-p err)
          (princ (strcat "\n  FEHLER: " tid " abgebrochen -> "
                         (vl-catch-all-error-message err)))
          (hmrec:result-json tid "linienzug" "failed" nil nil nil nil extra))
        ;; Kette gebaut, aber der Ablauf hat nicht alle aufgezeichneten Werte
        ;; abgerufen: die Geometrie kann nicht der Vorlage entsprechen.
        ((> offen 0)
          (princ (strcat "\n  FEHLER: " tid " - " (itoa offen)
                         " Journal-Werte NICHT verbraucht (Ablauf weicht"
                         " von der Aufzeichnung ab)."))
          (hmrec:ent-json-status tid "linienzug" "desync"
                                   (hmrec:last-insert-prefix-ab "VF_" vor-ent) extra))
        (T
          (setq ent (hmrec:last-insert-prefix-ab "VF_" vor-ent))
          (if ent
            (princ (strcat "  -> Block " (cdr (assoc 2 (entget ent)))))
            (princ "\n  FEHLER: kein VF_-Block gefunden"))
          (hmrec:ent-json tid "linienzug" ent extra)))))
)


;; ============================================================
;; Headless-Absicherung: Dialoge aus, leere Queue bricht ab
;; ============================================================
;; Die Journale sind vollstaendig, es darf also keine Live-Eingabe geben.
;; Falls doch (Desync), wuerde ein getpoint/getstring den Testlauf blockieren
;; und ein alert-Fenster ihn haengen lassen. Darum werden die Eingabe-
;; Funktionen fuer die Dauer des Tests durch Abbruch-Stubs ersetzt (liefern
;; nil = Abbruch, was vf-linienzug-modus sauber beendet) und alert auf die
;; Konsole umgeleitet. Alles mit Save/Restore, siehe hmrec:stubs-aus.
;; Die Stubs haben feste 1- bzw. 2-Arity (AutoLISP kennt keine optionalen
;; Parameter) - genau wie die Mocks in test_linienzug.lsp. Ruft der Bau-Ablauf
;; eine der Funktionen mit anderer Argumentzahl auf, gibt es einen
;; Argumentfehler statt einer Warnung; beides landet im vl-catch-all-apply um
;; vf-linienzug-modus und meldet die Kette als "failed". Wichtig ist nur, dass
;; kein Prompt und kein Dialog den Lauf blockiert.
(defun hmrec:stub-warnung (was)
  (setq *hmrec-prompts* (1+ (hmrec:prompts)))
  (princ (strcat "\n  WARNUNG: unerwartete Live-Eingabe (" was
                 ") - Replay-Queue leer, Kette wird abgebrochen."))
  nil
)
(defun hmrec:stub-getpoint (a b) (hmrec:stub-warnung "getpoint"))
(defun hmrec:stub-getstring (a)  (hmrec:stub-warnung "getstring"))
(defun hmrec:stub-getint (a)     (hmrec:stub-warnung "getint"))
(defun hmrec:stub-getreal (a)    (hmrec:stub-warnung "getreal"))
(defun hmrec:stub-alert (msg)
  (princ (strcat "\n  ALERT (unterdrueckt): " (if msg msg "")))
  (princ)
)

(defun hmrec:stubs-an ( / )
  (setq *hmrec-alt-getpoint* vfl-getpoint
        *hmrec-alt-getstring* getstring
        *hmrec-alt-getint*   getint
        *hmrec-alt-getreal*  getreal
        *hmrec-alt-alert*    alert)
  (setq vfl-getpoint hmrec:stub-getpoint
        getstring    hmrec:stub-getstring
        getint       hmrec:stub-getint
        getreal      hmrec:stub-getreal
        alert        hmrec:stub-alert)
  ;; Wizard-Dialoge aus (waehrend eines Replays greifen sie ohnehin nicht,
  ;; siehe vfl-wizard-aktiv - aber nach einem Desync wuerde ein Dialog
  ;; aufgehen und warten).
  (setq *hmrec-alt-wizard* (if (boundp '*vfl-wizard-mode*) *vfl-wizard-mode*))
  (setq *vfl-wizard-mode* nil)
  (if (car (atoms-family 1 '("SSG-GUI-AUS"))) (ssg-gui-aus))
  ;; Headless-Riegel der Produktion einschalten: eine erschoepfte Replay-Queue
  ;; ist dann ein harter, lokalisierter Abbruch statt eines stillen Rueckfalls
  ;; auf Live-Eingabe (siehe vfl-headless-abbruch). Die Stubs oben bleiben als
  ;; zweites Netz - sie fangen die Prompts ausserhalb der vfl-in-*-Wrapper
  ;; (Modus 3, Nebenpfade) und zaehlen sie.
  (setq *hmrec-alt-headless* (if (boundp '*vfl-headless*) *vfl-headless*))
  (setq *vfl-headless* T)
  (setq *hmrec-prompts* 0)
  (princ)
)

(defun hmrec:stubs-aus ( / )
  (setq vfl-getpoint *hmrec-alt-getpoint*
        getstring    *hmrec-alt-getstring*
        getint       *hmrec-alt-getint*
        getreal      *hmrec-alt-getreal*
        alert        *hmrec-alt-alert*)
  (setq *vfl-wizard-mode* *hmrec-alt-wizard*)
  (setq *vfl-headless* *hmrec-alt-headless*)
  (if (car (atoms-family 1 '("SSG-GUI-AN"))) (ssg-gui-an))
  (princ)
)


;; ============================================================
;; Alle Ketten bauen
;; ============================================================
;; Eigene Funktion, damit der Aufrufer sie in vl-catch-all-apply klammern und
;; die Eingabe-Stubs GARANTIERT zuruecknehmen kann (ein hier entkommender
;; Fehler wuerde sonst getstring/getpoint/alert der laufenden BricsCAD-Sitzung
;; ersetzt zuruecklassen).
;; Rueckgabe: Ergebnis-Liste in Bau-Reihenfolge.
(defun hmrec:ketten-bauen (ketten / kette res out tid fehlertext)
  (setq out '())
  (foreach kette ketten
    ;; Dimensions-Override je Kette neu setzen: der Abbruch-Handler in
    ;; vf-linienzug-modus setzt *ssg-ils-dim* zurueck, ein Abbruch wuerde die
    ;; folgenden Ketten sonst in der falschen Dimension bauen.
    (if (and (boundp '*hmrec-dim-override*) *hmrec-dim-override*)
      (setq *ssg-ils-dim* *hmrec-dim-override*))
    ;; Je Kette gefangen: ein Fehler NACH dem Bau (z.B. beim Auswerten des
    ;; Ergebnisses) darf nicht die restlichen Ketten mitnehmen - sonst steht
    ;; am Ende "0 OK, 0 Fehler" und man sieht nicht einmal, welche Kette
    ;; gebaut wurde. Der Bau selbst ist in hmrec:build-linienzug bereits
    ;; separat gefangen; dieser Riegel hier deckt alles danach ab.
    (setq tid (ssg-val (car kette) "test_id"))
    (setq res (vl-catch-all-apply 'hmrec:build-linienzug
                (list (car kette) (cadr kette))))
    (if (vl-catch-all-error-p res)
      (progn
        (setq fehlertext (vl-catch-all-error-message res))
        (princ (strcat "\n  FEHLER: " tid " - Ausnahme: " fehlertext))
        (setq res (hmrec:result-json tid "linienzug" "failed"
                    nil nil nil nil
                    (list (cons "fehler_text"
                                (hmrec:json-str fehlertext)))))))
    (if res (setq out (cons res out))))
  (reverse out)
)


;; ============================================================
;; JSON-Export der Ergebnisse
;; ============================================================
(defun hm_recformat:export-results (tests-out-dir / out-json f first)
  (if (null *hmrec-test-results*)
    (princ "\n  Keine Ergebnisse vorhanden.")
    (progn
      (vl-mkdir tests-out-dir)
      (setq out-json (strcat tests-out-dir "/hm_recformat_results.json"))
      (setq f (open out-json "w"))
      (if f
        (progn
          (write-line "[" f)
          (setq first T)
          (foreach r *hmrec-test-results*
            (if (not first) (write-line "," f))
            (write-line r f)
            (setq first nil))
          (write-line "]" f)
          (close f)
          (princ (strcat "\n  Ergebnisse: " out-json)))
        (princ (strcat "\n  FEHLER: Kann " out-json " nicht schreiben!")))))
)


;; ============================================================
;; C:TEST_HM_RECFORMAT - Hauptbefehl
;; ============================================================
(defun c:TEST_HM_RECFORMAT ( / json-datei daten ketten results-list res
                          anz-ok anz-fehler)
  ;; Debug-Datei nur bei eingeschaltetem Schalter: (dbg-schalter-on "hm_recformat")
  (setq *hmrec-dbg*
    (and (car (atoms-family 1 '("DBG-SCHALTER-OPEN")))
         (dbg-schalter-open "hm_recformat" "hm_recformat.dbg" "DXFM_LOG")))

  ;; Benoetigte Feature-Module laden (Linienzug braucht Vario + Gefaelle)
  (ssg-ensure "VarioFoerderer")
  (ssg-ensure "Gefaellestrecke")

  (if (null (car (atoms-family 1 '("VF-LINIENZUG-MODUS"))))
    (progn
      (princ "\n[TEST_HM_RECFORMAT] FEHLER: vf-linienzug-modus nicht geladen"
             " (VarioFoerderer/Gefaellestrecke laden).")
      (if *hmrec-dbg* (dbgclose))
      (exit)))

  (ssg-start "TEST_HM_RECFORMAT" '(("OSMODE") ("CECOLOR") ("ATTREQ") ("ATTDIA")))
  (setvar "OSMODE" 0)
  (setvar "ATTREQ" 0)
  (setvar "ATTDIA" 0)

  ;; Block-Bibliothek (Bogen-/AS-/ES-Masse) initialisieren
  (if (or (not *lib-initialized*) (null bogen-auf))
    (init-bibliothek))

  ;; Bau-Dimension festhalten. Die Eingabedaten sind dimensionsfrei; welche
  ;; Blockvariante (_2D/_3D) verwendet wird, loest ssg-ils-dim-aktuell auf
  ;; (Override *ssg-ils-dim* -> Umgebungsvariable DXFM_DIM -> Default "3D").
  (setq *hmrec-dimension* (ssg-ils-dim-aktuell))
  (princ (strcat "\n  Bau-Dimension: " *hmrec-dimension*
                 " (umschalten: TEST_HM_RECFORMAT_2D / TEST_HM_RECFORMAT_3D)"))

  ;; Testdaten laden
  (setq json-datei (strcat (getenv "DXFMAKRO") "/tests/testdata/hm_recformat.json"))
  (if (not (findfile json-datei))
    (progn
      (princ (strcat "\n[TEST_HM_RECFORMAT] FEHLER: " json-datei " nicht gefunden!"))
      (ssg-end)
      (if *hmrec-dbg* (dbgclose))
      (exit)))
  (setq daten (ssg-load-json json-datei))
  (if (null daten)
    (progn
      (princ "\n[TEST_HM_RECFORMAT] FEHLER: Testdaten konnten nicht geladen werden.")
      (ssg-end)
      (if *hmrec-dbg* (dbgclose))
      (exit)))

  (setq ketten (hmrec:gruppiere daten))
  (if (null ketten)
    (progn
      (princ "\n[TEST_HM_RECFORMAT] FEHLER: keine Kette gefunden - erwartet werden"
             " Kopf-Objekte mit \"test_id\" und Eingaben mit \"typ\".")
      (ssg-end)
      (if *hmrec-dbg* (dbgclose))
      (exit)))

  (princ "\n\n================================================================")
  (princ "\n  TEST_HM_RECFORMAT - 5 Linienzuege der Anlage HundM (polylines.dxf)")
  (princ (strcat "\n  " (itoa (length daten)) " JSON-Objekte, "
                 (itoa (length ketten)) " Ketten"))
  (princ "\n================================================================")

  (setq anz-ok 0 anz-fehler 0)
  (hmrec:stubs-an)
  ;; Stubs MUESSEN auch nach einem unerwarteten Fehler zurueckgenommen werden.
  (setq results-list (vl-catch-all-apply 'hmrec:ketten-bauen (list ketten)))
  (hmrec:stubs-aus)
  (if (vl-catch-all-error-p results-list)
    (progn
      (princ (strcat "\n[TEST_HM_RECFORMAT] FEHLER in der Kettenschleife: "
                     (vl-catch-all-error-message results-list)))
      (setq results-list '())))

  (foreach res results-list
    (if (vl-string-search "\"status\": \"executed\"" res)
      (setq anz-ok (1+ anz-ok))
      (setq anz-fehler (1+ anz-fehler))))

  (princ "\n================================================================")
  (princ (strcat "\n  Ergebnis: " (itoa anz-ok) " OK, "
                 (itoa anz-fehler) " Fehler"))
  (princ "\n================================================================")

  (setq *hmrec-test-results* results-list)

  (ssg-end)
  (princ "\n  TEST_HM_RECFORMAT abgeschlossen.")
  (if *hmrec-dbg* (dbgclose))
  (princ)
)


;; ============================================================
;; Dieselbe Anlage in einer bestimmten Dimension bauen
;; ============================================================
;; Die Eingabedaten (hm_recformat.json) sind dimensionsfrei - sie beschreiben die
;; Eingaben, mit denen die Ketten gebaut wurden. Ob daraus flache 2D-Symbole
;; oder 3D-Modelle werden, entscheidet allein die Blockvariante (_2D/_3D), die
;; ssg-ils-dim-aktuell aufloest. Unsere Bibliothek hat beide, also laesst sich
;; dieselbe Anlage ohne Datenaenderung in 2D ODER 3D aufbauen.
;; *hmrec-dim-override* wird in der Kettenschleife je Kette neu gesetzt
;; (siehe dort).
(defun hmrec:mit-dimension (dim / alt ergebnis)
  (setq alt (if (boundp '*ssg-ils-dim*) *ssg-ils-dim*))
  (setq *ssg-ils-dim* dim)
  (setq *hmrec-dim-override* dim)
  (princ (strcat "\n[TEST_HM_RECFORMAT] Dimension voruebergehend auf " dim
                 " gesetzt."))
  (setq ergebnis (c:TEST_HM_RECFORMAT))
  ;; Override wieder auf den vorherigen Stand - sonst baut ein folgender Test
  ;; unbemerkt in der hier gewaehlten Dimension weiter.
  (setq *ssg-ils-dim* alt)
  (setq *hmrec-dim-override* nil)
  (princ (strcat "\n[TEST_HM_RECFORMAT] Dimension zurueckgesetzt auf "
                 (if alt alt "Umgebung/Default") "."))
  ergebnis
)

(defun c:TEST_HM_RECFORMAT_2D ( / ) (hmrec:mit-dimension "2D"))
(defun c:TEST_HM_RECFORMAT_3D ( / ) (hmrec:mit-dimension "3D"))