#########################################################################
##                                                                     ##
##  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                  ##
##                                                                ##
####################################################################

#
# Read filename_text, convert CR+LF with LF, and return all as 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

}

#
# convert LF with CR+LF in text_src, then save filename_text (overwritten)
#
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

}

#
# Set length of a file to zero (overwritten)
#
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

}

#
# Write a line to a file (overwritten)
#
#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
#
#}

#
# Simple http client --- GET method
#   Access the url, then return the result (str_ret) and error (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 ""

    # Split url => protocol, host name + 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: Unable to open socket hostname=$hostname port=$port"
      } else {
        # "-translation binary" is required to handle Japanese
        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"

    }

  }

}

#
# Simple http client --- POST method
#   Send query_str to the url, then return the result (str_ret) and error (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

    # Simple implementation: always returns "ok"
    set str_ref "ok"

  } else {

    set str_ref ""

    # Split url => protocol, host name + 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: Unable to open socket hostname=$hostname port=$port"
      } else {
        # "-translation binary" is required to handle Japanese
        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"

    }

  }

}


#
# Returns information (plain text) about the object
# currently selected on the Stellarium server.
#
proc get_object_data_from_stellarium { stellarium_status_url hr_str list_for_replace flag_to_utf8 msg_ret } {

  upvar $msg_ret msg_ref

  set flag_using_http_geturl 0
  set ret_str ""

  # output option of nkf (unused)
#  set v [info tclversion]
#  if { 9.0 <= $v } {
#    # output UTF-8
#    set nkf_o "-w"
#  } else {
#    # output Shift-JIS
#    set nkf_o "-s"
#  }

  if { $flag_using_http_geturl != 0 } {
#    # Use http package
#    set r [::http::geturl $stellarium_status_url -binary 1]
#    # http status ("200" means OK)
#    set ret_code [::http::ncode $r]
#    # contents
#    set ret_string [::http::data $r]
#    ::http::cleanup $r
  } else {
    # Use ISC proc
    do_http_get $stellarium_status_url ret_string msg_ref
    if { $ret_string eq "" } {
      set ret_code ""
    } else {
      set ret_code "200"
    }
  }

  if { $ret_code ne "200" } {

    set msg_ref "ERROR in get_object_data_from_stellarium: Unable to connect to Stellarium."

  } else {

    # Convert current encoding of Tcl
    set line [encoding convertfrom utf-8 $ret_string]

    # Replace: \" -> \a
    set line [regsub -all {[\\]"} $line "\a"]
    set status [regexp -- {.*["]selectioninfo["]:["]([^"]+)["]} $line match info_str]
    if { $status == 1 } {
      # Restore: \a -> \"
      set info_str [string map {"\a" "\""} $info_str]
      set info_str [regsub -all {<br[ ]*[/]*>} $info_str "\n"]
      set info_str [regsub -all {<h[0-9][ ]*[^>]*>} $info_str "$hr_str\n"]
      set info_str [regsub -all {</h[0-9]>} $info_str "\n$hr_str\n"]
      set info_str [regsub -all {</span>|<span[^>]*>} $info_str ""]
      set info_str [regsub -all {</sup>|</sub>|<[/]*b>|<[/]*strong>} $info_str ""]
      set info_str [string map {"<sup>" "^" "<sub>" "_" } $info_str]
      set info_str [string map $list_for_replace $info_str]

      if { $flag_to_utf8 != 0 } {
        set ret_str [encoding convertto utf-8 $info_str]
      } else {
        set ret_str $info_str
      }
    }

  }

  return $ret_str

}

