Pagini

2013-09-25

Site in Common Lisp, partea 6

Aveam de gand sa fac o pagina meseriasa de administrare, dar m-am razgandit. Mai
bine mai simpla si mai repede, decat mai complicata si sa o termin cine stie
cand.
Ca sa atasez atribute unor vehicule voi pune mai intai link-uri pe vehicule,
care sa deschida pagina de administrare avand vehiculul selectat undeva
in dreapta. Pentru asta voi defini o noua comanda, EDIT-VEHICLE. Fiind vorba de
link-uri obisnuite, voi folosi parametri GET, spre deosebire de comenzile
ADD-VEHICLE si ADD-ATTRIBUTE, despre care am zis ca la un moment dat le voi
schimba pe POST. Asa ca voi incerca sa preiau CMD atat din parametrii GET cat si
din cei POST.

Am modificat atat template-ul, cat si codul din pagina de administrare.



In template am adaugat link-uri de modificare pentru fiecare vehicul, plus un
formular nou, care este vizibil numai atunci cand pagina de administrare
primeste comenzile de editare sau de salvare.
Formularul are doua campuri ascunse - numele comenzii si id-ul vehiculului.
In rest, el contine toate atributele disponibile, si valorile lor pentru
vehiculul selectat - deci este posibil sa existe atribute care sa nu aiba
valoare completata.

