#!/bin/sh
# Tcl ignores the next line -*- tcl -*- \
exec wish "$0" -- "$@"

# Copyright © 2011, 2012 Thomas Girard <thomas.g.girard@free.fr>.
# All rights reserved.
#
# tlsgui is free software; see LICENSE.txt for redistribution and
# use conditions. tlsgui comes with ABSOLUTELY NO WARRANTY.
#
# Run with --help for help.
#

package require Tk
package require Tcl 8.5

set VERSION "1.0.1"
set LOGMGR  "IDL:omg.org/DsLogAdmin/LogMgr:1.0"
set LOG     "IDL:omg.org/DsLogAdmin/Log:1.0"
set COPY    "Copyright 2011, 2012 © Thomas Girard"
set LICENSE "tlsgui is free software; see LICENSE.txt for redistribution and\
use conditions.
tlsgui comes with ABSOLUTELY NO WARRANTY."

proc usage {} {
    puts \
"Usage: tlsgui \[-ORBInitRef LogMgr=<object-reference>|-ORBInitRef\
Log=<object-reference>\]
where <object-reference> is a CORBA object reference, e.g.:
  file:///path/to/file.ior
  corbaloc:iiop:1.2@localhost:1234/BasicLogService
  corbaname:iiop:1.2@localhost:1234#BasicLogFactory
  IOR:...

For more information on the CORBA Telecom Log Service, see:
http://www.omg.org/spec/TLOG/"
}

proc about_box {} {
    tk_messageBox -message "tlsgui version $::VERSION" \
                  -detail "a Telecom Log Service viewer

$::COPY

$::LICENSE" \
                  -parent . -title "About tlsgui" -type ok
}

proc error_box {msg why} {
    tk_messageBox -message "$msg" -detail "$why" -type ok -icon "error" \
                  -parent . -title "Error"
}

proc get_ior {old} {
    set filename [tk_getOpenFile]

    if {$filename ne ""} {
        return "file://$filename"

    } else {
        return $old
    }
}

proc corba_init {} {
    if {[catch {package require combat} oops]} {
        puts stderr "Error: failed to find required \"combat\" package"
        exit 1
    }

    # Initialize CORBA stack
    if {[catch {set ::argv [eval corba::init $::argv]} res]} {
        puts stderr "Error: corba::init failed: $res"
        exit 1
    }

    if {[catch {package require DsLogAdminStubs} oops]} {
        # Try harder
        set wd [file normalize [file dirname [info script]]]
        lappend ::auto_path [file join $wd DsLogAdminStubs]

        if {[catch {package require DsLogAdminStubs} oops]} {
            puts stderr "Error: failed to find required \"DsLogAdminStubs\" package"
            exit 1
        }
    }
}

proc lookup {name type {silent true}} {
    corba::try {
        set object [corba::resolve_initial_references $name]

    } catch {IDL:omg.org/CORBA/ORB/InvalidName:1.0 ex} {
        if {[lindex [lindex $ex 1] 0] ne "no_such_initial_reference"} {
            error_box "Invalid \"$name\" initial reference!" "$ex"

        } elseif {!$silent} {
            error_box "Missing \"$name\" initial reference!" \
                      "Use -ORBInitRef $name=... to specify it"
        }

        set object ""

    } catch {... oops} {
        error_box "Invalid \"$name\" initial reference!" "$oops"
        set object ""
    }

    if {$object ne ""} {
        if {[catch {set ok [$object _is_a $type]} oops] || !$ok} {
            error_box "Invalid \"$name\" initial reference!" \
                      "Specified initial reference is not a $type"
            set object ""
        }
    }

    return $object
}

proc connect_to {ior type {silent true}} {
    if {[catch {set object [corba::string_to_object $ior]} oops]} {
        if {!$silent} { error_box "Invalid object reference!" "$ior: $oops" }
        set object ""

    } else {
        if {[catch {set ok [$object _is_a $type]} oops] || !$ok} {
            if {!$silent} {error_box "Invalid reference type!" "$ior: $oops" }
            corba::release $object
            set object ""
        }
    }

    return $object
}

# Layout of the window is:
#
#  +--------------------|Open ...|-----------------------+
#  |                                                     |
#  | CORBA Object Reference: _______________ [Browse...] |
#  |                                                     |
#  |                 [Open] [Cancel]                     |
#  +-----------------------------------------------------+
proc corba_open {} {
    set ::ior ""
    toplevel .op

    frame    .op.t
    label    .op.t.l   -text "CORBA Object Reference: "
    entry    .op.t.ior -width 40 -textvariable ior
    button   .op.t.br  -text "Browse..." -command {set ::ior [get_ior $::ior]}

    frame    .op.b
    button   .op.b.op  -text "Open"      -command {destroy .op}
    button   .op.b.cn  -text "Cancel"    -command {set ::ior ""; destroy .op}

    pack     .op.t.l   -side left
    pack     .op.t.br  -side right
    pack     .op.t.ior -expand 1    -fill x
    pack     .op.t     -side top    -fill x
    pack     .op.b.op  -side left
    pack     .op.b.cn  -side right
    pack     .op.b     -side bottom

    focus    .op.t.ior
    bind     .op <Return> {destroy .op}
    bind     .op <Escape> {set ::ior ""; destroy .op}

    wm resizable .op 1 0

    wm withdraw  .op
    update
    wm transient .op .
    wm title .op "Open..."
    wm deiconify .op

    wm minsize   .op [winfo width .op] [winfo height .op]

    set x [expr {([winfo screenwidth .]-[winfo width .op])/2}]
    set y [expr {([winfo screenheight .]-[winfo height .op])/2}]
    wm geometry  .op +$x+$y

    tkwait window .op

    return "$::ior"
}

proc open_log {{exit_on_empty false}} {
    while {true} {
        set ref [corba_open]

        if {$ref eq ""} {
            # No CORBA object reference specified: abort
            if {$exit_on_empty} {
                exit 1
            } else {
                return
            }
        }

        if {[set object [connect_to $ref $::LOGMGR]] eq ""} {
            if {[set object [connect_to $ref $::LOG false]] eq ""} {
                continue
            }

            set ::log $object
            set ::log_mgr [$::log my_factory]
            set ::log_id [$::log id]

        } else {
            unset -nocomplain ::log
            set ::log_mgr $object
            unset -nocomplain ::log_id
        }

        break
    }
}

proc show_logs {} {
    # Clear and populate log list box
    $::llb delete 0 [$::llb size]
    set ::log_ids [$::log_mgr list_logs_by_id]

    foreach id $::log_ids {
        $::llb insert end "#$id"
    }

    # As well as all other boxes
    $::rlb delete 0 [$::rlb size]
    $::itb configure -state normal
    $::itb delete 1.0 end
    $::itb configure -state disabled
    $::tree delete [$::tree children {}]

    if {[info exists ::log_id]} {
        # Lookup log with matching id
        for {set i 0} {$i < [llength $::log_ids]} {incr i} {
            if {$::log_id == [lindex $::log_ids $i]} {
                $::llb see $i
                $::llb selection set $i
                show_log
                break
            }
        }
    }
}

proc reopen_log {} {
    open_log
    show_logs
}

proc c2u_time {timestamp} {
    set sinceunix [expr {$timestamp - (12219292800 * 10000000)}]
    set secs [expr {$sinceunix / 10000000}]

    return [clock format $secs]
}

proc show_log {} {
    # Don't bother if there's nothing to do
    if {[llength $::log_ids] == 0} {
        return
    }

    set id [lindex $::log_ids [$::llb curselection]]
    set ::log [$::log_mgr find_log $id]

    # Now clear and populate record list box
    $::rlb delete 0 [$::rlb size]

    set iterator {}
    set ::log_records [$::log query "EXTENDED_TCL" "" iterator]

    if {$iterator != 0} {
        set position 0

        while {true} {
            corba::try {
                set chunks [$iterator get $position 0]

            } catch {IDL:omg.org/DsLogAdmin/InvalidParam:1.0 ex} {
                # Work-around TAO bug
                if {$position == 0} {
                    set position [llength $::log_records]
                    set chunks [$iterator get $position 0]

                } else {
                    corba::throw ex
                }
            }

            set got [llength $chunks]

            if {$got == 0} {
                corba::release $iterator
                break

            } else {
                set position [expr {$position + $got}]
                set ::log_records [concat $::log_records $chunks]
            }
        }
    }

    foreach record $::log_records {
        array set dict $record
        $::rlb insert end [format "#%d - %s" $dict(id) [c2u_time $dict(time)]]
    }

    # We also need to clear the info text box
    $::itb configure -state normal
    $::itb delete 1.0 end
    $::itb configure -state disabled
}

proc show_record {} {
    # No record means nothing to do.
    if {![info exists ::log_records] || [llength $::log_records] == 0} {
        return
    }

    array set dict [lindex $::log_records [$::rlb curselection]]

    # Replace existing info with new one
    if {[lindex $dict(info) 0] eq "string"} {
        $::itb configure -state normal
        $::itb replace 1.0 end [lindex $dict(info) 1]
        $::itb configure -state disabled
    }

    # Now clear treeview and display new one
    $::tree delete [$::tree children {}]

    foreach attribute $dict(attr_list) {
        array set pair $attribute

        if {[lindex $pair(value) 0] eq "string"} {
            set kv [list $pair(name) [lindex $pair(value) 1]]
            $::tree insert {} end -values $kv
        }
    }
}

corba_init
set len [llength $argv]

if {$len > 1} {
    puts "$argv0: too many arguments!"
    usage
    exit 1
}

if {$len > 0} {
    set arg [lindex $argv 0]
    switch -glob -- $arg {
        "-v" - "--version" {
            puts \
"TelecomLogServiceGUI (tlsgui) $VERSION

$COPY <thomas.g.girard@free.fr>
Hosted on: https://chiselapp.com/user/tgg/repository/tlsgui/home

$LICENSE"
            exit 0
        }

        "-h" - "-?" - "--help" {
            usage
            exit 0
        }

        default {
            puts stderr "Unknown argument $arg!"
            usage
            exit 1
        }
    }
}

wm title . "tlsgui"

# Layout of the main window is:
#
# +-----------+-|tlsgui|--------------+
# |<log #1> ^ | record #1 - time #1  ^|
# |   ...     |         ...           |
# | log #n  v |<record #n - time #2> v|
# +-----------+---------+-------------+
# | record n info is   ^| attr_list  ^|
# | displayed here as   |  k1 | v1    |
# | best as possible    |  k2 | v2    |
# | (CORBA any)        v|    ...     v|
# +---------------------+-------------+
ttk::panedwindow .p   -orient vertical

# Top pane
ttk::panedwindow .p.t -orient horizontal

# Top > Log list box (::llb)
ttk::labelframe .p.t.lf -text "Logs: "
set ::llb [tk::listbox .p.t.lf.l -yscrollcommand ".p.t.lf.ls set" -width 5 -exportselection 0]
ttk::scrollbar .p.t.lf.ls -command ".p.t.lf.l yview" -orient vertical
pack      .p.t.lf.ls -side right -fill y
pack      .p.t.lf.l  -expand 1   -fill both

# Top > Record list box (::rlb)
ttk::labelframe .p.t.rf -text "Records: "
set ::rlb [tk::listbox .p.t.rf.r -yscrollcommand ".p.t.rf.rs set" -exportselection 0]
ttk::scrollbar .p.t.rf.rs -command ".p.t.rf.r yview" -orient vertical
pack      .p.t.rf.rs -side right -fill y
pack      .p.t.rf.r  -expand 1   -fill both

bind $::llb <<ListboxSelect>> "show_log"
bind $::rlb <<ListboxSelect>> "show_record"

# Bottom pane
ttk::panedwindow .p.b -orient horizontal

# Bottom > Info
ttk::labelframe .p.b.if -text "Information: "
set ::itb [tk::text .p.b.if.t -width 40 -yscrollcommand ".p.b.if.ls set" -state disabled]
ttk::scrollbar .p.b.if.ls -command ".p.b.if.t yview" -orient vertical
pack      .p.b.if.ls -side right -fill y
pack      .p.b.if.t  -expand 1   -fill both

# Bottom > Attribute list
ttk::labelframe .p.b.af   -text "Attributes: "
set ::tree [ttk::treeview .p.b.af.t -columns "name value" -yscrollcommand ".p.b.af.rs set" -show headings]
$::tree    heading name  -text "Name"
$::tree    heading value -text "Value"
ttk::scrollbar  .p.b.af.rs -command ".p.b.af.t yview" -orient vertical
pack       .p.b.af.rs -side right -fill y
pack       .p.b.af.t  -expand 1   -fill both

.p.t add .p.t.lf
.p.t add .p.t.rf
.p.b add .p.b.if
.p.b add .p.b.af
.p add .p.t
.p add .p.b

pack .p -expand yes -fill both

option add *tearOff 0

menu .m
menu .m.log

# Create menus
.m add cascade -label "Log" -menu .m.log -underline 0
.m.log add command -label "Open..." -underline 0 \
                   -accelerator "Ctrl-O" -command {reopen_log}
.m.log add separator
.m.log add command -label "Quit" -underline 0 \
                   -accelerator "Ctrl-Q" -command {exit}
.m add cascade -label "Help" -underline 0 -menu [menu .m.help]
.m.help add command -label "About..." -command {about_box} -underline 0

# Key accelerators
bind . <Control-q> {exit}
bind . <Control-o> {reopen_log}

. configure -menu .m

# Now popup Open... dialog box if needed...
if {[set ::log_mgr [lookup LogMgr $LOGMGR]] eq ""} {
    if {[set ::log [lookup Log $LOG]] eq ""} {
        wm withdraw .
        update
        open_log true
        wm deiconify .
        update

    } else {
        set ::log_mgr [$::log my_factory]
        set ::log_id [$::log id]
    }
}

show_logs
wm minsize . [winfo width .] [winfo height .]
