Index: openacs-4/packages/xowiki/tcl/import-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xowiki/tcl/import-procs.tcl,v diff -u -N -r1.27.2.3 -r1.27.2.4 --- openacs-4/packages/xowiki/tcl/import-procs.tcl 11 Feb 2014 11:58:18 -0000 1.27.2.3 +++ openacs-4/packages/xowiki/tcl/import-procs.tcl 13 Mar 2014 13:00:01 -0000 1.27.2.4 @@ -1,9 +1,9 @@ ::xo::library doc { - XoWiki - importer + XoWiki - importer - @creation-date 2008-04-25 - @author Gustaf Neumann - @cvs-id $Id$ + @creation-date 2008-04-25 + @author Gustaf Neumann + @cvs-id $Id$ } @@ -28,8 +28,8 @@ Importer instproc report {} { my instvar added updated replaced inherited return "$added objects newly inserted,\ - $updated objects updated, $replaced objects replaced, $inherited inherited (update ignored)

\ - [my report_lines]" + $updated objects updated, $replaced objects replaced, $inherited inherited (update ignored)

\ + [my report_lines]" } Importer instproc import {-object:required -replace -create_user_ids} { @@ -41,31 +41,31 @@ my instvar package_id user_id $object demarshall -parent_id [$object parent_id] -package_id $package_id \ - -creation_user $user_id -create_user_ids $create_user_ids + -creation_user $user_id -create_user_ids $create_user_ids set item_id [::xo::db::CrClass lookup -name [$object name] -parent_id [$object parent_id]] #my msg "lookup of [$object name] parent [$object parent_id] => $item_id" if {$item_id != 0} { if {$replace} { ;# we delete the original - ::xo::db::CrClass delete -item_id $item_id - set item_id 0 + ::xo::db::CrClass delete -item_id $item_id + set item_id 0 my report_line $object replaced - my incr replaced + my incr replaced } else { - #my msg "$item_id update: [$object name]" - ::xo::db::CrClass get_instance_from_db -item_id $item_id - $item_id copy_content_vars -from_object $object - $item_id save -use_given_publish_date [$item_id exists publish_date] \ + #my msg "$item_id update: [$object name]" + ::xo::db::CrClass get_instance_from_db -item_id $item_id + $item_id copy_content_vars -from_object $object + $item_id save -use_given_publish_date [$item_id exists publish_date] \ -modifying_user [$object set modifying_user] - #my log "$item_id saved" + #my log "$item_id saved" $object set item_id [$item_id item_id] - #my msg "$item_id updated: [$object name]" + #my msg "$item_id updated: [$object name]" my report_line $item_id updated - my incr updated + my incr updated } } if {$item_id == 0} { set n [$object save_new -use_given_publish_date [$object exists publish_date] \ - -creation_user [$object set modifying_user] ] + -creation_user [$object set modifying_user] ] $object set item_id $n set item_id $object #my msg "$object added: [$object name]" @@ -167,76 +167,76 @@ } } - set need_to_import 1 - # - # If the page was implicitly added (due to being a - # page_template of an exported page), and a page (e.g. a form - # or a workflow) with the same name can be found in the - # target, don't materialize the inherited page. - # - if {$keep_inherited - && [$o exists __export_reason] - && [$o set __export_reason] eq "implicit_page_template"} { - $o unset __export_reason - set page [[my package_id] get_page_from_item_ref \ - -allow_cross_package_item_refs false \ - -use_package_path true \ - -use_site_wide_pages true \ - -use_prototype_pages false \ - [$o name] \ - ] + set need_to_import 1 + # + # If the page was implicitly added (due to being a + # page_template of an exported page), and a page (e.g. a form + # or a workflow) with the same name can be found in the + # target, don't materialize the inherited page. + # + if {$keep_inherited + && [$o exists __export_reason] + && [$o set __export_reason] eq "implicit_page_template"} { + $o unset __export_reason + set page [[my package_id] get_page_from_item_ref \ + -allow_cross_package_item_refs false \ + -use_package_path true \ + -use_site_wide_pages true \ + -use_prototype_pages false \ + [$o name] \ + ] - # If we would like to restrict to just inherited pages in - # the target, we could extend the test below with a test like - # the following: - # set inherited [expr {[$page physical_parent_id] ne [$page parent_id]}] + # If we would like to restrict to just inherited pages in + # the target, we could extend the test below with a test like + # the following: + # set inherited [expr {[$page physical_parent_id] ne [$page parent_id]}] - if {$page ne ""} { - #my msg "page [$o name] can ne found in folder [my parent_id]" - my incr inherited - unset todo($o) - set o $page - set need_to_import 0 - } - } + if {$page ne ""} { + #my msg "page [$o name] can ne found in folder [my parent_id]" + my incr inherited + unset todo($o) + set o $page + set need_to_import 0 + } + } - if {$need_to_import} { - # Now, all requirements are met, parent-object and - # child-object conditions are fulfilled. We have to map - # page_template for PageInstances and parent_ids for child - # objects to new IDs. - # - if {[$o istype ::xowiki::PageInstance]} { - #my msg "importing [$o name] page_instance, map $template_name_key to $name_map($template_name_key)" - $o page_template $name_map($template_name_key) - #my msg "exists template? [my isobject [$o page_template]]" - if {![my isobject [$o page_template]]} { - ::xo::db::CrClass get_instance_from_db -item_id [$o page_template] - #my msg "[my isobject [$o page_template]] loaded" - } - } - - if {[info exists item_ids($old_parent_id)]} { - $o set parent_id $id_map($old_parent_id) - } else { - $o set parent_id [my parent_id] - } - - # Everything is mapped, we can now do the import. - - #my msg "start import for $o, name=[$o name]" - my import \ - -object $o \ - -replace $replace \ - -create_user_ids $create_user_ids - #my msg "import for $o done, name=[$o name]" + if {$need_to_import} { + # Now, all requirements are met, parent-object and + # child-object conditions are fulfilled. We have to map + # page_template for PageInstances and parent_ids for child + # objects to new IDs. + # + if {[$o istype ::xowiki::PageInstance]} { + #my msg "importing [$o name] page_instance, map $template_name_key to $name_map($template_name_key)" + $o page_template $name_map($template_name_key) + #my msg "exists template? [my isobject [$o page_template]]" + if {![my isobject [$o page_template]]} { + ::xo::db::CrClass get_instance_from_db -item_id [$o page_template] + #my msg "[my isobject [$o page_template]] loaded" + } + } + + if {[info exists item_ids($old_parent_id)]} { + $o set parent_id $id_map($old_parent_id) + } else { + $o set parent_id [my parent_id] + } + + # Everything is mapped, we can now do the import. + + #my msg "start import for $o, name=[$o name]" + my import \ + -object $o \ + -replace $replace \ + -create_user_ids $create_user_ids + #my msg "import for $o done, name=[$o name]" - unset todo($o) - } + unset todo($o) + } - # + # # Maintain the maps and iterate - # + # if {$old_item_id ne ""} { set id_map($old_item_id) [$o item_id] } @@ -271,9 +271,9 @@ # foreach item_id $item_ids { if {[::xo::db::CrClass get_instance_from_db -item_id $item_id] eq ""} { - my log "Warning: cannot fetch item $item_id for exporting" + my log "Warning: cannot fetch item $item_id for exporting" } else { - set items($item_id) 1 + set items($item_id) 1 } } @@ -284,37 +284,37 @@ set new 0 ns_log notice "--export works on [array names items]" foreach item_id [array names items] { - # - # We flag the reason, why the implicitely included elements were - # included. If the target can resolve already such items - # (e.g. forms), we might not have to materialize these finally. - # - # For PageInstances (or its subtypes), include the parent-objects as well - # - if {[$item_id istype ::xowiki::PageInstance]} { - set template_id [$item_id page_template] - if {![info exists items($template_id)]} { - ns_log notice "--export including template-object $template_id [$template_id name]" - set items($template_id) 1 - ::xo::db::CrClass get_instance_from_db -item_id $template_id - set new 1 - $template_id set __export_reason implicit_page_template - continue - } - } - # - # check for child objects of the item - # - set sql [::xowiki::Page instance_select_query -folder_id $item_id -with_subtypes true] - ::xo::dc foreach export_child_obj $sql { - if {![info exists items($item_id)]} { - ::xo::db::CrClass get_instance_from_db -item_id $item_id - ns_log notice "--export including child $item_id [$item_id name]" - set items($item_id) 1 - set new 1 - $item_id set __export_reason implicit_child_page - } - } + # + # We flag the reason, why the implicitely included elements were + # included. If the target can resolve already such items + # (e.g. forms), we might not have to materialize these finally. + # + # For PageInstances (or its subtypes), include the parent-objects as well + # + if {[$item_id istype ::xowiki::PageInstance]} { + set template_id [$item_id page_template] + if {![info exists items($template_id)]} { + ns_log notice "--export including template-object $template_id [$template_id name]" + set items($template_id) 1 + ::xo::db::CrClass get_instance_from_db -item_id $template_id + set new 1 + $template_id set __export_reason implicit_page_template + continue + } + } + # + # check for child objects of the item + # + set sql [::xowiki::Page instance_select_query -folder_id $item_id -with_subtypes true] + ::xo::dc foreach export_child_obj $sql { + if {![info exists items($item_id)]} { + ::xo::db::CrClass get_instance_from_db -item_id $item_id + ns_log notice "--export including child $item_id [$item_id name]" + set items($item_id) 1 + set new 1 + $item_id set __export_reason implicit_child_page + } + } } if {!$new} break } @@ -325,10 +325,10 @@ set content "" foreach item_id $item_ids { if {[catch {set obj [$item_id marshall]} errorMsg]} { - ns_log error "Error while exporting $item_id [$item_id name]\n$errorMsg\n$::errorInfo" - error $errorMsg + ns_log error "Error while exporting $item_id [$item_id name]\n$errorMsg\n$::errorInfo" + error $errorMsg } else { - append content $obj\n + append content $obj\n } } return $content @@ -350,9 +350,9 @@ ns_log notice "--exporting $item_id [$item_id name]" ns_write "# exporting $item_id [$item_id name] [$item_id pretty_link]\n" if {[catch {set obj [$item_id marshall]} errorMsg]} { - ns_log error "Error while exporting $item_id [$item_id name]\n$errorMsg\n$::errorInfo" + ns_log error "Error while exporting $item_id [$item_id name]\n$errorMsg\n$::errorInfo" } else { - ns_write "$obj\n" + ns_write "$obj\n" } } } @@ -388,21 +388,21 @@ application/zip - application/x-zip - application/x-zip-compressed { - set zipcmd [::util::which unzip] - #my msg "zip = $zipcmd, tempdir = [my set tmpdir]" - exec $zipcmd $file -d [my set tmpdir] - my import -dir [my set tmpdir] -parent_id [my parent_id] - set success 1 + set zipcmd [::util::which unzip] + #my msg "zip = $zipcmd, tempdir = [my set tmpdir]" + exec $zipcmd $file -d [my set tmpdir] + my import -dir [my set tmpdir] -parent_id [my parent_id] + set success 1 } application/x-compressed { - if {[string match "*tar.gz" $name]} { - set cmd [::util::which tar] - exec $cmd -xzf $file -C [my set tmpdir] - my import -dir [my set tmpdir] -parent_id [my parent_id] - set success 1 - } else { - my msg "unknown compressed file type $name" - } + if {[string match "*tar.gz" $name]} { + set cmd [::util::which tar] + exec $cmd -xzf $file -C [my set tmpdir] + my import -dir [my set tmpdir] -parent_id [my parent_id] + set success 1 + } else { + my msg "unknown compressed file type $name" + } } default {my msg "type [::xowiki::guesstype $name] of $name unknown"} } @@ -416,90 +416,96 @@ #my msg "work on $tmpfile [::file isdirectory $tmpfile]" set file_name [::file tail $tmpfile] if {[::file isdirectory $tmpfile]} { - # ignore mac os x resource fork directories - if {[string match "*__MACOSX" $tmpfile]} continue - set folder_object [$package_id get_page_from_name -assume_folder true \ - -name $file_name -parent_id $parent_id] - if {$folder_object ne ""} { - # if the folder exists already, we have nothing to do - } else { - # we create a new folder ... - set folder_form_id [::xowiki::Weblog instantiate_forms -forms en:folder.form \ - -package_id $package_id] - set folder_object [FormPage new -destroy_on_cleanup \ - -title $file_name \ - -name $file_name \ - -package_id $package_id \ - -parent_id $parent_id \ - -nls_language en_US \ - -instance_attributes {} \ - -page_template $folder_form_id] - $folder_object save_new - # ..... and refetch it under its canonical name - ::xo::db::CrClass get_instance_from_db -item_id [$folder_object item_id] - } - my import -dir $tmpfile -parent_id [$folder_object item_id] + # ignore mac os x resource fork directories + if {[string match "*__MACOSX" $tmpfile]} continue + set folder_object [$package_id get_page_from_name -assume_folder true \ + -name $file_name -parent_id $parent_id] + if {$folder_object ne ""} { + # if the folder exists already, we have nothing to do + } else { + # we create a new folder ... + set folder_form_id [::xowiki::Weblog instantiate_forms -forms en:folder.form \ + -package_id $package_id] + set folder_object [FormPage new -destroy_on_cleanup \ + -title $file_name \ + -name $file_name \ + -package_id $package_id \ + -parent_id $parent_id \ + -nls_language en_US \ + -instance_attributes {} \ + -page_template $folder_form_id] + $folder_object save_new + # ..... and refetch it under its canonical name + ::xo::db::CrClass get_instance_from_db -item_id [$folder_object item_id] + } + my import -dir $tmpfile -parent_id [$folder_object item_id] } else { - set mime_type [::xowiki::guesstype $file_name] - if {[string match "image/*" $mime_type] && [my use_photo_form]} { - set photo_object [$package_id get_page_from_name -name en:$file_name -parent_id $parent_id] - if {$photo_object ne ""} { - # photo entry exists already, create a new revision - my log "Photo $file_name exists already" - $photo_object set title $file_name - set f [::xowiki::formfield::file new -object $photo_object -name "image" -destroy_on_cleanup] - $f set value $file_name - $f content-type $mime_type - $f set tmpfile $tmpfile - $f convert_to_internal - $photo_object save - } else { - # create a new photo entry - my log "new Photo $file_name" - set photoFormObj [::xowiki::Weblog instantiate_forms \ - -parent_id $parent_id -forms en:photo.form -package_id $package_id] - set photo_object [$photoFormObj create_form_page_instance \ - -name en:$file_name \ - -nls_language en_US \ - -creation_user [::xo::cc user_id] \ - -parent_id $parent_id \ - -package_id $package_id \ - -instance_attributes [list image $file_name]] - $photo_object title $file_name - $photo_object publish_status "ready" - $photo_object save_new ;# to obtain item_id needed by the form-field - set f [::xowiki::formfield::file new -object $photo_object -name "image" -destroy_on_cleanup] - $f set value $file_name - $f content-type $mime_type - $f set tmpfile $tmpfile - $f convert_to_internal - #my log "after convert to internal $file_name" - } - } else { - set file_object [$package_id get_page_from_name -name file:$file_name -parent_id $parent_id] - if {$file_object ne ""} { - my msg "file $file_name exists already" - # file entry exists already, create a new revision - $file_object set import_file $tmpfile - $file_object set mime_type $mime_type - $file_object set title $file_name - $file_object save - } else { - my msg "file $file_name created new" - set file_object [::xowiki::File new -destroy_on_cleanup \ - -title $file_name \ - -name file:$file_name \ - -parent_id $parent_id \ - -mime_type $mime_type \ - -package_id $package_id \ - -creation_user [::xo::cc user_id] ] - $file_object set import_file $tmpfile - $file_object save_new - } - } + set mime_type [::xowiki::guesstype $file_name] + if {[string match "image/*" $mime_type] && [my use_photo_form]} { + set photo_object [$package_id get_page_from_name -name en:$file_name -parent_id $parent_id] + if {$photo_object ne ""} { + # photo entry exists already, create a new revision + my log "Photo $file_name exists already" + $photo_object set title $file_name + set f [::xowiki::formfield::file new -object $photo_object -name "image" -destroy_on_cleanup] + $f set value $file_name + $f content-type $mime_type + $f set tmpfile $tmpfile + $f convert_to_internal + $photo_object save + } else { + # create a new photo entry + my log "new Photo $file_name" + set photoFormObj [::xowiki::Weblog instantiate_forms \ + -parent_id $parent_id -forms en:photo.form -package_id $package_id] + set photo_object [$photoFormObj create_form_page_instance \ + -name en:$file_name \ + -nls_language en_US \ + -creation_user [::xo::cc user_id] \ + -parent_id $parent_id \ + -package_id $package_id \ + -instance_attributes [list image $file_name]] + $photo_object title $file_name + $photo_object publish_status "ready" + $photo_object save_new ;# to obtain item_id needed by the form-field + set f [::xowiki::formfield::file new -object $photo_object -name "image" -destroy_on_cleanup] + $f set value $file_name + $f content-type $mime_type + $f set tmpfile $tmpfile + $f convert_to_internal + #my log "after convert to internal $file_name" + } + } else { + set file_object [$package_id get_page_from_name -name file:$file_name -parent_id $parent_id] + if {$file_object ne ""} { + my msg "file $file_name exists already" + # file entry exists already, create a new revision + $file_object set import_file $tmpfile + $file_object set mime_type $mime_type + $file_object set title $file_name + $file_object save + } else { + my msg "file $file_name created new" + set file_object [::xowiki::File new -destroy_on_cleanup \ + -title $file_name \ + -name file:$file_name \ + -parent_id $parent_id \ + -mime_type $mime_type \ + -package_id $package_id \ + -creation_user [::xo::cc user_id] ] + $file_object set import_file $tmpfile + $file_object save_new + } + } } } } } ::xo::library source_dependent +# +# Local variables: +# mode: tcl +# tcl-indent-level: 2 +# indent-tabs-mode: nil +# End: