OpenACS

antoniop
committed
oacs-5-10:antoniop:20220420065149
on 20 Apr 22
Keep handling also the section option
/tcl/apm-callback-procs.tcl (+30 -7)
1 1 ad_library {
2 2
3 3     APM callbacks for the proctoring-support package.
4 4
5 5 }
6 6
7 7 namespace eval proctoring {}
8 8 namespace eval proctoring::apm {}
9 9
10 10 ad_proc -private ::proctoring::apm::after_upgrade {
11 11     {-from_version_name:required}
12 12     {-to_version_name:required}
13 13 } {
14 14     Upgrade logic
15 15 } {
16 16     apm_upgrade_logic \
17 17         -from_version_name $from_version_name \
18 18         -to_version_name $to_version_name \
19 19         -spec {
20 20             3.0.0 3.1.0 {
  21                 if {[namespace which ::xowf::atjob] ne ""} {
  22                     #
  23                     # We can use xowf atjobs: as this upgrade can
  24                     # potentially take a long time on busy systems, we
  25                     # schedule it to run at the next server restart by
  26                     # setting the atjob time in the past.
  27                     #
  28                     set cmd [list eval [list ::proctoring::apm::upgrade_to_3_1_0]]
  29                     set j [::xowf::atjob new \
  30                                -cmd $cmd \
  31                                -time [::xowf::atjob ansi_time 0]]
  32                     $j persist
  33                 } else {
  34                     #
  35                     # No atjobs, the upgrade will run during the
  36                     # upgrade process.
  37                     #
21 38                     ::proctoring::apm::upgrade_to_3_1_0 -apm
22 39                 }
23 40             }
24 41         }
  42 }
25 43
26 44 ad_proc -private ::proctoring::apm::upgrade_to_3_1_0 {
27 45     -apm:boolean
28 46 } {
29 47     Version 3.1.0 introduced an actual table in the datamodel to store
30 48     proctoring artifacts. Go into the proctoring folder and generate a
31 49     database entry for each picture that respects the format used so
32 50     far.
33 51 } {
34 52     # Go in the proctoring folder...
35 53     set object_folders [glob \
36 54                             -nocomplain \
37 55                             -directory [acs_root_dir]/proctoring/ \
38 56                             -type d *]
39 57
40 58     set msg "::proctoring::apm::upgrade_to_3_1_0 START\n"
41       append msg "Creating entries in the artifacts table. [llength $object_folders] to inspect..."
42 59     ns_log warning $msg
43 60     if {$apm_p} {
44           apm_ns_write_callback $msg
  61         apm_ns_write_callback $msg<br>
45 62     }
46 63
  64     set msg "Creating entries in the artifacts table. [llength $object_folders] to inspect..."
  65     ns_log warning $msg
  66     if {$apm_p} {
  67         apm_ns_write_callback $msg<br>
  68     }
  69
47 70     # ...for each object folder...
48 71     foreach object_folder $object_folders {
49 72         set object_id [file tail $object_folder]
50 73         if {![string is integer -strict $object_id]} {
51 74             continue
52 75         }
53 76
54 77         set user_folders [glob \
55 78                               -nocomplain \
56 79                               -directory $object_folder \
57 80                               -type d *]
58 81
59 82         set msg "...object '$object_id' has [llength $user_folders] user folders..."
60 83         ns_log warning $msg
61 84         if {$apm_p} {
62               apm_ns_write_callback $msg
  85             apm_ns_write_callback $msg<br>
63 86         }
64 87
65 88         # ...foreach user folder...
66 89         foreach user_folder $user_folders {
67 90             set user_id [file tail $user_folder]
68 91             if {![string is integer -strict $user_id]} {
69 92                 continue
70 93             }
71 94
72 95             set files [glob \
73 96                            -nocomplain \
74 97                            -directory $user_folder \
75 98                            -type f *]
76 99             set msg "......for object '$object_id', user '$user_id' has [llength $files] files..."
77 100             ns_log warning $msg
78 101             if {$apm_p} {
79                   apm_ns_write_callback $msg
  102                 apm_ns_write_callback $msg<br>
80 103             }
81 104
82 105             # ...foreach file...
83 106             foreach f $files {
84 107                 if {[regexp {^(\w+)-(\w+)-(\d+)\.\w+$} [file tail $f] m name type timestamp]} {
85 108                     set msg ".........object '$object_id', user '$user_id' storing file '$f' in the artifacts table..."
86 109                     # If the file respects the naming convention
87 110                     # upheld so far, store the information in the
88 111                     # database.
89 112                     ::xo::dc dml -prepare integer,integer,integer,text,text,text,integer,integer init_artifact {
90 113                         insert into proctoring_object_artifacts
91 114                         (object_id, user_id, timestamp, name, type, file)
92 115                         select :object_id, :user_id, to_timestamp(:timestamp), :name, :type, :f
93 116                         from dual
94 117                         where exists (select 1 from acs_objects where object_id = :object_id)
95 118                           and exists (select 1 from users where user_id = :user_id)
96 119                     }
97 120                 } else {
98 121                     set msg ".........object '$object_id', user '$user_id' file '$f' does not respect the naming convention."
99 122                 }
100 123                 ns_log warning $msg
101 124                 if {$apm_p} {
102                       apm_ns_write_callback $msg
  125                     apm_ns_write_callback $msg<br>
103 126                 }
104 127             }
105 128         }
106 129     }
107 130
108 131     set msg "::proctoring::apm::upgrade_to_3_1_0 FINISH\n"
109 132     ns_log warning $msg
110 133     if {$apm_p} {
111           apm_ns_write_callback $msg
  134         apm_ns_write_callback $msg<br>
112 135     }
113 136 }