attachments-procs.tcl

Automated tests.

Location:

packages/attachments/tcl/test/attachments-procs.tcl

Created:

18 February 2021

Author:

Héctor Romojaro

CVS Identification:

$Id: attachments-procs.tcl,v 1.1.2.6 2023/02/20 10:53:21 antoniop Exp $

Procedures in this file

Detailed information

[ hide source ] | [ make this the default ]

Content File Source

ad_library {
    Automated tests.

    @author Héctor Romojaro <hector.romojaro@gmail.com>
    @creation-date 18 February 2021
    @cvs-id $Id: attachments-procs.tcl,v 1.1.2.6 2023/02/20 10:53:21 antoniop Exp $
}

aa_register_case -procs {
    attachments::get_all_attachments
    attachments::get_attachments
    attachments::attach
    attachments::unattach
    attachments::toggle_approved
} -cats {
    api
} attachments_basic_api {
    Test attachments basic api.
} {
    aa_run_with_teardown -rollback -test_code {
        #
        # Create test objects
        #
        set object_id       [package_instantiate_object acs_object]
        set attachment1_id  [package_instantiate_object acs_object]
        set attachment2_id  [package_instantiate_object acs_object]
        set attachment_ids  [lsort [list $attachment1_id $attachment2_id]]
        #
        # Check that there are no attachments in new object
        #
        aa_equals "Check for attachments on new object" \
            [attachments::get_all_attachments -object_id $object_id] ""
        #
        # Check attachments in object
        #
        attachments::attach \
            -object_id $object_id \
            -attachment_id $attachment1_id \
            -approved_p f
        attachments::attach \
            -object_id $object_id \
            -attachment_id $attachment2_id \
            -approved_p f
        set attachment_list [attachments::get_all_attachments \
                                -object_id $object_id]
        set attachment_list_ids [lsort [lmap x $attachment_list {lindex $x 0}]]
        aa_equals "Check for new attachments object" \
           "$attachment_list_ids" "$attachment_ids"
        #
        # Check for approved/not approved attachments
        #
        attachments::toggle_approved \
            -object_id $object_id \
            -item_id $attachment1_id
        set approved_attachments_list [attachments::get_attachments \
                                        -object_id $object_id]
        set approved_attachments_ids [lsort \
            [lmap x $approved_attachments_list {lindex $x 0}]]
        aa_equals "Check for approved attachments after toggle" \
           "$attachment1_id" "$approved_attachments_ids"
        attachments::toggle_approved \
            -object_id $object_id \
            -item_id $attachment1_id
        aa_equals "Check for approved attachments after toggle (1)" \
            "[attachments::get_attachments -object_id $object_id]" ""
        aa_equals "Check for approved attachments after toggle (2)" \
            [attachments::get_all_attachments \
                -object_id $object_id \
                -approved_only] ""
        #
        # Check that there are no attachments after unattaching
        #
        attachments::unattach \
            -object_id $object_id \
            -attachment_id $attachment1_id
        attachments::unattach \
            -object_id $object_id \
            -attachment_id $attachment2_id
        aa_equals "Check for attachments after unattaching" \
            [attachments::get_all_attachments -object_id $object_id] ""
    }
}

aa_register_case -procs {
    attachments::get_package_key
} -cats {
    api
    production_safe
} attachments_package_key {
    Test attachments::get_package_key.
} {
    aa_equals "Package_key" [attachments::get_package_key] "attachments"
}

aa_register_case -procs {
    attachments::get_title
    acs_object_type
    content::extlink::is_extlink
    content::extlink::name
    content::item::is_subclass
    content::revision::get_title
    acs_object::get_element
} -cats {
    api smoke production_safe
} attachments_name_api {
    Test attachments name api.
} {
    foreach attachment_id [db_list get_attachments {
        select item_id from attachments fetch first 10 rows only
    }] {
        #
        # Try our best to get the 'title', depending on the object type
        #
        set title ""
        set object_type [acs_object_type $attachment_id]
        if {[content::extlink::is_extlink -item_id $attachment_id]} {
            #
            # URL
            #
            set title [content::extlink::name -item_id $attachment_id]
        } elseif {[content::item::is_subclass \
                       -object_type $object_type \
                       -supertype "content_item"]} {
            #
            # Content item, or subtype
            #
            set title [content::item::get_title -item_id $attachment_id]
        } elseif {[content::item::is_subclass \
                       -object_type $object_type  \
                       -supertype "content_revision"]} {
            #
            # Content revision, or subtype
            #
            set title [content::revision::get_title -revision_id $attachment_id]
        } else {
            #
            # Let's try the 'title' column on 'acs_objects'
            #
            set title [acs_object::get_element \
                           -object_id $attachment_id \
                           -element "title"]
        }
        #
        # If everything fails, set the 'attachment_id' as title
        #
        if {$title eq ""} {
            set title $attachment_id
        }

        aa_equals "Name for attachment '$attachment_id' is expected" \
            $title [attachments::get_title -attachment_id $attachment_id]
    }
}

aa_register_case -procs {
    attachments::get_url
    attachments::get_attachments_url
    attachments::add_attachment_url
    attachments::detach_url
    attachments::goto_attachment_url
    attachments::graphic_url
    attachments::context_bar
    attachments::get_root_folder
    fs_context_bar_list
} -cats {
    api smoke production_safe
} attachments_url_api {
    Test attachments URL api.
} {
    set system_url [acs::test::url]


    aa_section "Attachments URL"

    set attachments_url [attachments::get_attachments_url]
    aa_false "'$attachments_url' is a local URL" [util::external_url_p $attachments_url]
    aa_true "'$attachments_url' is a valid URL" [util_url_valid_p -relative $attachments_url]
    aa_true "'$system_url/$attachments_url' is a valid URL" \
        [util_url_valid_p $system_url/$attachments_url]


    aa_section "Add Attachment URL"

    set add_attachment_url [attachments::add_attachment_url \
                                -folder_id 1234 \
                                -package_id 5678 \
                                -object_id 91011 \
                                -return_url a&b \
                                -pretty_name c&d \
                               ]
    aa_false "'$add_attachment_url' is a local URL" [util::external_url_p $add_attachment_url]
    aa_true "'$add_attachment_url' is a valid URL" [util_url_valid_p -relative $add_attachment_url]
    aa_true "'$add_attachment_url' starts by '$attachments_url'" \
        [regexp ^/?${attachments_url}.*$ $add_attachment_url]
    aa_true "'$add_attachment_url' contains '1234'" {
        [string first 1234 $add_attachment_url] >= 0
    }
    #
    # TODO: this fails because package_id is not used into the
    # API. This should be fixed somehow.
    #
    # aa_true "'$add_attachment_url' contains '5678'" {
    #     [string first 5678 $add_attachment_url] >= 0
    # }
    aa_true "'$add_attachment_url' contains '91011'" {
        [string first 91011 $add_attachment_url] >= 0
    }
    aa_true "'$add_attachment_url' contains '[ns_urlencode a&b]'" {
        [string first [ns_urlencode a&b] $add_attachment_url] >= 0
    }
    aa_true "'$add_attachment_url' contains '[ns_urlencode c&d]'" {
        [string first [ns_urlencode c&d] $add_attachment_url] >= 0
    }


    aa_section "Remove Attachment URL"

    set detach_url [attachments::detach_url \
                        -package_id 1234 \
                        -object_id 5678 \
                        -attachment_id 91011 \
                        -return_url c&d]
    aa_false "'$detach_url' is a local URL" [util::external_url_p $detach_url]
    aa_true "'$detach_url' is a valid URL" [util_url_valid_p -relative $detach_url]
    aa_true "'$detach_url' starts by '$attachments_url'" \
        [regexp ^/?${attachments_url}.*$ $detach_url]
    #
    # TODO: this fails because package_id is not used into the
    # API. This should be fixed somehow.
    #
    # aa_true "'$detach_url' contains '1234'" {
    #     [string first 1234 $detach_url] >= 0
    # }
    aa_true "'$detach_url' contains '5678'" {
        [string first 5678 $detach_url] >= 0
    }
    aa_true "'$detach_url' contains '91011'" {
        [string first 91011 $detach_url] >= 0
    }
    aa_true "'$detach_url' contains '[ns_urlencode c&d]'" {
        [string first [ns_urlencode c&d] $detach_url] >= 0
    }


    aa_section "Go to Attachment URL"

    set go_to_attachment_url [attachments::goto_attachment_url \
                                  -package_id 1234 \
                                  -object_id 5678 \
                                  -attachment_id 91011]
    aa_false "'$go_to_attachment_url' is a local URL" [util::external_url_p $go_to_attachment_url]
    aa_true "'$go_to_attachment_url' is a valid URL" [util_url_valid_p -relative $go_to_attachment_url]
    aa_true "'$go_to_attachment_url' starts by '$attachments_url'" \
        [regexp ^/?${attachments_url}.*$ $go_to_attachment_url]
    #
    # TODO: this fails because package_id is not used into the
    # API. This should be fixed somehow.
    #
    # aa_true "'$go_to_attachment_url' contains '1234'" {
    #     [string first 1234 $go_to_attachment_url] >= 0
    # }
    aa_true "'$go_to_attachment_url' contains '5678'" {
        [string first 5678 $go_to_attachment_url] >= 0
    }
    aa_true "'$go_to_attachment_url' contains '91011'" {
        [string first 91011 $go_to_attachment_url] >= 0
    }


    aa_section "Graphics URL"

    set graphic_html [attachments::graphic_url]
    aa_true "Tag contains '[attachments::get_url]'" {
        [string first [attachments::get_url] $graphic_html] >= 0
    }
    aa_true "The graphics are in HTML form" [regexp -nocase {^<img.*$} $graphic_html]


    aa_section "Attachment Context-Bar"

    try {
        #
        # attachments::get_root_folder relies on the node from the
        # connection.
        #
        set orig_node_id [ad_conn node_id]
        ad_conn -set node_id [site_node::get_node_id_from_object_id \
                                  -object_id [apm_package_id_from_key "acs-automated-testing"]]

        set root_folder_id [attachments::get_root_folder]
        set folder_id [db_string get_any_attachment_folder {
            select coalesce(max(f.folder_id), :root_folder_id)
            from cr_folders f, cr_items i
            where f.folder_id = i.item_id
            and i.parent_id = :root_folder_id
        } -default ""]
        set extra_vars {a 1 b 2 c 3}
        set cbar_list [fs_context_bar_list \
                           -extra_vars $extra_vars \
                           -folder_url "attach" \
                           -file_url "attach" \
                           -root_folder_id $root_folder_id \
                           -final t $folder_id]

        attachments::context_bar \
            -folder_id $folder_id \
            -extra_vars $extra_vars \
            -final t \
            -multirow attachments_test_multirow
    } finally {
        ad_conn -set node_id $orig_node_id
    }

    aa_true "Multirow 'attachments_test_multirow' was created" \
        [template::multirow exists attachments_test_multirow]
    aa_equals "Multirow length is expected" \
        [template::multirow size attachments_test_multirow] \
        [expr {[llength $cbar_list] + 1}]
}

