patch modify bug incorrectly identifying source file to be replaced

modify.rkt

@@ -1,7 +1,7 @@
 #lang cli
 
 (require (only-in racket/date current-date date->string date-display-format)
-         (only-in racket/string string-join non-empty-string?)
+         (only-in racket/string string-join string-split non-empty-string?)
          (only-in racket/list first second third fourth fifth last take drop flatten add-between)
          (only-in racket/format ~a)
          (only-in racket/exn exn->string)
@@ -27,7 +27,7 @@
 
 ;; example
 ;; modify -input-file in-progress/beginning-latl.scm --resource-type unsettled
-;; --headline "Beginning LATL" 
+;; --headline "Beginning LATL"
 ;; publish -i in-progress/beginning-latl.scm -r unsettled -l "Beginning LATL"
 
 (help (usage "modify is here to update existing posts with new content."))
@@ -40,7 +40,7 @@
                        [(equal? t "unsettled") "unsettled"]
                        [(equal? t "root") "root"]
                        [else (error 'failure "couldn't recognize resource. please use one of 'settled' 'unsettled' 'root'")])))
-       
+
 (flag (input #:param [input ""] i)
       ("-i" "--input-file" "file to publish")
       (input (if (file-exists? i)
@@ -66,8 +66,8 @@
        [update-time (date->string (current-date) (date-display-format 'iso-8601))]
        [rollback-thunks (list)])
    (displayln "running modify")
-   
+
-   
+
    ;; getting existing file ports
    ;; ---------------------------
    ;; if any of these fail to match, exit modify
@@ -75,19 +75,19 @@
    ;; this throws an exception if the file does not exist, but it must be manually
    ;; truncated. using #:exists 'must-truncate guarantees file exists, but truncates
    ;; prior to data being read from file
-   
+
    ;; locate existing post in source
    ;; (. -> . input-port? output-port?)
    (define (get-source-ports)
-     (let ([file-handle  (path-add-extension
+     (let*
-       (if (equal? r-type "root")
+         ([file-id (last (string-split n-in "/"))]
-           (if x-test
+          [file-handle (if (equal? r-type "root")
-               (build-path "publish-test" "source" l-head)
+                           (if x-test
-               (build-path "source" l-head))
+                               (build-path "publish-test" "source" file-id)
-           (if x-test
+                               (build-path "source" file-id))
-               (build-path "publish-test" "source" r-type l-head)
+                           (if x-test
-               (build-path "source" r-type l-head)))
+                               (build-path "publish-test" "source" r-type file-id)
-       #".scm")])
+                               (build-path "source" r-type file-id)))])
        (values
         (open-input-file file-handle)
         (open-output-file file-handle #:exists 'update))))
@@ -137,8 +137,8 @@
                              (build-path "data" "make-atom"))
                          #".scm")])
        (open-input-file file-handle)))
-     
+
-   
+
    (define (handle-error-getting-file expn)
      (displayln "handle-error-getting-file")
      (displayln expn)
@@ -175,9 +175,9 @@
          (lambda (tag-row)
            (member match-id tag-row))
          tag-table))))
-        
+
    ;; ------------------------------
-   
+
    ;; rollback execution
    ;; ------------------
    ;; all handlers of any exception raised after writes start occurring must evaluate
@@ -243,7 +243,7 @@
                                    (write-to-file-with-retries out-port content is-print))])
        (write-to-file out-port content #:print-mode? is-print)))
    ;; ------------
-    
+
    ;; resource-replacement
    ;; --------------------
    ;; replace resource in source/<type>/id
@@ -265,7 +265,7 @@
                                      res-table)
                               3)])
            (append-post-footer new-content-sans-footer (source-url r-type id) tag-list history-list)))))
-   
+
 
    ;; replace-resource compose chain expression
    (define (replace-resource source-input-port source-output-port make-new-content id)
@@ -300,7 +300,7 @@
    (define (get-publish-time res-table id)
      (last (findf (lambda (row) (equal? (first row) id))
                     res-table)))
-   
+
    ;; update-res-table compose chain expression
    (define (update-res-table old-table rt-output-port id)
      (let* ([new-table (update-res-table-with-modification old-table id)]
@@ -321,7 +321,7 @@
    ;; atom-table update
    ;; -----------------
    (define (update-atom-table at-input-port at-output-port res-link)
-     (let ([old-table (csv->list at-input-port)])                                       
+     (let ([old-table (csv->list at-input-port)])
        (lambda (accumulator)
          (let* ([res-row (hash-ref accumulator 'resource)]
                 [desc (third res-row)]
@@ -355,7 +355,7 @@
    (define (compose-accumulator rb-thunks)
      (hash 'rb-thunks rb-thunks))
 
-     
+
 
    ;; run modify with exception handlers
    ;; ----------------------------------