/ftp/pub/users/ronald/proyectos/rcs-gopher/RCS/rcs-gopher_gophernicus.scm,v  -->  standard output
revision 1.14
;;; PENDIENTE
;; - Funci??n para generar diffs a partir del nombre de un proyecto, de un archivo y dos revisiones.  YA
;; Para hacer esto, modificar o utilizar de base la funci??n rcs-revisiones y obtener-selector-de-revisi??n.  YA
;;    - Funci??n para generar el men?? de revisiones para elegir la primera revisi??n.  YA
;;    - Funci??n para generar el men?? de revisiones para elegir la segunda revisi??n y mostrar el diff.  YA
;; - Funci??n para consultar el mensaje de Log de una revisi??n de un archivo perteneciente a un proyecto. YA
;; - Funci??n para generar la p??gina principal de un proyecto de rcs-gopher. YA
;; - Funci??n para generar la p??gina principal de una colecci??n de proyectos de rcs-gopher. YA

(use-modules (ice-9 rdelim)
             (ice-9 ftw)
             (ice-9 popen))

(define *host* "sdf.org")
(define *puerto* "70")
(define *proyectos* '("rcs-gopher" "pxle"))
;(define *directorio-base-de-proyectos* "/ftp/pub/users/ronald/proyectos-rcs/")
(define *directorio-base-de-proyectos* "proyectos/")
(define *ruta-base-cgi-bin* "/users/ronald/cgi-bin/")
(define *nombre-del-script-de-rcs-gopher* "rcs-gopher.sh")

(define (error-en-men??-gopher mensaje)
  (simple-format #t "3~A\tERROR\tERROR\t70\n" mensaje))

(define (error-en-archivo mensaje)
  (simple-format #t "ERROR\n=====\n\n- ~A\n" mensaje))

(define (destabulizar cadena)
  (string-join
    (string-split cadena #\Tab)
    "    "))

(define (host-y-puerto)
  (simple-format #f "~A\t~A" *host*
                             *puerto*))

(define (obtener-ruta-de-archivo nombre-de-proyecto archivo)
  (if archivo
    (simple-format #f "~A~A/RCS/~A,v"
                      *directorio-base-de-proyectos*
                      nombre-de-proyecto
                      archivo)
    (simple-format #f "~A~A/RCS/"
                      *directorio-base-de-proyectos*
                      nombre-de-proyecto)))

(define (obtener-selector-de-revisi??n secci??n nombre-de-proyecto archivo revisi??n-a revisi??n-b)
  (if (null? revisi??n-b)
    (simple-format #f "~A~A?~A/~A/~A/~A"
                      *ruta-base-cgi-bin*
                      *nombre-del-script-de-rcs-gopher*
                      secci??n
                      nombre-de-proyecto
                      revisi??n-a
                      archivo)
    (simple-format #f "~A~A?~A/~A/~A/~A/~A"
                      *ruta-base-cgi-bin*
                      *nombre-del-script-de-rcs-gopher*
                      secci??n
                      nombre-de-proyecto
                      revisi??n-a
                      revisi??n-b
                      archivo)))

(define (enlace-a-secci??n tipo secci??n nombre-de-proyecto archivo)
  (simple-format #t "~A~A\t~A~A?~A/~A/~A\t~A\n"
                    tipo
                    archivo
                    *ruta-base-cgi-bin*
                    *nombre-del-script-de-rcs-gopher*
                    secci??n
                    nombre-de-proyecto
                    archivo
                    (host-y-puerto)))

(define (rcs-??ltima-revisi??n nombre-de-proyecto archivo)
  (simple-format #t "0~A\t~A\t~A\n"
    archivo
    (obtener-selector-de-revisi??n "revs"
                                  nombre-de-proyecto
                                  archivo
                                  "ULT"   #nil)
    (host-y-puerto)))

(define (obtener-selector-men??-secci??n secci??n nombre-de-proyecto)
  (simple-format #f "~A~A?~A/~A"
                    *ruta-base-cgi-bin*
                    *nombre-del-script-de-rcs-gopher*
                    secci??n
                    nombre-de-proyecto))

(define (obtener-n??mero-de-revisi??n texto)
;(list-ref (string-split (list-ref (string-split l??nea #\Tab) 0) #\Space) 1)))))
  (list-ref
    (string-split
      (list-ref
        (string-split texto #\Tab)
        0)
      #\Space)
    1))

(define (rcs-revisiones nombre archivo secci??n tipo-de-??tem revisi??n-base)
  (if (and (member nombre *proyectos*)
           (access? (obtener-ruta-de-archivo
                      nombre
                      archivo)
                    R_OK))
    (let ((puerto (open-pipe* OPEN_READ "rlog" (obtener-ruta-de-archivo nombre archivo)))
          (l??nea ""))
      (while ((lambda ()
                (set! l??nea (read-line puerto))
                (not (eof-object? l??nea))))
        (if (string-prefix? "revision" l??nea)
          (simple-format #t "~A~A\t~A\t~A\t~A\n"
                         tipo-de-??tem (string-titlecase (destabulizar l??nea))
                         (if (null? revisi??n-base)
                           (obtener-selector-de-revisi??n secci??n
                                                         nombre
                                                         archivo
                                                         (obtener-n??mero-de-revisi??n l??nea)
                                                         #nil)
                           (obtener-selector-de-revisi??n secci??n
                                                         nombre
                                                         archivo
                                                         revisi??n-base
                                                         (obtener-n??mero-de-revisi??n l??nea)))
                         *host*
                         *puerto*))))
    (error-en-men??-gopher "No existe este proyecto o archivo.")))

(define (rcs-ver-revisi??n nombre archivo revisi??n)
  (if (and (member nombre *proyectos*)
           (access? (obtener-ruta-de-archivo
                      nombre
                      archivo)
                    R_OK))
    (let ((puerto (open-pipe* OPEN_READ "co" (simple-format #f "-p~A" (if (string= revisi??n "ULT")
                                                                        ""
                                                                        revisi??n))
                                             (obtener-ruta-de-archivo nombre archivo)))
          (l??nea ""))
      (while ((lambda ()
                (set! l??nea (read-line puerto))
                (not (eof-object? l??nea))))
        (simple-format #t "~A\n" l??nea)))
    (error-en-archivo "No existe este proyecto o archivo.")))

(define (rcs-ver-diff nombre archivo revisi??n-a revisi??n-b)
  (if (and (member nombre *proyectos*)
           (access? (obtener-ruta-de-archivo
                      nombre
                      archivo)
                    R_OK))
    (let ((puerto (open-pipe* OPEN_READ "rcsdiff" (simple-format #f "-r~A" (if (string= revisi??n-a "ULT")
                                                                             ""
                                                                             revisi??n-a))
                                                  (simple-format #f "-r~A" (if (string= revisi??n-b "ULT")
                                                                             ""
                                                                             revisi??n-b))
                                                  (obtener-ruta-de-archivo nombre archivo)))
          (l??nea ""))
      (while ((lambda ()
                (set! l??nea (read-line puerto))
                (not (eof-object? l??nea))))
        (simple-format #t "~A\n" l??nea)))
    (error-en-archivo "No existe este proyecto o archivo.")))

(define (rcs-ver-log nombre archivo revisi??n)
  (if (and (member nombre *proyectos*)
           (access? (obtener-ruta-de-archivo
                      nombre
                      archivo)
                    R_OK))
    (let ((puerto (open-pipe* OPEN_READ "rlog" (simple-format #f "-r~A" (if (string= revisi??n "ULT")
                                                                          ""
                                                                          revisi??n))
                                               (obtener-ruta-de-archivo nombre archivo)))
          (l??nea ""))
      (while ((lambda ()
                (set! l??nea (read-line puerto))
                (not (eof-object? l??nea))))
        (simple-format #t "~A\n" l??nea)))
    (error-en-archivo "No existe este proyecto o archivo.")))

(define (generar-entradas-comunes nombre)
  (for-each (lambda (nombre selector)
              (simple-format #t "1~A\t~A\t~A\n"
                                nombre
                                selector
                                (host-y-puerto)))
            (list nombre "Revisiones"
                  "Diffs" "Logs")
            (list (obtener-selector-men??-secci??n "inicio" nombre)
                  (obtener-selector-men??-secci??n "revs" nombre)
                  (obtener-selector-men??-secci??n "diffs" nombre)
                  (obtener-selector-men??-secci??n "logs" nombre))))

(define (generar-entradas-por-archivo nombre)
  (let ((directorio-proyecto (simple-format #f "~A~A/RCS"
                               *directorio-base-de-proyectos*
                               nombre)))
    (for-each (lambda (archivo)
                (if (string-suffix? ",v" archivo)
                  (rcs-??ltima-revisi??n
                    nombre
                    (string-trim-right
                      archivo
                      (char-set #\, #\v)))))
              (scandir directorio-proyecto))))

(define (generar-entradas-por-archivo nombre funci??n)
  (let ((directorio-proyecto (simple-format #f "~A~A/RCS"
                               *directorio-base-de-proyectos*
                               nombre)))
    (for-each funci??n
              (scandir directorio-proyecto))))

(define (rcs-men??-principal-proyecto nombre)
  (if (and (member nombre *proyectos*)
           (access? (obtener-ruta-de-archivo
                      nombre #f)
                    R_OK))
    (begin
      (generar-entradas-comunes nombre)
      (generar-entradas-por-archivo nombre
                                    (lambda (archivo)
                                      (if (string-suffix? ",v" archivo)
                                        (rcs-??ltima-revisi??n
                                          nombre
                                          (string-trim-right
                                            archivo
                                            (char-set #\, #\v)))))))
    (error-en-men??-gopher "No existe este proyecto o archivo.")))

(define (rcs-men??-de-secci??n-por-archivo tipo secci??n nombre)
  (generar-entradas-por-archivo nombre
                                (lambda (archivo)
                                  (if (string-suffix? ",v" archivo)
                                    (enlace-a-secci??n tipo
                                                      secci??n
                                                      nombre
                                                      (string-trim-right
                                                           archivo
                                                           (char-set #\, #\v)))))))

(define (rcs-men??-principal)
  (for-each (lambda (proyecto)
              (simple-format #t "1~A\t~A\t~A\t~A\n"
                                proyecto
                                (obtener-selector-men??-secci??n "inicio" proyecto)
                                *host*
                                *puerto*))
            *proyectos*))

(define (parsear-selector texto)
  (apply values (string-split texto #\/)))

(define (rcs-principal)
  (let ((selector (getenv "SEARCHREQUEST")))
    (define-values (secci??n . par??metros)
                   (parsear-selector selector))
    (let ((tama??o (length par??metros)))
      (cond
        ((and (string= secci??n "inicio")
              (= tama??o 0))
          (rcs-men??-principal))
        ((and (string= secci??n "inicio")
              (= tama??o 1))
          (rcs-men??-principal-proyecto (list-ref par??metros 0)))
        ((and (string= secci??n "revs")
              (= tama??o 1))
          (rcs-men??-de-secci??n-por-archivo "1" "revs" (list-ref par??metros 0)))
        ((and (string= secci??n "revs")
              (= tama??o 2))
          (rcs-revisiones (list-ref par??metros 0) (list-ref par??metros 1) "revs" "0" #nil))
        ((and (string= secci??n "revs")
              (= tama??o 3))
          (rcs-ver-revisi??n (list-ref par??metros 0) (list-ref par??metros 2) (list-ref par??metros 1)))
        ((and (string= secci??n "diffs")
              (= tama??o 1))
          (rcs-men??-de-secci??n-por-archivo "1" "diffs" (list-ref par??metros 0)))
        ((and (string= secci??n "diffs")
              (= tama??o 2))
          (rcs-revisiones (list-ref par??metros 0) (list-ref par??metros 1) "diffs" "1" #nil))
        ((and (string= secci??n "diffs")
              (= tama??o 3))
          (rcs-revisiones (list-ref par??metros 0) (list-ref par??metros 2) "diffs" "0" (list-ref par??metros 1)))
        ((and (string= secci??n "diffs")
              (= tama??o 4))
          (rcs-ver-diff (list-ref par??metros 0) (list-ref par??metros 3) (list-ref par??metros 1) (list-ref par??metros 2)))
        ((and (string= secci??n "logs")
              (= tama??o 1))
          (rcs-men??-de-secci??n-por-archivo "1" "logs" (list-ref par??metros 0)))
        ((and (string= secci??n "logs")
              (= tama??o 2))
          (rcs-revisiones (list-ref par??metros 0) (list-ref par??metros 1) "logs" "0" #nil))
        ((and (string= secci??n "logs")
              (= tama??o 3))
          (rcs-ver-log (list-ref par??metros 0) (list-ref par??metros 2) (list-ref par??metros 1)))
        (#t (error-en-men??-gopher "Entrada inv??lida."))
))))

(rcs-principal)