aa_register_case -procs {
    attachments::map_root_folder
    attachments::unmap_root_folder
    attachments::root_folder_p
} -cats {
    api smoke production_safe
} attachments_map_folder {
    Test attachments::map_root_folder api.
} {
    aa_run_with_teardown -rollback -test_code {
        set package_id [db_string get_a_package {
            select max(package_id) from apm_packages p
            where not exists (select 1 from attachments_fs_root_folder_map
                              where package_id = p.package_id)
        } -default ""]
        set folder_id [db_string get_a_folder {
            select max(folder_id) from fs_root_folders f
            where not exists (select 1 from attachments_fs_root_folder_map
                              where folder_id = f.folder_id)
        } -default ""]
        if { $package_id ne "" && $folder_id ne "" } {

            aa_false "Package does not refer to a root_folder" \
                [attachments::root_folder_p -package_id $package_id]

            aa_log "Mapping package '$package_id' to folder '$folder_id'"
            attachments::map_root_folder \
                -package_id $package_id \
                -folder_id $folder_id

            aa_true "Package now refers to a root_folder" \
                [attachments::root_folder_p -package_id $package_id]

            aa_true "A mapping was inserted" [db_0or1row check {
                select 1 from attachments_fs_root_folder_map
                where package_id = :package_id and folder_id = :folder_id
            }]

            aa_log "Remove the mapping"
            attachments::unmap_root_folder \
                -package_id $package_id \
                -folder_id $folder_id

            aa_false "Package does not refer to a root_folder anymore" \
                [attachments::root_folder_p -package_id $package_id]
        } else {
            aa_log "Cannot test mapping, not package or root folders to choose."
        }
    }
}

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