Coverage report: /home/samppa/personal/opiskelu/ohtuprojekti/pulsu/trunk/document-view3.lisp

KindCoveredAll%
expression389 3.4
branch028 0.0
Key
Not instrumented
Conditionalized out
Executed
Not executed
 
Both branches taken
One branch taken
Neither branch taken
1
 (in-package :puls.ui)
2
 
3
                                         ; group is non-nil if we are viewing a unified group
4
                                         ; nil if we are viewing document cases
5
 (defhtml render-case-attributes (row group page back)
6
 
7
   (htm    
8
    (:div :id "right_container"    
9
          (:form
10
           :name "attributes" :action "/updatedb"
11
           (:input :type "button" :id "newcase" :value "New Case" :onclick "toNew();")
12
           (:table
13
            :id "attributes"
14
            (render-attrs row))
15
           
16
           (:em (:span :id "wrong_values"))
17
           (:em (:span :id "modified_text"))
18
           (:input :type "hidden" :value "" :name "doc_selected_cases")
19
           (:input :type "hidden" :value "" :name "submitter")
20
           (:input :type "hidden" :value (getf row :docno) :name "docno")
21
           (:input :type "hidden" :value page :name "page")
22
           (:input :type "hidden" :value back :name "back")
23
           (when group
24
             (htm
25
              (:input :type "hidden" :value (getf row :group_number) :name "group_number")))
26
           (:input :type "hidden" :value (getf row :doc_date) :name "published")
27
           (:input :type "hidden"
28
                   :value (getf row :event_id) :name "event_id"))
29
          
30
          (:div :id "buttons"
31
                (:input :type "button" :id "accept" :value "Accept case" :onclick "submit('accept');")
32
                (:input :type "button" :id "reject" :value "Reject case" :onclick "submit('reject');")))))
33
 
