# output.test --
#
# Tests output routing to files for bodies, headers, and diagnostics.
#
# Copyright (c) 2024-2026 Massimo Manghi
#
# SPDX-License-Identifier: TCL
#
# See the file "license.terms" at the top level of this distribution
# for information on usage and redistribution of this file, and for the
# complete disclaimer of warranties and limitation of liability.
#
# Portions of this file were drafted or revised with AI assistance
# under the direction and review of Massimo Manghi

package require tcltest
namespace import ::tcltest::*

source [file join [file dirname [file normalize [info script]]] support.tcl]

::tclcurl::test::load_package

proc ::tclcurl::test::slurp_file {path {translation auto}} {
    set fh [open $path]
    try {
        if {$translation ne "auto"} {
            chan configure $fh -translation $translation
        }
        return [read $fh]
    } finally {
        close $fh
    }
}

proc ::tclcurl::test::run_child_capture {name body_script} {
    set tempdir [::tcltest::temporaryDirectory]
    set scriptPath [file join $tempdir ${name}-child.tcl]
    set resultPath [file join $tempdir ${name}-result.txt]
    set stdoutPath [file join $tempdir ${name}-stdout.txt]
    set stderrPath [file join $tempdir ${name}-stderr.txt]
    set supportPath [file join [file dirname [file normalize [info script]]] support.tcl]

    foreach path [list $scriptPath $resultPath $stdoutPath $stderrPath] {
        catch {file delete -force $path}
    }

    set scriptTemplate {
source _TCL_SUPPORT_PATH_
::tclcurl::test::load_package
set result {}
_TCL_BODY_SCRIPT_
set fh [open _TCL_RESULT_PATH_ w]
try {
    puts -nonewline $fh $result
} finally {
    close $fh
}
}
    set script [string map [list \
        _TCL_SUPPORT_PATH_ [list $supportPath] \
        _TCL_BODY_SCRIPT_ $body_script \
        _TCL_RESULT_PATH_ [list $resultPath]] $scriptTemplate]

    ::tclcurl::test::write_text_file $scriptPath $script
    try {
        exec [info nameofexecutable] $scriptPath > $stdoutPath 2> $stderrPath
        return [list \
            0 \
            [::tclcurl::test::slurp_file $stdoutPath] \
            [::tclcurl::test::slurp_file $stderrPath] \
            [::tclcurl::test::slurp_file $resultPath]]
    } finally {
        foreach path [list $scriptPath $resultPath $stdoutPath $stderrPath] {
            catch {file delete -force $path}
        }
    }
}

proc ::tclcurl::test::write_text_file {path data} {
    set fh [open $path w]
    try {
        puts -nonewline $fh $data
    } finally {
        close $fh
    }
}

test output-1.1 {-file writes the HTTP response body to disk} -constraints http_server -body {
    set bodyPath [file join [::tcltest::temporaryDirectory] output-body.txt]
    catch {file delete -force $bodyPath}
    ::tclcurl::test::with_easy_handle handle {
        $handle configure -url [::tclcurl::test::server::base_url] \
                          -file $bodyPath \
                          -noprogress 1
        set rc [$handle perform]
        list $rc \
             [$handle getinfo responsecode] \
             [expr {[file exists $bodyPath]}] \
             [expr {[::tclcurl::test::slurp_file $bodyPath] eq "tclcurl test server\n"}]
    }
} -cleanup {
    catch {file delete -force [file join [::tcltest::temporaryDirectory] output-body.txt]}
} -result {0 200 1 1}

test output-1.2 {-writeheader writes HTTP response headers to disk} -constraints http_server -body {
    set headerPath [file join [::tcltest::temporaryDirectory] output-headers.txt]
    catch {file delete -force $headerPath}
    ::tclcurl::test::with_easy_handle handle {
        $handle configure -url [::tclcurl::test::server::base_url] \
                          -nobody 1 \
                          -writeheader $headerPath \
                          -noprogress 1
        set rc [$handle perform]
        set headerText [::tclcurl::test::slurp_file $headerPath]
        list $rc \
             [$handle getinfo responsecode] \
             [expr {[file exists $headerPath]}] \
             [expr {[string first "HTTP/1.1 200 OK" $headerText] >= 0}] \
             [expr {[string first "Content-Length:" $headerText] >= 0}]
    }
} -cleanup {
    catch {file delete -force [file join [::tcltest::temporaryDirectory] output-headers.txt]}
} -result {0 200 1 1 1}

