Changeset 30081 in project


Ignore:
Timestamp:
11/23/13 03:07:55 (6 years ago)
Author:
Jim Ursetto
Message:

chicken-doc-admin 0.4.7: Warn on exception in parse-svnwiki, instead of crashing; report number of errors

Report number of errors for egg parsing; update man report to include add/modify markers.
Distinguish between parse errors and skipped files; ignore manpage symbolic links.

Location:
release/4/chicken-doc-admin/trunk
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • release/4/chicken-doc-admin/trunk/chicken-doc-admin.scm

    r28720 r30081  
    258258  (write-doc-node path doc 'unit name timestamp))
    259259
     260(define (warning/exception str e)
     261  (apply warning
     262         (string-append (if str (string-append str ": ") "")
     263                        (let ((loc ((condition-property-accessor 'exn 'location) e)))
     264                          (if loc (conc loc ": ") ""))
     265                        (or ((condition-property-accessor 'exn 'message) e) ""))
     266         ((condition-property-accessor 'exn 'arguments) e)))
     267(define (warn-on-exception str thunk)
     268  (handle-exceptions e
     269      (begin (warning/exception str e)
     270             #f)
     271    (thunk)))
     272
    260273;; FIXME: PATH is expected to be list of strings, due to requirement in write-eggshell
    261274(define (parse-egg/svnwiki fn-or-port path timestamp)
    262   (let ((sxml-doc (parse-svnwiki fn-or-port)))
    263     (write-eggshell path sxml-doc timestamp)
    264     #t))
     275  (let ((sxml-doc (warn-on-exception "Parse error" (lambda () (parse-svnwiki fn-or-port)))))
     276    (and sxml-doc
     277         (begin
     278           (write-eggshell path sxml-doc timestamp)
     279           #t))))
    265280
    266281(define (parse-man/svnwiki fn-or-port path name timestamp)
    267   (let ((sxml-doc (parse-svnwiki fn-or-port)))
    268     (write-manshell path name sxml-doc timestamp)
    269     #t))
     282  (let ((sxml-doc (warn-on-exception "Parse error" (lambda () (parse-svnwiki fn-or-port)))))
     283    (and sxml-doc
     284         (begin
     285           (write-manshell path name sxml-doc timestamp)
     286           #t))))
    270287
    271288(define eggdoc-svnwiki-available?
     
    366383                          'directory)
    367384                        )))
    368            (else #f)))
     385           (else 'skipped)))
    369386    ((eggdoc)
    370      (and (regular-file? pathname)
    371           (let ((fts (file-modification-time pathname)))
    372             ;; Force node to #f, leave code scaffolding in place for future timestamp handling
    373             (let* ((node #f    ;; (handle-exceptions e #f (lookup-node path))
    374                          )
    375                    (nts (if node (or (node-timestamp node) 0) 0))
    376                    (ntype (if node (node-type node) 'none)))
    377               (or (and (not force?)
    378                        (eq? ntype 'egg)
    379                        (<= fts nts)
    380                        'unchanged)
    381                   (and (parse-egg/eggdoc pathname root path fts)
    382                        (if node 'modified 'added)))))))
     387     (cond ((regular-file? pathname)
     388            (let ((fts (file-modification-time pathname)))
     389              ;; Force node to #f, leave code scaffolding in place for future timestamp handling
     390              (let* ((node #f ;; (handle-exceptions e #f (lookup-node path))
     391                           )
     392                     (nts (if node (or (node-timestamp node) 0) 0))
     393                     (ntype (if node (node-type node) 'none)))
     394                (or (and (not force?)
     395                         (eq? ntype 'egg)
     396                         (<= fts nts)
     397                         'unchanged)
     398                    (and (parse-egg/eggdoc pathname root path fts)
     399                         (if node 'modified 'added))))))
     400           (else 'skipped)))
    383401    (else
    384402     (error "Invalid egg document type" type))))
     
    413431;; Internal interface.
    414432(define (parse-eggdir dir type root #!optional force?)
    415   (let ((egg-count 0) (updated 0))
     433  (let ((egg-count 0) (updated 0) (errors 0))
    416434    (case type
    417435      ((svnwiki)
    418436       (for-each (lambda (name)
    419                    ;; Can't count errors yet as we don't distinguish between non-regular files and errors.
    420                    ;; Therefore, don't include error/non-regular files in processed report.
    421437                   (let* ((pathname (make-pathname dir name))
    422438                          ;; (We could move name portion from pathname to path arg.)
    423439                          (code (parse-one-egg pathname type root #f force?))
    424440                          (path (get-egg-path pathname root #f)))
    425                      (when code
     441                     (unless (or (eq? code 'skipped)
     442                                 (eq? code 'directory))
    426443                       (set! egg-count (+ egg-count 1)))
    427444                     ;; Must print ONLY after successful parse, otherwise
     
    437454                          (print "M " spath))
    438455                         ((unchanged))
    439                          ((directory)) ;; Since this can never be "updated", maybe it shouldn't +1 egg-count
    440                          ((#f)
    441                           (print "? " spath))))))
     456                         ((directory))
     457                         ((skipped))   ;; returned on non-regular file (including links)
     458                         ((unknown))   ;; not currently used for eggs
     459                         ((#f)         ;; returned on fatal parse error
     460                          (set! errors (+ errors 1))
     461                          (print "E " spath))
     462                         (else
     463                          (error "unknown parse return code" code))))))
    442464                 (remove ignore-filename? (directory dir))))
    443 
    444465      ((eggdoc)
    445466       (print "Gathering egg information...")
     
    450471                       (display pretty-path) (display " -> ") (flush-output)
    451472                       (let ((code (parse-one-egg pathname type root #f force?))) ; eggname printed in parse-egg/eggdoc
    452                          (when code
    453                            (set! egg-count (+ egg-count 1)))
     473                         (unless (eq? code 'skipped)
     474                          (set! egg-count (+ egg-count 1)))
    454475                         (case code
    455476                           ((added modified)
    456477                            (set! updated (+ updated 1)))
    457                            ((unchanged))))))
     478                           ((unchanged))
     479                           ((skipped))
     480                           ((#f)
     481                            (set! errors (+ errors 1)))
     482                           (else
     483                            (error "unknown parse return code" code))))))
    458484                   (gather-eggdoc-pathnames dir))))
    459485      (else
     
    466492    (when (pair? root)
    467493      (printf "~a :: " (string-intersperse root " ")))
    468     (printf "~a eggs processed, ~a updated\n"
    469             egg-count updated)))
     494    (printf "~a eggs processed, ~a updated~a\n" egg-count updated
     495            (if (> errors 0)
     496                (sprintf ", ~a errors" errors)
     497                ""))))
    470498
    471499;; Public (toplevel) command interface.
     
    497525     (let ((name (pathname-file pathname)))
    498526       (let ((path (or path (man-filename->path name))))
    499          (and (regular-file? pathname)
    500               path
    501               (let* ((fts (file-modification-time pathname))
    502                      (node (handle-exceptions e #f (lookup-node path)))
    503                      (nts (if node (or (node-timestamp node) 0) 0))
    504                      (ntype (if node (node-type node) 'none)))
    505                 (or (and (not force?)
    506                          (eq? ntype 'unit)   ;; FIXME unit?  what an odd design decision
    507                          (<= fts nts)
    508                          'unchanged)
    509                     (and (parse-man/svnwiki pathname path name fts)
    510                          (if node 'modified 'added))))))))
     527         (cond ((symbolic-link? pathname) 'skipped)
     528               ((and (regular-file? pathname)
     529                     path)
     530                (let* ((fts (file-modification-time pathname))
     531                       (node (handle-exceptions e #f (lookup-node path)))
     532                       (nts (if node (or (node-timestamp node) 0) 0))
     533                       (ntype (if node (node-type node) 'none)))
     534                  (or (and (not force?)
     535                           (eq? ntype 'unit) ;; FIXME unit?  what an odd design decision
     536                           (<= fts nts)
     537                           'unchanged)
     538                      (and (parse-man/svnwiki pathname path name fts)
     539                           (if node 'modified 'added)))))
     540               ((not path) 'unknown)
     541               (else 'skipped)))))
    511542    (else
    512543     (error "Invalid man document type" type))))
     
    612643
    613644(define (parse-man-directory dir type #!optional force?)
    614   (let ((egg-count 0) (updated 0))
     645  (let ((egg-count 0) (updated 0) (errors 0))
    615646    (with-global-write-lock
    616647     (lambda ()
     
    620651          (for-each (lambda (name)
    621652                      (let ((code (parse-one-man (make-pathname dir name) 'svnwiki #f force?)))
    622                         (when code
     653                        (unless (eq? code 'skipped)
    623654                          (set! egg-count (+ egg-count 1)))
    624655                        (case code
    625                           ((added modified)
     656                          ((added)
    626657                           (set! updated (+ updated 1))
    627                            (print name))
    628                           ((unchanged)))))
     658                           (print "A " name))
     659                          ((modified)
     660                           (set! updated (+ updated 1))
     661                           (print "M " name))
     662                          ((unchanged))
     663                          ((skipped))   ;; don't be verbose
     664                          ((#f)
     665                           (set! errors (+ errors 1))
     666                           (print "E " name))
     667                          ((unknown)
     668                           (print "? " name))       ;; not an error; just a man with no path
     669                          (else
     670                           (error "unknown parse return code" code)))))
    629671                    (remove ignore-filename? (directory dir))))
    630672         (else
    631673          (error "Invalid man directory type" type)))
    632674       (commit-working-id-cache!)
    633        (printf "~a man pages processed, ~a updated\n" egg-count updated)))))
     675       (printf "; ~a man pages processed, ~a updated~a\n" egg-count updated
     676               (if (> errors 0)
     677                   (sprintf ", ~a errors" errors)
     678                   ""))))))
    634679
    635680;; If names is null, look for all .wiki docs in the repository.  Otherwise,
     
    665710                      (let ((code (parse-one-egg fn type '() #f force?))
    666711                            (name (pathname-file fn)))
    667                         ;; If file is missing it is recorded as an error but
    668                         ;; its name is not printed.
    669                         (if code
    670                             (set! egg-count (+ egg-count 1))
    671                             ;; Safe to count errors here, as *.wiki should be regular files
    672                             (set! errors (+ errors 1)))
     712                        (set! egg-count (+ egg-count 1))
    673713                        (case code
    674714                          ((added)
     
    679719                           (print "M " name))
    680720                          ((unchanged))
     721                          ((skipped unknown)
     722                           (set! errors (+ errors 1))   ;; here, skipping is considered an error, as all *.wiki should be regular files
     723                           (print "? " name))
    681724                          ((#f)
    682                            (print "? " name)))))
     725                           (set! errors (+ errors 1))
     726                           (print "E " name)))))
    683727                    (if (pair? names)
    684728                        (wiki-doc-filenames names)
  • release/4/chicken-doc-admin/trunk/chicken-doc-admin.setup

    r28720 r30081  
    11;;; chicken-doc-admin
    2 (define version "0.4.6")
     2(define version "0.4.7")
    33
    44(compile -s -O2 -d1 -S chicken-doc-admin.scm -j chicken-doc-admin -j chicken-doc-parser)
Note: See TracChangeset for help on using the changeset viewer.