34
 (defpage (updatedb :uri "/updatedb")
35
     (docno event_id doc_selected_cases
36
            submitter group_number page back search)
37
   (puls.controller::authenticate-user)
38
   (let* ((params (format nil "&search=~A&back=~A" search back))
39
                                         ; selected becomes ((docno0 event_id0) (docno1 event_id1) ...)
40
          (selected
41
           (loop :for i :in (cl-ppcre:split ";" doc_selected_cases)
42
                 :collect (cl-ppcre:split ":" i)))
43
          (attributes
44
           (append (list :docno docno :event_id event_id)
45
                   (loop :for a :in (puls.controller:get-attrs)
46
                         :for value = (get-parameter (attr-id a))
47
                         :when (> (length value) 0)
48
                         :nconcing (list (attr-field a) value)))))
49
 
50
     (cond ((string= "reject" submitter)
51
            (puls.controller:reject-event docno event_id)
52
            (if (null group_number)
53
                (hunchentoot:redirect
54
                 (format nil "/dv?n=~A~A" docno params))
55
                (hunchentoot:redirect
56
                 (format nil "/dv?group_number=~A~A" group_number params))))
57
                   
58
           ((string= "reject_all" submitter)
59
            (loop :for (docno c) :in selected
60
                  :do (puls.controller:reject-event docno c))
61
            (if (null group_number)
62
                (hunchentoot:redirect
63
                 (format nil "/dv?n=~A~A" docno params))
64
                (hunchentoot:redirect
65
                 (format nil "/dv?group_number=~A~A" group_number params))))
66
 
67
           ((string= "remove_selected" submitter)
68
            (loop :for (docno c) :in selected
69
                  :do (puls.controller:reject-event docno c)))
70
 
71
           ((string= "verify" submitter)
72
            (puls.controller:verify-unified-case group_number "Web"))
73
 
74
                                         ; this probably doesn't work....
75
           ((string= "verify_all" submitter)
76
            (loop :for (group_number) :in selected
77
                  :do (puls.controller:verify-unified-case group_number "Web")))
78
           
79
           (t ;ugh, nested conds
80
 
81
            (setf
82
             attributes
83
             (handler-case (puls.controller:clean-row
84
                            attributes
85
                            (puls.controller:get-document-text docno))
86
               (invalid-attr-value (y)
87
                 (hunchentoot:redirect
88
                  (concatenate
89
                   'string
90
                   "/error?message="
91
                   (hunchentoot:url-encode
92
                    (format nil
93
                            "Invalid value '~A' for attribute '~A'"
94
                            (invalid-attr-value-value y)
95
                            (attr-desc (invalid-attr-value-attr y)))))))))
96
           
97
            (cond ((string= "acceptnew" submitter)
98
                   (puls.controller:add-event docno attributes)
99
                   (hunchentoot:redirect
100
                    (format nil "/dv?n=~A~A" docno params)))
101
                 
102
                  ((string= "accept" submitter)
103
                   (puls.controller:set-event
104
                    docno event_id
105
                    (append '(:verify "Web") attributes))
106
                   (puls.controller:reunify-event docno event_id))
107
                 
108
                  ((string= "accept_all" submitter)
109
                   (loop :for (docno c) :in selected
110
                         :do (puls.controller:set-event docno c attributes)
111
                         :do (puls.controller:reunify-event docno c))
112
                   (puls.controller:set-event docno event_id attributes)
113
                   (puls.controller:reunify-event docno event_id)))))
114
     
115
     ; finally: redirect
116
     (hunchentoot:redirect
117
      (format nil "/dv?n=~A&c=~A&group_number=~A&page=~A~A"
118
              docno event_id group_number page params))))
119
 
120
 (defhtml render-main-content (string row rows)
121
   (let* ((string (highlight-document string row rows))
122
          (split (cl-ppcre:split "\\n" string :limit 4)))
123
     (htm
124
      (:div :id "main_content"
125
            (:h2 (str (nth 2 split)))
126
            (:p (str (nth 3 split)))))))
127
 
128
 
129
 (defpage (setselected :uri "/setselected") (selected_cases docno event_id group_number back page)
130
 
131
   (hunchentoot:redirect (format nil "/dv?n=~A&c=~A&selected_cases=~A&group_number=~A&back=~A&page=~A"
132
                                 docno event_id selected_cases group_number back page)))
133
 
134
  
135
 
136
 (defpage (document-view :uri "/dv")
137
     ((n :parameter-type 'STRING)
138
      (c :parameter-type 'INTEGER)
139
      (group_number :parameter-type 'INTEGER)
140
      (selected_cases :parameter-type 'STRING :init-form "")
141
      (msg :parameter-type 'STRING))
142
   (puls.controller::authenticate-user)
143
 
144
   (let* ((row (cond
145
                 ((not (or (null n) (null c)))
146
                  (puls.controller:get-event n c))
147
                 ((not (null n))
148
                  (first (get-document-events n)))
149
                 ((not (null group_number))
150
                  (first (puls.controller:get-unified-case group_number)))
151
                 (t
152
                  (puls.controller:get-event
153
                   "20051227_reliefWeb_622c2b995e5cc2fa20fd343a3fd4a149"
154
                   1))))
155
          (docevents (puls.controller:get-document-events n)))
156
 
157
     (htm
158
      "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Transitional//EN\" \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd\">"
159
      (:html
160
       :xmlns "http://www.w3.org/1999/xhtml"
161
       :xml\:lang "fi"
162
       :lang "fi"
163
       (:head
164
        (:meta :http-equiv "Content-Type"
165
               :content    "text/html;charset=iso-8859-1")
166
        (:title "Document view")
167
        (:link :href "static/docustyle.css" :rel "stylesheet" :type "text/css")
168
        (:link :href "static/headerstyle.css" :rel "stylesheet" :type "text/css")
169
        (:script :language "javascript"
170
                 :type "text/javascript"
171
                 :src "static/docuscript.js")
172
        (:script :language "javascript"
173
                 :type "text/javascript"
174
                 :src "static/switch_input.js")
175
        (:script :language "javascript"
176
                 :type "text/javascript"
177
                 :src "static/prototype-1.6.0.3.js")
178
        (:script :language "javascript"
179
                 :type "text/javascript"
180
                 :src "static/tests.js")
181
        (:script :language "javascript"
182
                 :type "text/javascript"
183
                 :src "static/jsunit/app/jsUnitCore.js"))
184
      
185
       (:body
186
        :onload "markChecked()"
187
        :class "layout"
188
        (:div
189
         :id "container"
190
         (header)         
191
         (:div
192
          :id "left_container"
193
          (link* "Back to list" (if (get-parameter "back") (get-parameter "back") "newest") 
194
                 :page (get-parameter "page")
195
                 :search (get-parameter "search")
196
                 :snippet (get-parameter "snippet"))
197
          (:br)
198
          (:div :class
199
                (if (null group_number)
200
                    "doc_view"
201
                    "group_view")
202
          (if (null group_number)
203
              
204
              (htm (:div :class "group_view_tab"
205
               (link-here* "Unified"
206
                           :group_number (getf row :group_number)))
207
               (:div :class "doc_view_tab"
208
                     (htm "Document"))
209
               (:h3 "Document cases"))
210
              
211
              (htm (:div :class "doc_view_tab"
212
               (link-here* "Document"
213
                           :group_number nil))
214
               (:div :class "group_view_tab"
215
                     (htm "Unified"))
216
               (:h3 "Unified cases")))
217
 
218
          (link "All" "javascript:selectAll()") ","
219
          (link "None" "javascript:selectNone()") ","
220
          (link "Invert" "javascript:selectInvert()")
221
          (:form
222
           :name "cases"
223
           :action "setselected"
224
           (:input :type "hidden" :name "selected_cases" :value selected_cases)
225
           (:input :type "hidden" :name "docno"
226
                   :value (getf row :docno))
227
           (:input :type "hidden" :name "event_id"
228
                   :value (getf row :event_id))
229
           (:input :type "hidden" :name "group_number"
230
                   :value group_number)
231
           (:input  :type "hidden" :name "back"
232
                    :value (get-parameter "back"))
233
           (:input  :type "hidden" :name "page"
234
                    :value (get-parameter "page"))
235
 
236
           (if (null group_number)
237
               (mapcar (lambda (x)
238
                         (render-left-container
239
                          (getf row :docno)
240
                          (getf row :event_id)
241
                          x))
242
                       docevents)
243
               (mapcar (lambda (x)
244
                         (render-left-container
245
                          (getf row :docno)
246
                          (getf row :event_id)
247
                          x))
248
                       (puls.controller:get-unified-case group_number))))))
249
 
250
         (render-case-attributes row group_number (get-parameter "page") (get-parameter "back"))
251
         (render-main-content (puls.controller:get-document-text
252
                               (getf row :docno)) row docevents))
253
        (footer))))))
254
 
255
 
256
 (defhtml render-left-container (current-n current-c row)
257
   (let ((id (unique-id "case")))
258
     (htm 
259
      (:ul
260
       (:li
261
        (:input :type "checkbox" 
262
                :id id
263
                :value (format nil "~A:~A" (getf row :docno) (getf row :event_id))
264
                :onclick "checkChecked(id)")
265
 
266
        (if (and (string= current-n (getf row :docno))
267
                 (= current-c (getf row :event_id)))
268
            (htm
269
             (:strong :id (format nil "~A~A" "link" id) :class "current"
270
                      (str (first (puls.controller:get-trigger-spans row)))))
271
            (htm (:span :id (format nil "~A~A" "link" id) :class "uncheckd"
272
                        (link-here* (first (puls.controller:get-trigger-spans row))
273
                                    :n (getf row :docno)
274
                                    :c (getf row :event_id)
275
                                    :upage nil
276
                                    :dpage nil)))))))))
277
 
278
                                       
279
 (deftest test-document-view ()
280
   (combine-results
281
     (test-switch-input)
282
     (test-attribute-plain)
283
     (test-attribute-select)
284
     (test-attribute-status_select)
285
     (test-attribute-text)
286
     (test-render-case-attributes)
287
     (test-render-main-content)))
288
 
289
 (deftest test-switch-input ()
290
   (check (equal (with-output-to-string (*http-stream*)
291
                   (switch-input "test"))
292
                 "
293
 <td>
294
   <a onclick=\"switch_input('test');\">
295
     <img class=\"switch_image\" src=\"static/switch_button.jpg\" alt=\"switch input\" />
296
   </a>
297
 </td>")))
298
 
299
 (deftest test-attribute-plain()
300
   (check (equal (with-output-to-string (*http-stream*)
301
                   (render-attr (first (get-attrs)) '(:doc_date "abc")))
302
                 "
303
 <tr id=\"doc_date_tr\">
304
   <td id=\"doc_date_text\">Published
305
   </td>
306
   <td></td>
307
   <td>abc
308
   </td>
309
 </tr>"
310
                 )))
311
 
312
 (deftest test-attribute-select()
313
   (check
314
     (equal
315
      (with-output-to-string (*http-stream*)
316
        (puls.ui::render-attr (second (puls.controller::get-attrs))
317
                              '(:docno "20051106_IHT_6d2d65033534bfb3bd242fd8847ff941" :event_id 1)))
318
      "
319
 <tr id=\"disease_name_tr\">
320
   <td id=\"disease_name_text\">Disease
321
   </td>
322
 <td>
323
   <a onclick=\"switch_input('disease_name');\">
324
     <img class=\"switch_image\" src=\"static/switch_button.jpg\" alt=\"switch input\" />
325
   </a>
326
 </td>
327
   <td>
328
     <select name=\"disease_name\" id=\"disease_name_id\" onchange=\"checkAttributes()\">
329
       <option value=\"China's fourth reported outbreak\">China's fourth reported outbreak
330
       </option>
331
       <option value=\"The outbreak\">The outbreak
332
       </option>
333
       <option value=\"a virus\">a virus
334
       </option>
335
       <option value=\"SARS\">SARS
336
       </option>
337
       <option value=\"a public health threat bird flu\">a public health threat bird flu
338
       </option>
339
       <option value=\"the disease\">the disease
340
       </option>
341
       <option value=\"the virus\">the virus
342
       </option>
343
       <option value=\"H5N1\">H5N1
344
       </option>
345
       <option value=\"an outbreak\">an outbreak
346
       </option>
347
       <option value=\"pneumonia\">pneumonia
348
       </option>
349
       <option value=\"the H5N1 bird flu virus\">the H5N1 bird flu virus
350
       </option>
351
       <option value=\"bird flu\">bird flu
352
       </option>
353
     </select>
354
   </td>
355
 </tr>")))
356
 
357
 (deftest test-attribute-status_select ()
358
   (check (equal (with-output-to-string (*http-stream*)
359
                   (render-attr (nth 7 (get-attrs)) '(:case_status "dead")))
360
                 "
361
 <tr id=\"case_status_tr\">
362
   <td id=\"case_status_text\">Status
363
   </td>
364
 <td>
365
   <a onclick=\"switch_input('case_status');\">
366
     <img class=\"switch_image\" src=\"static/switch_button.jpg\" alt=\"switch input\" />
367
   </a>
368
 </td>
369
   <td>
370
     <select name=\"case_status\" id=\"case_status_id\" onchange=\"checkAttributes()\">
371
       <option value=\"sick\">sick
372
       </option>
373
       <option value=\"dead\" selected=\"selected\">dead
374
       </option>
375
     </select>
376
   </td>
377
 </tr>")))
378
 
379
 (deftest test-attribute-text ()
380
   (check (equal (with-output-to-string (*http-stream*)
381
                   (render-attr (nth 8 (get-attrs)) '(:descriptor "abc")))
382
                 "
383
 <tr id=\"case_descriptor_tr\">
384
   <td id=\"case_descriptor_text\">Descriptor
385
   </td>
386
 <td>
387
   <a onclick=\"switch_input('case_descriptor');\">
388
     <img class=\"switch_image\" src=\"static/switch_button.jpg\" alt=\"switch input\" />
389
   </a>
390
 </td>
391
   <td>
392
     <input type=\"text\" name=\"case_descriptor\" id=\"case_descriptor_id\" size=\"20\" />
393
   </td>
394
 </tr>")))
395
 
396
 (deftest test-render-case-attributes ()
397
   (let* ((docno "20050101_bbc_b118e8867977ba4feae312bb5ea17ef4")
398
          (row (puls.controller:get-event docno 1)))
399
 
400
     (check (equal (with-output-to-string (*http-stream*)
401
                     (render-attrs row))
402
                   "
403
 <tr id=\"doc_date_tr\">
404
   <td id=\"doc_date_text\">Published
405
   </td>
406
   <td></td>
407
   <td>2005.01.01
408
   </td>
409
 </tr>
410
 <tr id=\"disease_name_tr\">
411
   <td id=\"disease_name_text\">Disease
412
   </td>
413
 <td>
414
   <a onclick=\"switch_input('disease_name');\">
415
     <img class=\"switch_image\" src=\"static/switch_button.jpg\" alt=\"switch input\" />
416
   </a>
417
 </td>
418
   <td>
419
     <select name=\"disease_name\" id=\"disease_name_id\" onchange=\"checkAttributes()\">
420
       <option value=\"weapons-grade anthrax\">weapons-grade anthrax
421
       </option>
422
     </select>
423
   </td>
424
 </tr>
425
 <tr id=\"country_tr\">
426
   <td id=\"country_text\">Country
427
   </td>
428
 <td>
429
   <a onclick=\"switch_input('country');\">
430
     <img class=\"switch_image\" src=\"static/switch_button.jpg\" alt=\"switch input\" />
431
   </a>
432
 </td>
433
   <td>
434
     <select name=\"country\" id=\"country_id\" onchange=\"checkAttributes()\">
435
       <option value=\"the US\">the US
436
       </option>
437
       <option value=\"Iraq\">Iraq
438
       </option>
439
       <option value=\"Washington\">Washington
440
       </option>
441
       <option value=\"US\">US
442
       </option>
443
     </select>
444
   </td>
445
 </tr>
446
 <tr id=\"location_tr\">
447
   <td id=\"location_text\">Location
448
   </td>
449
 <td>
450
   <a onclick=\"switch_input('location');\">
451
     <img class=\"switch_image\" src=\"static/switch_button.jpg\" alt=\"switch input\" />
452
   </a>
453
 </td>
454
   <td>
455
     <select name=\"location\" id=\"location_id\" onchange=\"checkAttributes()\">
456
     </select>
457
   </td>
458
 </tr>
459
 <tr id=\"time_tr\">
460
   <td id=\"time_text\">Time
461
   </td>
462
 <td>
463
   <a onclick=\"switch_input('time');\">
464
     <img class=\"switch_image\" src=\"static/switch_button.jpg\" alt=\"switch input\" />
465
   </a>
466
 </td>
467
   <td>
468
     <select name=\"time\" id=\"time_id\" onchange=\"checkAttributes()\">
469
       <option value=\"after the 1991\">after the 1991
470
       </option>
471
       <option value=\"May 2003\" selected=\"selected\">May 2003
472
       </option>
473
     </select>
474
   </td>
475
 </tr>
476
 <tr id=\"norm_stime_tr\">
477
   <td id=\"norm_stime_text\">Begin
478
   </td>
479
 <td>
480
   <a onclick=\"switch_input('norm_stime');\">
481
     <img class=\"switch_image\" src=\"static/switch_button.jpg\" alt=\"switch input\" />
482
   </a>
483
 </td>
484
   <td>
485
     <select name=\"norm_stime\" id=\"norm_stime_id\" onchange=\"checkAttributes()\">
486
       <option value=\"1991\">1991
487
       </option>
488
       <option value=\"2003.05\" selected=\"selected\">2003.05
489
       </option>
490
     </select>
491
   </td>
492
 </tr>
493
 <tr id=\"norm_etime_tr\">
494
   <td id=\"norm_etime_text\">End
495
   </td>
496
 <td>
497
   <a onclick=\"switch_input('norm_etime');\">
498
     <img class=\"switch_image\" src=\"static/switch_button.jpg\" alt=\"switch input\" />
499
   </a>
500
 </td>
501
   <td>
502
     <select name=\"norm_etime\" id=\"norm_etime_id\" onchange=\"checkAttributes()\">
503
       <option value=\"2005\">2005
504
       </option>
505
       <option value=\"2003.05\" selected=\"selected\">2003.05
506
       </option>
507
     </select>
508
   </td>
509
 </tr>
510
 <tr id=\"case_status_tr\">
511
   <td id=\"case_status_text\">Status
512
   </td>
513
 <td>
514
   <a onclick=\"switch_input('case_status');\">
515
     <img class=\"switch_image\" src=\"static/switch_button.jpg\" alt=\"switch input\" />
516
   </a>
517
 </td>
518
   <td>
519
     <select name=\"case_status\" id=\"case_status_id\" onchange=\"checkAttributes()\">
520
       <option value=\"sick\">sick
521
       </option>
522
       <option value=\"dead\" selected=\"selected\">dead
523
       </option>
524
     </select>
525
   </td>
526
 </tr>
527
 <tr id=\"case_descriptor_tr\">
528
   <td id=\"case_descriptor_text\">Descriptor
529
   </td>
530
 <td>
531
   <a onclick=\"switch_input('case_descriptor');\">
532
     <img class=\"switch_image\" src=\"static/switch_button.jpg\" alt=\"switch input\" />
533
   </a>
534
 </td>
535
   <td>
536
     <input type=\"text\" name=\"case_descriptor\" id=\"case_descriptor_id\" size=\"20\" value=\"any detainee\" />
537
   </td>
538
 </tr>
539
 <tr id=\"confidence_tr\">
540
   <td id=\"confidence_text\">Confidence
541
   </td>
542
   <td></td>
543
   <td>0.0d0
544
   </td>
545
 </tr>
546
 <tr id=\"source_tr\">
547
   <td id=\"source_text\">Source
548
   </td>
549
   <td></td>
550
   <td>
551
   </td>
552
 </tr>
553
 <tr id=\"verify_tr\">
554
   <td id=\"verify_text\">Verify
555
   </td>
556
   <td></td>
557
   <td>
558
   </td>
559
 </tr>")))) 
560
 
561
 (deftest test-render-main-content ()
562
   (let* ((docno "20050101_bbc_b118e8867977ba4feae312bb5ea17ef4")
563
          (row (puls.controller:get-event docno 1)))
564
 
565
     (check (equal (with-output-to-string (*http-stream*)
566
                     (render-main-content (puls.controller:get-document-text docno)
567
                                          row (puls.controller:get-document-events docno))) 
568
                   "
569
 <div id=\"main_content\">
570
   <h2>Iraq's jailed Mrs Anthrax 'dying'
571
   </h2>
572
   <p>The jailed Iraqi microbiologist dubbed Mrs Anthrax is seriously ill and should be freed, an Iraqi lawyer has said. Dr Huda Salih Mahdi Ammash is dying from cancer, according to Badih Aref - who represents imprisoned former Iraqi deputy Prime Minister Tariq Aziz. The lawyer said his client had asked him to help Dr Ammash, who was in \"terrible pain\". Dr Ammash is one of two high profile Iraqi women arrested by US troops in <span class='time'>May 2003</span> and held at a secret location. The US military refused to comment on Dr Ammash's health. \"Certainly, we have medical care available to take care of <span class='case_descriptor'>any detainee</span>,\" a US military spokesman told AP news agency. 'Relapse' Mr Aref said Tariq Aziz passed on the information about Dr Ammash during a meeting. \"When I met Mr Aziz, he told me 'her case is more than important than mine,' Mr Aref said. \"She is always in terrible pain because of cancer, her medical condition is worsening quickly and is she remains like that <strong>she will undoubtedly die</strong>,\" the lawyer said. Mr Aref said Dr Ammash had been treated for <span class='disease_name'>breast cancer</span> before her arrest and had now suffered a relapse. The scientist was one of the few women in Saddam Hussein's inner circle and the only one on the US list of 55 most wanted Iraqis. She was the only female member of the Iraq Command, the 18-member council that ran the Baath Party, as well as a party regional commander. However the US-educated microbiologist is best known for her alleged involvement with the weapons of mass destruction programme. Dubbed \"Mrs Anthrax\" by Washington, US intelligence services say she masterminded the reconstruction of Iraq's biological weapons facilities after the 1991 Gulf War. The other high profile Iraqi woman imprisoned by <span class='location'>the US</span> is microbiologist Dr Rihab Rashid Taha, who became known as Dr Germ for helping Iraq develop weapons-grade anthrax.  
573
 
574
   </p>
575
 </div>"))))
576
 
577
 
578
 
579
 
580
 
581