OpenACS

gustafn
committed
MAIN:gustafn:20150623162604
on 23 Jun 15
- quote HTML attributes
openacs-4/.../tcl/download-procs.tcl (+13 -13)
1 1 # /packages/download/tcl/download-procs.tcl
2 2 ad_library {
3 3      Procs used by the download module.
4 4      @author jbank@arsdigita.com [jbank@arsdigita.com]
5 5      @creation-date Tue Dec 12 15:13:52 2000
6 6      @cvs-id $Id$
7 7 }
8 8
9 9 # @author jbank@arsdigita.com [jbank@arsdigita.com]
10 10 # @creation-date Tue Dec 12 15:14:13 2000
11 11 ad_proc download_repository_info { {package_id ""} {do_redirect 1}} {
12 12     Get information about the repository mounted for package_id.
13 13 } {
14       if [empty_string_p $package_id] {
  14     if {$package_id eq ""} {
15 15         set package_id [ad_conn package_id]
16 16     }
17 17     if { ![db_0or1row repository_info {
18 18         select repository_id, title, description, help_text from download_repository_obj where parent_id = :package_id
19 19     } -column_array repository ] } {
20 20         #Package not setup
21 21         if { $do_redirect } {
22 22             set admin_p [permission::permission_p -object_id $package_id -privilege "admin"]
23 23             if { $admin_p } {
24 24                 set repository_id [db_nextval acs_object_id_seq]
25 25                 set return_url "[ad_conn package_url]admin/repository-types"
26 26                 ad_return_exception_page 200 "Not setup" "Please <a href=\"[ad_conn package_url]admin/repository-ae?[export_vars -url {repository_id return_url}]\">configure this instance of the download module</a>."
27 27             } else {
28 28                 ad_return_exception_page 200 "Not setup" "Please have an admin configure this instance of the download module."
29 29             }
30 30             ad_script_abort
31 31         }
32 32     } else {
33 33         if { $do_redirect } {
34 34             set repository_id $repository(repository_id)
 
118 118     } {
119 119         { revision_id:naturalnum,notnull "" }
120 120         { download_id:naturalnum,notnull "" }
121 121         { reason_id "" }
122 122         { reason_other ""}
123 123     }
124 124    
125 125     ns_log Debug "download_file_downloader: downloading $revision_id"
126 126
127 127     set user_id [ad_conn user_id]
128 128     set download_ip [ad_conn peeraddr]
129 129     if [catch {
130 130         set download_hostname [ns_hostbyaddr $download_ip]
131 131     }] {
132 132         set download_hostname [db_null]
133 133     }
134 134     set user_agent  [ns_set iget [ad_conn headers] user-agent]
135 135
136 136     regexp "[ad_conn package_url]download/(.*)" [ad_conn url] match path
137 137
138       if [empty_string_p $revision_id] {
  138     if {$revision_id eq ""} {
139 139         ad_script_abort
140 140     }
141 141
142 142     permission::require_permission -object_id $revision_id -privilege "read"
143 143
144 144     ##Record the download for all time!!
145 145     set double_click_p [db_string download_count "select count(*) from download_downloads where download_id = :download_id"]
146 146     if { $double_click_p == 0 } {
147           if [catch {
  147         if {[catch {
148 148             db_dml download_insert {
149 149                 insert into download_downloads (
150 150                 download_id,
151 151                 user_id,
152 152                 revision_id,
153 153                 download_date,
154 154                 download_ip,
155 155                 download_hostname,
156 156                 user_agent,
157 157                 reason_id,
158 158                 reason)
159 159                 values
160 160                 (:download_id,
161 161                 :user_id,
162 162                 :revision_id,
163 163                 sysdate,
164 164                 :download_ip,
165 165                 :download_hostname,
166 166                 :user_agent,
167 167                 :reason_id,
168 168                 :reason_other)
169 169             }
170           } errmsg] {
  170         } errmsg]} {
171 171             ns_log Error "Download: Unable to log download due to an error: $errmsg"
172 172         }
173 173     }
174 174
175 175     cr_write_content -revision_id $revision_id
176 176
177 177     return filter_return
178 178 }
179 179
180 180 # @author jbank@arsdigita.com [jbank@arsdigita.com]
181 181 # @creation-date Fri Dec 15 14:07:02 2000
182 182 ad_proc download_metadata_column { data_type } { Dummy comment.} {
183 183     switch -- $data_type {
184 184         date { set answer_column "date_answer" }
185 185         boolean { set answer_column "boolean_answer" }
186 186         number { set answer_column "number_answer" }
187 187         integer { set answer_column "number_answer" }
188 188         choice { set answer_column "choice_answer" }
189 189         text { set answer_column "clob_answer" }
190 190         default {
 
200 200 ad_proc download_validate_metadata { repository_id metadata_info archive_type_id } {
201 201     Validate metadata arguments for a given archive_type
202 202 } {
203 203     array set metadata $metadata_info
204 204     set metadata_with_missing_responses [list]
205 205     ##Iterate over the metadata information
206 206     db_foreach metadata {
207 207         select
208 208         dam.metadata_id,
209 209         dam.pretty_name,
210 210         dam.data_type,
211 211         dam.required_p
212 212         from download_archive_metadata dam
213 213         where dam.repository_id = :repository_id and
214 214         dam.computed_p = 'f' and
215 215         (dam.archive_type_id = :archive_type_id or
216 216          dam.archive_type_id is null)
217 217         order by sort_key
218 218     } {
219 219                 # date's are complex. convert them first
220                   if { $data_type == "date" } {
  220                 if { $data_type eq "date" } {
221 221                         if [catch  { set metadata($metadata_id) [validate_ad_dateentrywidget "" metadata.$metadata_id [ns_getform]]} errmsg] {
222                                   if {$required_p == "t"} {
  222                                 if {$required_p eq "t"} {
223 223                                         ad_complain "$errmsg: Please make sure your dates are valid."
224 224                                 } else {
225 225                                         set metadata($metadata_id) ""
226 226                                 }
227 227                         }
228 228                 }
229           if { [exists_and_not_null metadata($metadata_id)] } {
  229         if { ([info exists metadata($metadata_id)] && $metadata($metadata_id) ne "") } {
230 230             set response_value [string trim $metadata($metadata_id)]
231           } elseif {$required_p == "t"} {
  231         } elseif {$required_p eq "t"} {
232 232             lappend metadata_with_missing_responses $pretty_name
233 233             continue
234 234         } else {
235 235             set response_to_question($metadata_id) ""
236 236             set response_value ""
237 237         }
238           if {![empty_string_p $response_value]} {
239               if { $data_type == "number" } {
  238         if {$response_value ne ""} {
  239             if { $data_type eq "number" } {
240 240                 if { ![regexp {^(-?[0-9]+\.)?[0-9]+$} $response_value] } {
241 241
242 242                     ad_complain "The value for \"$metadata\" must be a number. Your value was \"$response_value\"."
243 243                     continue
244 244                 }
245               } elseif { $data_type == "integer" } {
  245             } elseif { $data_type eq "integer" } {
246 246                 if { ![regexp {^[0-9]+$} $response_value] } {
247 247                     ad_complain "The value for \"$metadata\" must be an integer. Your value was \"$response_value\"."
248 248                     continue
249 249                 }
250 250             }
251 251         }
252 252        
253 253
254 254         ns_log Debug "LOGGING: Metadata $pretty_name: $metadata($metadata_id)"
255 255     }
256 256     if { [llength $metadata_with_missing_responses] > 0 } {
257 257         ad_complain "You didn't respond to all required sections. You skipped:"
258 258         ad_complain [join $metadata_with_missing_responses "\n"]
259 259     }
260 260     return [array get metadata]
261 261 }
262 262
263 263 # @author jbank@arsdigita.com [jbank@arsdigita.com]
264 264 # @creation-date Fri Dec 15 16:16:41 2000
265 265 ad_proc download_insert_metadata { repository_id archive_type_id revision_id metadata_array} {
 
279 279     }]
280 280
281 281     foreach metadata_info $metadata_list {
282 282         set metadata_id [lindex $metadata_info 0]
283 283         set data_type [lindex $metadata_info 1]
284 284         set response $metadata($metadata_id)
285 285         set answer_column [download_metadata_column $data_type]
286 286         db_dml metadata_inserts "
287 287          insert into download_revision_data(revision_id, metadata_id, $answer_column)
288 288          values ( :revision_id, :metadata_id, :response )
289 289         "
290 290     }
291 291 }
292 292
293 293 # @author jbank@arsdigita.com [jbank@arsdigita.com]
294 294 # @creation-date Fri Dec 15 16:20:38 2000
295 295 ad_proc download_insert_revision { upload_file tmpfile repository_id archive_type_id archive_id version_name revision_id user_id creation_ip approved_p metadata_array } {
296 296     Dummy comment.
297 297 } {
298 298     # get the filename part of the upload file
299       if ![regexp {[^//\\]+$} $upload_file filename] {
  299     if {![regexp {[^//\\]+$} $upload_file filename]} {
300 300         # no match
301 301         set filename $upload_file
302 302     }
303 303
304 304         # get the file_size for the postgres version
305 305         set file_size [file size $tmpfile]
306 306
307 307     set mime_type [cr_filename_to_mime_type -create $upload_file]
308 308
309 309     db_exec_plsql revision_new {
310 310         declare
311 311           v_revision_id integer;
312 312         begin
313 313           v_revision_id := content_revision.new(
314 314            item_id => :archive_id,
315 315            title => :filename,
316 316            description => :version_name,
317 317            revision_id => :revision_id,
318 318            mime_type => :mime_type,
319 319            creation_user => :user_id,