test output-1.3 {-stderr redirects verbose diagnostics to a file} -constraints http_server -body {
    set stderrPath [file join [::tcltest::temporaryDirectory] output-stderr.txt]
    catch {file delete -force $stderrPath}
    ::tclcurl::test::with_easy_handle handle {
        $handle configure -url [::tclcurl::test::server::base_url] \
                          -stderr $stderrPath \
                          -verbose 1 \
                          -nobody 1 \
                          -noprogress 1
        set rc [$handle perform]
        set stderrText [::tclcurl::test::slurp_file $stderrPath]
        list $rc \
             [$handle getinfo responsecode] \
             [expr {[file exists $stderrPath]}] \
             [expr {[string length $stderrText] > 0}] \
             [expr {[string first "HEAD / HTTP/1.1" $stderrText] >= 0}]
    }
} -cleanup {
    catch {file delete -force [file join [::tcltest::temporaryDirectory] output-stderr.txt]}
} -result {0 200 1 1 1}

test output-1.4 {-file can be reset to the default destination} -constraints http_server -body {
    set bodyPath [file join [::tcltest::temporaryDirectory] output-body-reset.txt]
    set childScriptTemplate {
set bodyPath _TCL_BODY_PATH_
catch {file delete -force $bodyPath}
::tclcurl::test::with_easy_handle handle {
    $handle configure -url [::tclcurl::test::server::base_url] \
                      -file $bodyPath \
                      -noprogress 1
    set firstRc [$handle perform]
    file delete -force $bodyPath

    $handle configure -url [::tclcurl::test::server::base_url] \
                      -file "" \
                      -noprogress 1
    set secondRc [$handle perform]

    set result [list $firstRc $secondRc [$handle getinfo responsecode] [expr {![file exists $bodyPath]}]]
}
}
    set childScript [string map [list \
        _TCL_BODY_PATH_ [list $bodyPath]] $childScriptTemplate]
    set runResult [::tclcurl::test::run_child_capture output-1.4 $childScript]
    list [lindex $runResult 0] \
         [string trim [lindex $runResult 1]] \
         [string length [lindex $runResult 2]] \
         [lindex $runResult 3]
} -result {0 {tclcurl test server} 0 {0 0 200 1}}

test output-1.5 {-writeheader can be reset to the default destination} -constraints http_server -body {
    set headerPath [file join [::tcltest::temporaryDirectory] output-headers-reset.txt]
    set childScriptTemplate {
set headerPath _TCL_HEADER_PATH_
catch {file delete -force $headerPath}
::tclcurl::test::with_easy_handle handle {
    $handle configure -url [::tclcurl::test::server::base_url] \
                      -nobody 1 \
                      -writeheader $headerPath \
                      -noprogress 1
    set firstRc [$handle perform]
    file delete -force $headerPath

    $handle configure -url [::tclcurl::test::server::base_url] \
                      -nobody 1 \
                      -writeheader "" \
                      -noprogress 1
    set secondRc [$handle perform]

    set result [list $firstRc $secondRc [$handle getinfo responsecode] [expr {![file exists $headerPath]}]]
}
}
    set childScript [string map [list \
        _TCL_HEADER_PATH_ [list $headerPath]] $childScriptTemplate]
    set runResult [::tclcurl::test::run_child_capture output-1.5 $childScript]
    set capturedText "[lindex $runResult 1][lindex $runResult 2]"
    list [lindex $runResult 0] \
         [expr {[string first "HTTP/1.1 200 OK" $capturedText] >= 0}] \
         [expr {[string first "Content-Length:" $capturedText] >= 0}] \
         [lindex $runResult 3]
} -result {0 1 1 {0 0 200 1}}

test output-1.6 {-stderr can be reset to the default destination} -constraints http_server -body {
    set stderrPath [file join [::tcltest::temporaryDirectory] output-stderr-reset.txt]
    set childScriptTemplate {
set stderrPath _TCL_STDERR_PATH_
catch {file delete -force $stderrPath}
::tclcurl::test::with_easy_handle handle {
    $handle configure -url [::tclcurl::test::server::base_url] \
                      -stderr $stderrPath \
                      -verbose 1 \
                      -nobody 1 \
                      -noprogress 1
    set firstRc [$handle perform]
    file delete -force $stderrPath

    $handle configure -url [::tclcurl::test::server::base_url] \
                      -stderr "" \
                      -verbose 1 \
                      -nobody 1 \
                      -noprogress 1
    set secondRc [$handle perform]

    set result [list $firstRc $secondRc [$handle getinfo responsecode] [expr {![file exists $stderrPath]}]]
}
}
    set childScript [string map [list \
        _TCL_STDERR_PATH_ [list $stderrPath]] $childScriptTemplate]
    set runResult [::tclcurl::test::run_child_capture output-1.6 $childScript]
    set stderrText [lindex $runResult 2]
    list [lindex $runResult 0] \
         [string length [lindex $runResult 1]] \
         [expr {[string first "HEAD / HTTP/1.1" $stderrText] >= 0}] \
         [lindex $runResult 3]
} -result {0 0 1 {0 0 200 1}}

cleanupTests
