#########################################################################
##                                                                     ##
##  I N T E R S T E L L A R   C O N S O L E                            ##
##            Copyright (C) 2025- Misato Observatory, Wakayama, Japan  ##
##                                                                     ##
##  This software is available under the GPL (General Public License)  ##
##                                                                     ##
#########################################################################

####################################################################
##                                                                ##
##                 B A S E   P R O C E D U R E S                  ##
##                                                                ##
####################################################################

#
# 基本: filename_text を読み込み、改行を LF に変換し text_ret に返す
#
proc load_text_file { filename_text text_ret maxlencol_ret } {

  upvar $text_ret text_ref
  upvar $maxlencol_ret maxlencol_ref
  set return_val -1

  set text_ref ""
  set maxlencol_ref 0

  if { [catch {open $filename_text r} fid] } {
    # do nothing
  } else {
    fconfigure $fid -translation binary
    set data [read $fid]
    set text_ref [string map {"\r\n" "\n"} $data]
    catch {close $fid}
    # set max col length
    set lines [split $text_ref "\n"]
    set len_lines [llength $lines]
    for {set i 0} {$i < $len_lines} {incr i} {
      set l [string length [lindex $lines $i]]
      if { $maxlencol_ref < $l } {
        set maxlencol_ref $l
      }
    }
    set return_val 0
  }

  return $return_val

}

#
# 基本: LF　な text_src を CR+LF な filename_text へ上書き保存
#
proc save_text_file { text_src filename_text } {

  set return_val -1

  if { [catch {open $filename_text w} fid] } {
    # do nothing
  } else {
    fconfigure $fid -translation binary
    set data [string map {"\n" "\r\n"} $text_src]
    puts -nonewline $fid $data
    catch {close $fid}
    set return_val 0
  }

  return $return_val

}

#
# 基本: ファイルを上書きし、ファイルサイズをゼロにする
#
proc reset_a_file { filename } {

  set ret_status -1

  if { [catch {open $filename w} fid] } {
    # do nothing
  } else {
    fconfigure $fid -translation binary
    catch {close $fid}
    set ret_status 0
  }

  return $ret_status

}

#
# 基本: ファイルを上書きし、1行を書き込む
#
#proc update_a_file_with_a_line { filename str_line } {
#
#  set ret_status -1
#
#  if { [catch {open $filename w} fid] } {
#    # do nothing
#  } else {
#    fconfigure $fid -translation binary
#    puts $fid $str_line
#    catch {close $fid}
#    set ret_status 0
#  }
#
#  return $ret_status
#
#}

#
# 基本: 簡易的 httpクライアント --- GETメソッド
#       url にアクセスし、結果を str_ret、エラー内容を msg_ret に返す
#
proc do_http_get { url str_ret msg_ret } {

  upvar $str_ret str_ref
  upvar $msg_ret msg_ref
  set flag_using_curl 0

  if { $flag_using_curl != 0 } {

    set str_ref [exec -ignorestderr curl -s -G $url]

  } else {

    set str_ref ""

    # url を protocol, host名+port, path に分離
    set status [regexp -- {^([a-z]+)://([^/]+)(.*)} [string trim $url] match proto host path]

    if { $status == 1 } {

      if { $path eq "" } {
        set path "/"
      }
      set status [regexp -- {^([^:]+):(.*)} $host match hostname port]
      if { $status == 0 } {
        set hostname "$host"
        set port "80"
      }

      if {[catch {socket $hostname $port} sock] != 0} {
        # output ERROR message
        set msg_ref "ERROR: cannot open socket hostname=$hostname port=$port"
      } else {
        # 日本語を使うためには -translation binary が必須
        fconfigure $sock -buffering line -translation binary
        puts $sock "GET $path HTTP/1.0\r"
        puts $sock "\r"
        flush $sock
        set server_status "unknown"
        if { [gets $sock txt_line] >= 0 } {
          set lst [split $txt_line " "]
          if { 1 < [llength $lst] } {
            set s0 [string trim [lindex $lst 0]]
            set s1 [string trim [lindex $lst 1]]
            set server_status "$s1"
          }
        }
        while { [gets $sock txt_line] >= 0 } {
          if { [string trim $txt_line] eq "" } {
            break
          }
        }
        if { $server_status eq "200" } {
          while { [gets $sock txt_line] >= 0 } {
            append str_ref "$txt_line\n"
          }
        } else {
          set msg_ref "ERROR: server_status=$server_status hostname=$hostname port=$port"
        }
        catch {close $sock}
      }

    } else {

      set msg_ref "ERROR: invalid url=$url"

    }

  }

}

#
# 基本: 簡易的 httpクライアント --- POSTメソッド
#       url に query_str を送信し、結果を str_ret、エラー内容を msg_ret に返す
#
proc do_http_post { url query_str str_ret msg_ret } {

  upvar $str_ret str_ref
  upvar $msg_ret msg_ref
  set flag_using_curl 0

  if { $flag_using_curl != 0 } {

    set f [open "| curl -s -d @- $url" w]
    puts -nonewline $f "$query_str"
    catch {close $f} std_err

    # 簡易実装: 常に "ok" を返す
    set str_ref "ok"

  } else {

    set str_ref ""

    # url を protocol, host名+port, path に分離
    set status [regexp -- {^([a-z]+)://([^/]+)(.*)} [string trim $url] match proto host path]

    if { $status == 1 } {

      if { $path eq "" } {
        set path "/"
      }
      set status [regexp -- {^([^:]+):(.*)} $host match hostname port]
      if { $status == 0 } {
        set hostname "$host"
        set port "80"
      }

      if {[catch {socket $hostname $port} sock] != 0} {
        # output ERROR message
        set msg_ref "ERROR: cannot open socket hostname=$hostname port=$port"
      } else {
        # 日本語を使うためには -translation binary が必須
        fconfigure $sock -buffering line -translation binary
        set query_len [string length $query_str]
        puts $sock "POST $path HTTP/1.0\r"
        puts $sock "Content-Length: $query_len\r"
        puts $sock "\r"
        puts -nonewline $sock $query_str
        flush $sock
        set server_status "unknown"
        if { [gets $sock txt_line] >= 0 } {
          set lst [split $txt_line " "]
          if { 1 < [llength $lst] } {
            set s0 [string trim [lindex $lst 0]]
            set s1 [string trim [lindex $lst 1]]
            set server_status "$s1"
          }
        }
        while { [gets $sock txt_line] >= 0 } {
          if { [string trim $txt_line] eq "" } {
            break
          }
        }
        if { $server_status eq "200" } {
          while { [gets $sock txt_line] >= 0 } {
            append str_ref "$txt_line\n"
          }
        } else {
          set msg_ref "ERROR: server_status=$server_status hostname=$hostname port=$port"
        }
        catch {close $sock}
      }

    } else {

      set msg_ref "ERROR: invalid url=$url"

    }

  }

}