Template:
<html>
<head>
<style type='text/css'>
  .admin-container { overflow: auto; padding: 5px; width: 400px; height: 200px; background: #eee }
</style>
</head>
<body>
<!-- autovehicule -->
Autovehicule:<br>
<form action='/admin' method='GET'>
<input type='text' id='vehicle' name='vehicle'>
<input type='hidden' name='cmd' value='add-vehicle'>
<input type='submit' value='Adauga vehicul'>
</form>
<div class='admin-container'>
  <table>
  <!-- TMPL_LOOP vehicles -->
  <tr><td id='<!-- TMPL_VAR id -->'><a href="/admin?cmd=edit-vehicle&id=<!-- TMPL_VAR id -->"><!-- TMPL_VAR name --></a></td></tr>
  <!-- /TMPL_LOOP -->
  </table>
</div>
<br><br>
<!-- atribute -->
Atribute:<br>
<form action='/admin' method='GET'>
<input type='text' id='attribute' name='attribute'>
<input type='hidden' name='cmd' value='add-attribute'>
<input type='submit' value='Adauga atribut'>
</form>
<div class='admin-container'>
  <table>
  <!-- TMPL_LOOP attributes -->
  <tr><td id='<!-- TMPL_VAR id -->'><!-- TMPL_VAR name -->: <!--TMPL_VAR att-type --></td></tr>
  <!-- /TMPL_LOOP -->
  </table>
</div>
<!-- atribute la vehicule -->
<!-- TMPL_IF edit-vehicle -->
<div class='admin-container' style='left: 450px; top: 50px; height: 600px; position: absolute; '>
  <form action='admin' method=GET'>
    <!-- TMPL_VAR edit-vehicle --><br>
    <input type='hidden' name='cmd' value='set-attributes'>
    <input type='hidden' name='id' value='<!--TMPL_VAR edit-vehicle-id -->'>
    <br>
    <table border=1>
    <!-- TMPL_LOOP edit-vehicle-attrs -->
    <tr>
      <td><!-- TMPL_VAR att-name --></td>
      <td><input type='text' name='<!--TMPL_VAR att-name -->' value='<!-- TMPL_VAR att-value -->'></td>
    </tr>
    <!-- /TMPL_LOOP -->
    </table>
    <br>
    <input type='submit' value='Seteaza atribute'>
  </form>
</div>
<!-- /TMPL_IF -->
</body>
</html>

Modificari in cod:
; variabile speciale; restul au ramas nemodificate
(defparameter *SITE-ROOT* 
  (if (equalp "Linux" (software-type))
      "~/cars-site/"
      "~/Documents/GitHub/cars-site/"))
(defparameter *db* "cars-site-db")

(defun get-site-file (name)
  (merge-pathnames name *SITE-ROOT*))

; salvarea si incarcarea bazei de date
(defun serialize ()
  "versiune penibila, dar functionala"
  (with-output-to-string (s)
    (format s "; atribute")
    (loop for a in (get-all-attributes)
  do (format s "~%(add-attribute (make-instance 'attribute :name \"~a\" :id ~a :att-type '~a))"
      (name a)
      (id a)
      (att-type a)))
    (format s "~%~%; vehicule")
    (loop for v in (get-all-vehicles)
  do (format s "~%(add-vehicle (make-instance 'vehicle :name \"~a\" :id ~a))"
      (name v)
      (id v)))
    (format s "~%~%; atributele vehiculelor")
    (loop for v in (get-all-vehicles)
  do (loop for a in (get-all-attributes)
        do (let* ((id (id v))
    (name (name a))
    (val (get-attribute-on-vehicle id name)))
      (when (and val (not (equal "NIL" val)))
        (format s "~%(set-attribute-on-vehicle ~a \"~a\" \"~a\")" id name val)))))
    s))

(defun persist-to-disk ()
  (with-open-file (g (get-site-file *db*) :direction :output 
       :if-exists :supersede :if-does-not-exist :create)
    (format g "~a" (serialize))))

(defun load-from-disk ()
  (load (get-site-file *db*)))


Am adaugat apoi o functie noua, GET-VEHICLE-BY-ID, care returneaza un vehicul
atunci cand primeste id-ul lui. Am setat CATCH-ERRORS-P din pachetul HUNCHENTOOT
ca fiind T, astfel incat toate exceptiile pe care le primesc (in Common Lisp se
spune "toate conditiile semnalate") sa apara in debugger. Am adaugat o variabila
speciala noua, *LAST-REQUEST*, in care sa se salveze ultima cerere - in timpul
executiei metodelor din ACCEPTOR am acces la o variabila dinamica (e acelasi
lucru cu "variabila speciala") care se numeste *REQUEST* si in care se gaseste
obiectul cerere curent. Acum ma voi putea uita la cerere post-factum, si voi
putea folosi in REPL (linia de comanda, gen) metodele din ACCEPTOR.

Am modificat destul de mult functia WEB-ADMIN. Am "dresat"-o sa se uite atat in
parametrii GET cat si in POST dupa CMD.
Se poate vedea acum ca este impartita in doua bucati: una in care proceseaza
comenzile primite, si una in care face randarea - in cazul de fata grosul muncii
este pregatirea listei de parametri. Ce facem cu informatia asta? momentan o
pastram in minte, poate mai tarziu iese ceva util de aici.
Am adaugat comenzile SET-ATTRIBUTES, EDIT-VEHICLE SI SAVE-DATA. Prima seteaza
atributele pentru un vehicul, a doua il face editabil - adica trece prin toate
atributele disponibile si le pune intr-un formular, completand valorile acolo
unde vehiculul respectiv le are.

(defun web-admin ()
  (setf *LAST-REQUEST* *REQUEST*)
  (when (not (is-logged-in))
      (redirect "/login"))
  (let ((cmd (or (get-parameter "cmd")
    (post-parameter "cmd")))
 (edit-vehicle))
    (cond
      ((equal cmd "add-vehicle")
       (let ((name (get-parameter "vehicle")))
  (add-vehicle (make-instance 'vehicle :name name))))
      ((equal cmd "add-attribute")
       (let ((name (get-parameter "attribute")))
  (add-attribute (make-instance 'attribute :name name))))
      ((equal cmd "edit-vehicle")
       (setf edit-vehicle (get-vehicle-by-id (parse-integer (get-parameter "id")))))
      ((equal cmd "set-attributes")
       (setf edit-vehicle (get-vehicle-by-id (parse-integer (get-parameter "id"))))       
       (loop for att in (get-all-attributes)
   do (set-attribute-on-vehicle 
       (parse-integer (get-parameter "id")) 
       (name att) 
       (get-parameter (name att)))))
      ((equal cmd "save-data")
       (persist-to-disk))
      (t nil))
    (with-output-to-string (s)
      (html-template:fill-and-print-template
       (get-site-file "admin.tmpl")
       `(:vehicles 
  ,(mapcar #'(lambda (x) 
        `(:id ,(id x) :name ,(name x))) 
    (get-all-vehicles))
  :attributes 
  ,(mapcar #'(lambda (x) 
        `(:id ,(id x) :name ,(name x) :att-type ,(att-type x))) 
    (get-all-attributes))
  ,@(when edit-vehicle   
   `(:edit-vehicle ,(name edit-vehicle)
     :edit-vehicle-id ,(id edit-vehicle)
     :edit-vehicle-attrs
     ,(mapcar #'(lambda (x)
          `(:att-name ,(name x)
        :att-value ,(get-attribute-on-vehicle (id edit-vehicle) (name x))))
      (get-all-attributes))))
  )
       :stream s)
       s)))

SAVE-DATA salveaza "baza de date" pe disc. Pentru chestia asta am adaugat un
mecanism din trei functii: SERIALIZE, PERSIST-TO-DISK si LOAD-FROM-DISK. Modul
de serializare este simplist - sunt generate apeluri catre functiile care adauga
datele.

La partea de serializare m-am lovit de alta problema: nimeni nu actualiza variabila
care da id-ul atunci cand incarcam baza de date cu LOAD-FROM-DISK, asa ca am
actualizat functiile ADD-ATTRIBUTE si ADD-VEHICLE sa se ocupe de asta - daca
id-ul obiectului adaugat este mai mare decat secventa, o face pe aceasta din urma
sa fie mai mare cu 1 decat id-ul.

  (defun add-vehicle (vehicle)
    (if (find-vehicle-by-name (name vehicle))
 (error "Vehiculul cu acest nume este deja introdus!")
 (push vehicle all-vehicles))
    (when (<= vehicle-id-seq (id vehicle))
      (setf vehicle-id-seq (1+ (id vehicle))))
    vehicle)

O chestie interesanta: in loc sa mai creez lista de variabile pe care o transmit
lui FILL-AND-PRINT-TEMPLATE folosind functia LIST, acum folosesc BACKQUOTE (`),
al carui rol este sa returneze parametrii trimisi ne-evaluati, cu exceptia
cazurilor cand acestia sunt precedati de virgula (,). Combinatiile dintre ` si ,
pot fi si imbricate, pentru distractie sporita!

Deja am inceput sa vad niste limitari la modelul de date ales, si la modul in
care am aranjat sursele - faptul ca tin tot codul intr-un singur fisier incepe
sa faca mai dificila navigarea intre functii.

Acum ar fi dragut sa facem in sfarsit pagina de interogare a bazei de date. Alte
fineturi mai pot astepta.


P.S. codul este pe GitHub: https://github.com/termita81/cars-site

Niciun comentariu:

Trimiteți un comentariu

S-ar putea sa nu vedeti comentariul aparand imediat, asta inseamna ca el asteapta aprobarea mea. Aceasta e o masura anti-SPAM.