category-xml-procs.tcl

Procedures for importing/exporting category trees from/to XML documents.

Location:
packages/categories/tcl/category-xml-procs.tcl
Created:
2003-12-02
Author:
Tom Ayles <tom@beatniq.net>
CVS Identification:
$Id: category-xml-procs.tcl,v 1.6.2.2 2024/07/28 17:00:04 gustafn Exp $

Procedures in this file

Detailed information

category_tree::xml::add_category (private)

 category_tree::xml::add_category -tree_id tree_id -parent_id parent_id \
    node

Imports one category.

Switches:
-tree_id (required)
-parent_id (required)
Parameters:
node (required)

Partial Call Graph (max 5 caller/called nodes):
%3 category_tree::xml::import category_tree::xml::import (public) category_tree::xml::add_category category_tree::xml::add_category category_tree::xml::import->category_tree::xml::add_category category::add category::add (public) category_tree::xml::add_category->category::add category::update category::update (public) category_tree::xml::add_category->category::update

Testcases:
No testcase defined.

category_tree::xml::import (public)

 category_tree::xml::import [ -site_wide ] xml

Imports a category tree from an XML representation.

Switches:
-site_wide (optional, boolean)
Parameters:
xml (required)
A string containing the source XML to import from
Returns:
The category tree identifier
Author:
Tom Ayles <tom@beatniq.net>

Partial Call Graph (max 5 caller/called nodes):
%3 test_category_tree_import category_tree_import (test categories) category_tree::xml::import category_tree::xml::import test_category_tree_import->category_tree::xml::import category_tree::add category_tree::add (public) category_tree::xml::import->category_tree::add category_tree::update category_tree::update (public) category_tree::xml::import->category_tree::update category_tree::xml::add_category category_tree::xml::add_category (private) category_tree::xml::import->category_tree::xml::add_category db_transaction db_transaction (public) category_tree::xml::import->db_transaction dom dom category_tree::xml::import->dom category_tree::xml::import_from_file category_tree::xml::import_from_file (public) category_tree::xml::import_from_file->category_tree::xml::import

Testcases:
category_tree_import

category_tree::xml::import_from_file (public)

 category_tree::xml::import_from_file [ -site_wide ] file

Imports a category tree from a given file.

Switches:
-site_wide (optional, boolean)
Parameters:
file (required)

Partial Call Graph (max 5 caller/called nodes):
%3 test_category_tree_import category_tree_import (test categories) category_tree::xml::import_from_file category_tree::xml::import_from_file test_category_tree_import->category_tree::xml::import_from_file category_tree::xml::import category_tree::xml::import (public) category_tree::xml::import_from_file->category_tree::xml::import tdom::xmlReadFile tdom::xmlReadFile category_tree::xml::import_from_file->tdom::xmlReadFile install::xml::action::load-categories install::xml::action::load-categories (public) install::xml::action::load-categories->category_tree::xml::import_from_file

Testcases:
category_tree_import
[ hide source ] | [ make this the default ]

Content File Source

ad_library {
    Procedures for importing/exporting category trees from/to XML documents.

    @author Tom Ayles (tom@beatniq.net)
    @creation-date 2003-12-02
    @cvs-id $Id: category-xml-procs.tcl,v 1.6.2.2 2024/07/28 17:00:04 gustafn Exp $
}

namespace eval ::category_tree::xml {}

d_proc -public ::category_tree::xml::import_from_file {
    {-site_wide:boolean}
    file
} {
    Imports a category tree from a given file.
} {
    if {![file exists $file] || ![file readable $file]} {
        error {Cannot open file for reading}
    }

    return [import -site_wide=$site_wide_p [::tdom::xmlReadFile $file]]
}

d_proc -public ::category_tree::xml::import {
    {-site_wide:boolean}
    xml
} {
    Imports a category tree from an XML representation.

    @param xml A string containing the source XML to import from
    @return The category tree identifier
    @author Tom Ayles (tom@beatniq.net)
} {
    # recode site_wide_p to DB-style boolean
    if {$site_wide_p} { set site_wide_p t } elseset site_wide_p f }

    set doc [dom parse -- $xml]
    if {[catch {set root [$doc documentElement]} err]} {
        error "Error parsing XML: $err"
    }

    set tree_id 0

    db_transaction {
        foreach translation [$root selectNodes {translation}] {
            if {[catch {set locale [$translation getAttribute locale]}]} {
                error "Required attribute 'locale' not found"
            }
            if {[catch {set name [[$translation selectNodes {name}] text]}]} {
                error "Required element 'name' not found"
            }
            if {[catch {set description [[$translation selectNodes {description}] text]}]} {
                set description {}
            }
            if {$tree_id} {
                # tree initialized, add translation
                category_tree::update \
                    -tree_id $tree_id \
                    -name $name \
                    -description $description \
                    -locale $locale
            } else {
                # initialize tree
                set tree_id [category_tree::add \
                                 -site_wide_p $site_wide_p \
                                 -name $name \
                                 -description $description \
                                 -locale $locale]
            }
        }

        foreach category [$root selectNodes {category}] {
            add_category -tree_id $tree_id -parent_id {} $category
        }
    }
    
    $doc delete

    return $tree_id
}

d_proc -private ::category_tree::xml::add_category {
    {-tree_id:required}
    {-parent_id:required}
    node
} {
    Imports one category.
} {
    set category_id 0
    
    # do translations
    foreach translation [$node selectNodes {translation}] {
        if {[catch {set locale [$translation getAttribute locale]}]} {
            error "Required attribute 'locale' not found"
        }
        if {[catch {set name [[$translation selectNodes {name}] text]}]} {
            error "Required element 'name' not found"
        }
        if {[catch {set description [[$translation selectNodes {description}] text]}]} {
            set description {}
        }

        if {$category_id} {
            # category exists, add translation
            category::update \
                -category_id $category_id \
                -locale $locale \
                -name $name \
                -description $description
        } else {
            # create category
            set category_id [category::add \
                                 -tree_id $tree_id \
                                 -parent_id $parent_id \
                                 -locale $locale \
                                 -name $name \
                                 -description $description]
        }
    }
    
    # do children
    foreach child [$node selectNodes {category}] {
        add_category -tree_id $tree_id -parent_id $category_id $child
    }
}

# Local variables:
#    mode: tcl
#    tcl-indent-level: 4
#    indent-tabs-mode: nil
# End: