#!/usr/local/bin/tclsh8.6

#
# Handle link numbers
#
# Parameters (form or url): none
#   - menu page with creation/reuse form and list
#      - action: (none)
#   - creation 
#      - action: "create"
#      - descr: link description
#   - reuse
#      - action: "reuse"
#      - id: link id
#      - descr: link description
#      - confirm: yes or no
#   - edition
#      - action: "edit"
#      - id: link id
#   - modification (after edit)
#      - action: "mod"
#      - id: link id
#      - descr: link description
#
# History
#   2012/01/21 : jean      : design
#

#
# Template pages used by this script
#

set conf(page-init)		genl.html
set conf(page-edit)		genl-edit.html
set conf(page-ok)		genl-ok.html
set conf(page-confirm)		genl-confirm.html

#
# Script name called in url
#
set conf(script)	"genl"

# Format for link list display

set conf(tablink) {
    global {
	    chars {10 normal}
	    columns {15 70 15}
	    botbar {no}
	    align {left}
    }
    pattern Title {
	    title {yes}
	    chars {10 bold}
	    vbar {no}
	    column { }
	    vbar {no}
	    column {
	    	multicolumn {2}
	    }
	    vbar {no}
    }
    pattern Normal {
	    vbar {no}
	    column { }
	    vbar {no}
	    column { }
	    vbar {no}
	    column { format {raw} }
	    vbar {no}
    }
}

#
# Netmagis general library
#

source /usr/local/lib/netmagis/libnetmagis.tcl

# ::webapp::cgidebug ; exit

##############################################################################
# Utility functions
##############################################################################

proc gen-link-list {l title modlink} {
   global conf

   set lines {}
   if {$title} then {
   	lappend lines [list "Title" \
				[mc "Id"] \
				[mc "Description"] \
			]
   }
   foreach e $l {
   	lassign $e id descr
	set edit ""
	if {$modlink} then {
	    d urlset "" $conf(script) [list {action edit} [list id $id]]
	    set edit [::webapp::helem "a" [mc "Edit"] "href" [d urlget ""]]
	}
	lappend lines [list "Normal" $id $descr $edit]
    }

    return [::arrgen::output "html" $conf(tablink) $lines]
}

proc check-idlink {dbfd id} {
    if {! [regexp {^L?([0-9]+)$} $id dummy id]} then {
	d error [format [mc "Invalid link number (%s)"] $id]
    }

    set sql "SELECT MAX(idlink) AS max FROM topo.link"
    set max -1
    pg_select $dbfd $sql tab {
	set max $tab(max)
    }
    if {$id > $max} then {
	d error [format [mc "Non-existent link number (%s)"] $id]
    }

    return $id
}




##############################################################################
# Default page presenting the link creation form
##############################################################################

d cgi-register {action {}} {
} {
    global conf

    #
    # Build link list
    #

    set l {}

    set sql "SELECT idlink, descr FROM topo.link
    		WHERE descr <> ''
    		ORDER BY idlink ASC"

    pg_select $dbfd $sql tab {
	lappend l [list $tab(idlink) $tab(descr)]
    }

    set list [gen-link-list $l false true]

    #
    # Output result
    #

    d urlset "" $conf(script) {}
    d result $conf(page-init) [list \
					[list %URLFORM% [d urlget ""]] \
					[list %LIST% $list] \
				]
}


##############################################################################
# Create a new link
##############################################################################

d cgi-register {action create} {
	{descr    1 1}
} {
    global conf

    set id -1
    set descr [string trim $descr]
    set qdescr [::pgsql::quote $descr]
    set sql "INSERT INTO topo.link (descr) VALUES ('$qdescr') RETURNING idlink"
    pg_select $dbfd $sql tab {
	set id $tab(idlink)
    }

    if {$id > 0} then {
	d urlset "" $conf(script) {}
	set list [gen-link-list [list [list $id $descr]] true true]
	d result $conf(page-ok) [list \
				    [list %LIST% $list] \
				]
    } else {
	d error [mc "Error while generating a link number"]
    }
}

##############################################################################
# Edit a link description
##############################################################################

d cgi-register {action edit} {
    {id    	1 1}
} {
    global conf

    set id [check-idlink $dbfd $id]

    set descr ""
    set sql "SELECT descr FROM topo.link WHERE idlink=$id"
    pg_select $dbfd $sql tab {
    	set descr $tab(descr)
    }

    d urlset "" $conf(script) {}
    set descr [::webapp::html-string $descr]
    d result $conf(page-edit) [list \
					[list %URLFORM% [d urlget ""]] \
					[list %ID% $id] \
					[list %DESCR% $descr] \
				]
}


##############################################################################
# Commit modification for a link description
##############################################################################

d cgi-register {action mod} {
    {id    	1 1}
    {descr	1 1}
} {
    global conf

    set id [check-idlink $dbfd $id]

    set found 0
    set sql "SELECT idlink FROM topo.link WHERE idlink = $id"
    pg_select $dbfd $sql tab {
	set found 1
    }

    set qdescr [::pgsql::quote $descr]
    if {$found} then {
	set sql "UPDATE topo.link SET descr='$qdescr' WHERE idlink=$id"
    } else {
	set sql "INSERT INTO topo.link (idlink, descr) VALUES ($id, '$qdescr')"
    }
    if {! [::pgsql::execsql $dbfd $sql msg]} then {
	d error [format [mc "Can't modify link %s (%s)"] $id $msg]
    }

    set list [gen-link-list [list [list $id $descr]] true true]
    d result $conf(page-ok) [list \
				[list %LIST% $list] \
			    ]
}

##############################################################################
# Reuse an old link number
##############################################################################

d cgi-register {action reuse} {
    {id    	1 1}
    {descr	1 1}
    {confirm	1 1}
} {
    global conf

    set id [check-idlink $dbfd $id]

    set currentdescr ""
    set sql "SELECT descr FROM topo.link WHERE idlink=$id"
    set exist false
    pg_select $dbfd $sql tab {
	set exist true
	set currentdescr $tab(descr)
    }

    set qdescr [::pgsql::quote $descr]
    if {$exist} then {
	if {$confirm ne "yes"} then {
	    set oldval [gen-link-list [list [list $id $currentdescr]] true false]
	    set newval [gen-link-list [list [list $id $descr]] true false]
	    set pdescr [::webapp::post-string $descr]
    	    d urlset "" $conf(script) {}
	    d result $conf(page-confirm) [list \
					    [list %URLFORM% [d urlget ""]] \
					    [list %OLDVAL% $oldval] \
					    [list %NEWVAL% $newval] \
					    [list %ID% $id] \
					    [list %DESCR% $pdescr] \
					 ]
	} else {
	    set sql "UPDATE topo.link SET descr='$qdescr' WHERE idlink=$id"
	}
    } else {
	set sql "INSERT INTO topo.link (idlink, descr) VALUES ($id, '$qdescr')"
    }

    if {$confirm eq "yes"} then {
	if {! [::pgsql::execsql $dbfd $sql msg]} then {
	    d error [format [mc "Can't reuse link %s (%s)"] $id $msg]
	}

	set list [gen-link-list [list [list $id $descr]] true true]
	d result $conf(page-ok) [list [list %LIST% $list]]
    }
}

##############################################################################
# Main procedure
##############################################################################

d cgi-dispatch "topo" "topogenl"
