cbklib

# by a "package unknown" script.  It invokes the
# "package ifneeded" command to set up package-related
# information so that packages will be loaded automatically
# in response to "package require" commands.  When this
# script is sourced, the variable $dir must contain the
# full path name of this file's directory.

package ifneeded softwareupdate 1.4 [list source [file join $dir softwareupdate.tcl]]

# by a "package unknown" script.  It invokes the
# "package ifneeded" command to set up package-related
# information so that packages will be loaded automatically
# in response to "package require" commands.  When this
# script is sourced, the variable $dir must contain the
# full path name of this file's directory.

package ifneeded softwareupdate 1.5 [list source [file join $dir softwareupdate.tcl]]

#softwareupdate.tcl  routines to manage spoftware updates

#  Copyright (C) 2014  WordTech Communications LLC

#MIT license

package provide softwareupdate 1.4
package require http
package require tdom



namespace eval softwareupdate {

    if {![info exists library]} {
	variable library [file dirname [info script]]
    }

................................................................................

    #check version of installed software
    proc checkVersion {app version} {
	variable appversion
	variable appname
	variable currentversion
	variable versionnumber
	variable appcast
	variable sparkledata
	variable changedata


	set appname $app


	softwareupdate::checkingForUpdates

	set appcast http://www.codebykevin.com/[string tolower $appname].xml
	http::config -useragent "$appname Update Check"

	set xml [http::data [http::geturl $appcast]]

	if [catch {http::geturl $appcast} msg] {
	    puts "error: $msg"
	    tk_messageBox -icon info -title "" -message "Update Error!" -detail "An error occurred in retrieving update information.\nPlease try again later."
	    return
	} 

	dom parse $xml sparkledata
	set versionnumber [string trim [$sparkledata selectNodes -namespaces [list x "http://www.andymatuschak.org/xml-namespaces/sparkle"] {string(//enclosure/@x:version)}] .0]

	set changedata [$sparkledata selectNodes {string(//description/text())}]

	set minOS [$sparkledata selectNodes -namespaces [list x "http://www.andymatuschak.org/xml-namespaces/sparkle"] {string(//x:minimumSystemVersion)}]


	if {[tk windowingsystem] eq "aqua"} {
	    set hostOS [exec sw_vers -productVersion]

	    if {![package vsatisfies $hostOS $minOS]} {
		tk_messageBox -icon warning -message "Error!" -detail "$appname is not supported on Mac OS X $hostOS. The minimum supported OS version is $minOS." 
		return
	    }
	}
	
	if {[expr $currentversion < $versionnumber]} {
	    switch [tk windowingsystem] {
		"aqua" {
		    softwareupdate::updatePitch

		}
		
		"win32" {
		    softwareupdate::winPitch $appname $currentversion $versionnumber
		}
		
		"x11" {
		    
		}
	    }
	    
	} else {
	    softwareupdate::upToDate
	}
    }

    #define the current version of the software
    proc setVersion {app number} {
	variable currentversion
	variable appname
	set currentversion $number
	set appname $app
	
    }


    #get the current installation path
    proc findCurrentInstallation {} {
	variable currentinstall
	variable appname 
	switch [tk windowingsystem] {

	    "aqua" {
		set approot [info nameofexecutable]
		set apppath [split $approot /]
		set currentinstall [join [lrange $apppath 0 [lsearch $apppath "*.app"]] / ]
	    }
	    
	    "win32" {
		set currentinstall [file join $::env(APPDATA) ${appname}_App]  
	    }
	    
	    "x11" {
		return
	    }
	}
	
	return $currentinstall

    }

    #prompt user to update: for Perl, which chokes on XML parsing from Tcl
    proc updatePitchPerl {apptitle appnumber currentapp changelog} {
	variable appname
	variable icon
	variable changedata
	variable currentversion
	variable versionnumber
	variable changelist

	catch {destroy .updateprogress}

	catch {destroy .update}


	toplevel .update
	wm title .update "Software Update"

	wm withdraw .update

	frame .update.f -bg gray95
	pack .update.f -fill both -expand yes

	frame .update.f.top -bg gray95
	pack .update.f.top -fill both -expand yes

	label .update.f.top.i -image $icon -bg gray95 -relief flat -highlightthickness 0
	pack .update.f.top.i -side left -fill both -expand yes

	frame .update.f.top.r -bg gray95
	pack .update.f.top.r -side right -fill both -expand yes

	label .update.f.top.r.title -text "A new version of $apptitle is available!" -font {-weight bold} -bg gray95 -relief flat -highlightthickness 0
	pack .update.f.top.r.title -fill both -expand yes -side top

	label .update.f.top.r.msg -text "$apptitle $appnumber is available--you have $currentapp. Would you like to download it now?" -bg gray95 -relief flat -highlightthickness 0
	pack .update.f.top.r.msg -fill both -expand yes -side top

	label .update.f.top.r.release -text "Release Notes:" -font {-weight bold} -relief flat -highlightthickness 0 -bg gray95 
	pack .update.f.top.r.release -side top -fill both -expand yes

	text .update.f.top.r.text -font TkDefaultFont
	pack .update.f.top.r.text -side top -fill both -expand yes

	ttk::frame .update.f.top.r.bottom -padding 5
	pack .update.f.top.r.bottom -side bottom -fill both -expand yes

	ttk::button .update.f.top.r.bottom.skip -text "Skip This Version" -command {destroy .update}

	ttk::button .update.f.top.r.bottom.install -text "Install Update" -default active -command softwareupdate::installUpdate
	
	pack .update.f.top.r.bottom.install .update.f.top.r.bottom.skip  -side right  -fill both -expand yes

	set changetext [split $changelog *]

	set changetext [lrange $changetext 1 end]

	foreach item $changetext {
	    
	    .update.f.top.r.text insert end "* $item\n"

	}

	.update.f.top.r.text configure -state disabled

	wm resizable .update 0 0
	wm deiconify .update
	raise .update
	wm transient .update .

    }


    #prompt user to update
    proc updatePitch {} {
	variable appname
	variable icon
	variable changedata
	variable currentversion
	variable versionnumber

	catch {destroy .updateprogress}

	catch {destroy .update}
	

	toplevel .update
	wm title .update "Software Update"

	wm withdraw .update

	frame .update.f -bg gray95
	pack .update.f -fill both -expand yes

	frame .update.f.top -bg gray95
	pack .update.f.top -fill both -expand yes

	label .update.f.top.i -image $icon -bg gray95 -relief flat -highlightthickness 0
	pack .update.f.top.i -side left -fill both -expand yes

	frame .update.f.top.r -bg gray95
	pack .update.f.top.r -side right -fill both -expand yes

	label .update.f.top.r.title -text "A new version of $appname is available!" -font {-weight bold} -bg gray95 -relief flat -highlightthickness 0
	pack .update.f.top.r.title -fill both -expand yes -side top

	label .update.f.top.r.msg -text "$appname $versionnumber is available--you have $currentversion. Would you like to download it now?" -font {-size 10} -bg gray95 -relief flat -highlightthickness 0
	pack .update.f.top.r.msg -fill both -expand yes -side top

	label .update.f.top.r.release -text "Release Notes:" -font {-size 10 -weight bold} -relief flat -highlightthickness 0 -bg gray95 
	pack .update.f.top.r.release -side top -fill both -expand yes

	text .update.f.top.r.text -font TkDefaultFont
	pack .update.f.top.r.text -side top -fill both -expand yes

	ttk::frame .update.f.top.r.bottom -padding 5
	pack .update.f.top.r.bottom -side bottom -fill both -expand yes

	ttk::button .update.f.top.r.bottom.skip -text "Skip This Version" -command {destroy .update}

	ttk::button .update.f.top.r.bottom.install -text "Install Update" -default active -command softwareupdate::installUpdate
	
	pack .update.f.top.r.bottom.install .update.f.top.r.bottom.skip  -side right  -fill both -expand yes

	.update.f.top.r.text insert end $changedata

	.update.f.top.r.text configure -state disabled

	wm resizable .update 0 0
	wm deiconify .update
	raise .update
	wm transient .update .

    }

    proc winPitch {name newversion oldversion} {
	set answer [tk_messageBox  -icon info -title "New Version Available" -message "New Version Available" -detail "$name $newversion is available--you have $oldversion. Would you like to download it now?" -type yesno
		   ]

	switch -- $answer {
	    yes {

		xplat::launch http://www.codebykevin.com/$name.html
		destroy .updateprogress
	    }
	    no {
		destroy .updateprogress
		return
	    }
	}
    }
    #"busy" dialog
    proc checkingForUpdates {} {

	variable appname
	variable icon

	catch {destroy .updateprogress}

	toplevel .updateprogress 
	wm title .updateprogress "Updating $appname"

	wm withdraw .updateprogress
	update idletasks

	ttk::frame .updateprogress.f -padding 5
	pack .updateprogress.f -fill both -expand yes

	label .updateprogress.f.l -bg gray95 -image $icon -bd 0 -relief flat -highlightthickness 0 -width [image width $icon] -height [image height $icon]
	pack .updateprogress.f.l -side left -fill both -expand yes

	frame .updateprogress.f.r -bg gray95 -bd 0 -highlightcolor gray95
	pack .updateprogress.f.r -side right -fill both -expand yes
	
	
	ttk::label .updateprogress.f.r.t -text "Checking for updates..." -padding 5
	pack .updateprogress.f.r.t -side top -fill both -expand yes

	ttk::frame .updateprogress.f.r.f -padding 5
	pack .updateprogress.f.r.f -side top -fill both -expand yes
	
	ttk::progressbar .updateprogress.f.r.f.progress -mode indeterminate -orient horizontal
	pack .updateprogress.f.r.f.progress -fill both -expand yes -side top

	.updateprogress.f.r.f.progress start

	ttk::button .updateprogress.f.r.f.b -text "Cancel" -command {destroy .updateprogress}

	pack .updateprogress.f.r.f.b -side bottom -fill both -expand no

	wm geometry .updateprogress 400x100
	wm resizable .updateprogress 0 0

	wm deiconify .updateprogress
	raise .updateprogress

	wm transient .updateprogress .

    }

    #dialog if current version is installed
    proc upToDate {} {
	variable appname
	variable currentversion

	catch {destroy .updateprogress}

	tk_messageBox  -icon info -title "Up to Date" -message "You're up to date!" -detail "$appname $currentversion is the currently the newest version available."

    }

    #show progress of installation
    proc progressDialog {} {

	variable appname
	variable status
	variable icon

	catch {destroy .downloadprogress}

	toplevel .downloadprogress
	wm title .downloadprogress "Updating $appname"

	wm transient .downloadprogress .

	label .downloadprogress.label -image $icon  -anchor w -bg gray95 -highlightthickness 0

	pack .downloadprogress.label -side left -fill both -expand yes


	ttk::frame .downloadprogress.frame -padding 5
	pack .downloadprogress.frame -side right -fill both -expand yes

	ttk::label .downloadprogress.frame.l -textvariable softwareupdate::status -width 40 -text ""
	pack .downloadprogress.frame.l -side top -fill both -expand yes

	ttk::progressbar .downloadprogress.frame.bar -mode indeterminate -orient horizontal  -maximum 100
	pack .downloadprogress.frame.bar -side top -fill both -expand yes

	.downloadprogress.frame.bar start
	update

	ttk::button .downloadprogress.frame.b -text "Cancel" -command {destroy .updateprogress}
	pack .downloadprogress.frame.b -side right -fill both -expand no

	wm geometry .downloadprogress 400x100
	wm resizable .downloadprogress 0 0
	
    }

    #download and install the update
    proc installUpdate {} {
	variable currentinstall
	variable status
	variable appname
	variable tmpdir

	catch {destroy .update}

	softwareupdate::findCurrentInstallation

	softwareupdate::progressDialog
	set status "Downloading update for $appname"
	
	switch [tk windowingsystem] {

	    "aqua" {
		http::geturl http://www.codebykevin.com/updates/[list $appname].tgz -channel [open $tmpdir/[list $appname].tgz w] 
		update
		after 1000
		cd $tmpdir
		set status "Unpacking update for $appname"
		update
		after 1000
		catch {exec tar xvfz [list $appname].tgz}
	    }
	    
	    "win32" {
	
	    }
	    
	    "x11" {
		
	    }
	}
	
	
	set status "Ready to install"
	.downloadprogress.frame.bar configure -mode determinate
	.downloadprogress.frame.bar configure -value 100
	.downloadprogress.frame.bar stop
	destroy .downloadprogress.frame.b 
	pack [ttk::button .downloadprogress.frame.b -text "Install and Relaunch" -command softwareupdate::launchUpdate] -side right -fill both -expand no
	return
    }


    #launch the update
    proc launchUpdate {}  {

	variable currentinstall
	variable appname
	variable tmpdir
	
	switch [tk windowingsystem] {

	    "aqua" {
		if {[catch {exec codesign -v $tmpdir/$appname.app} msg]} {
		    bgerror $msg
		    tk_messageBox -icon warning -message "Error!" -detail "An error occurred in the installation of $appname. Please try again later."
		    return
		} else {

		    file rename -force $currentinstall [file join /Users [exec whoami] .Trash [file tail $currentinstall]]

		    file rename -force $tmpdir/$appname.app $currentinstall

		    exec $currentinstall/Contents/MacOS/$appname &

		    exit
		}
	    }
	    
	    "win32" {
		
	    }
	    
	}

	catch {destroy .downloadprogress}

	

    }


    namespace export *

}

#softwareupdate.tcl  routines to manage spoftware updates

#  Copyright (C) 2014  WordTech Communications LLC

#MIT license

package provide softwareupdate 1.5
package require http
package require tls

http::register https 443 [list ::tls::socket -tls1 1]   ;# "-tls1 1" is required since [POODLE]

namespace eval softwareupdate {

    if {![info exists library]} {
	variable library [file dirname [info script]]
    }

................................................................................

    #check version of installed software
    proc checkVersion {app version} {
	variable appversion
	variable appname
	variable currentversion
	variable versionnumber





	set appname $app


	softwareupdate::checkingForUpdates

	set versionurl https://www.codebykevin.com/version.tcl
	http::config -useragent "$appname Update Check"

	if [catch {http::geturl $versionurl} msg] {
	    puts "error: $msg"
	    tk_messageBox -icon warning -title "Unable to Connect to Server" -message "Unable to Connect to Server" -detail "Unable to connect to www.codebykevin.com to check for updates. Please make sure you are connected to the Internet." -parent .
	    return
	} 

	array set appversion [http::data [http::geturl $versionurl]]
	set versionnumber $appversion([string tolower $appname])
	puts $version
	if {$currentversion < $versionnumber} {
	    softwareupdate::updatePitch
	} else {
	    softwareupdate::upToDate
	}
}

#define the current version of the software
proc setVersion {app number} {
    variable currentversion
    variable appname
    set currentversion $number
    set appname $app
    
}


#get the current installation path
proc findCurrentInstallation {} {
    variable currentinstall
    variable appname 
    switch [tk windowingsystem] {

	"aqua" {
	    set approot [info nameofexecutable]
	    set apppath [split $approot /]
	    set currentinstall [join [lrange $apppath 0 [lsearch $apppath "*.app"]] / ]
	}
	
	"win32" {
	    set currentinstall [file join $::env(APPDATA) ${appname}_App]  
	}
	
	"x11" {
	    return
	}
    }
    
    return $currentinstall

}



#prompt user to update
proc updatePitch {} {
    variable appname
    variable icon
    variable changedata
    variable currentversion
    variable versionnumber

    catch {destroy .updateprogress}

    catch {destroy .update}
    
	variable appname

	set changeurl https://www.codebykevin.com/$appname-changes.tcl

        if [catch {http::geturl $changeurl} msg] {
	    puts "error: $msg"
	    tk_messageBox -icon warning -title "Unable to Connect to Server" -message "Unable to Connect to Server" -detail "Unable to connect to www.codebykevin.com to check for updates. Please make sure you are connected to the Internet." -parent .
	    return
	} 


	set changelist [http::data [http::geturl $changeurl]]

	set updateanswer [tk_messageBox -title "Update" -icon info -message "Update Available" -detail "A new version ($softwareupdate::versionnumber) of $appname is available.\n\nThis new version features the following updates and changes:\n\n$changelist\n\nWould you like to install it? " -type yesno -parent .]
	switch -- $updateanswer {
	    yes {
		softwareupdate::installUpdate
	    }
	    no {
		destroy $updateanswer
		return
	    }
	    
	}

}

proc winPitch {name newversion oldversion} {
    set answer [tk_messageBox  -icon info -title "New Version Available" -message "New Version Available" -detail "$name $newversion is available--you have $oldversion. Would you like to download it now?" -type yesno
	       ]

    switch -- $answer {
	yes {

	    xplat::launch https://www.codebykevin.com/$name.html
	}
	no {
	    return
	}
    }
}
#"busy" dialog
proc checkingForUpdates {} {

    variable appname
    variable icon

    catch {destroy .updateprogress}

    toplevel .updateprogress 
    wm title .updateprogress "Updating $appname"

    wm withdraw .updateprogress
    update idletasks

    ttk::frame .updateprogress.f -padding 5
    pack .updateprogress.f -fill both -expand yes

    label .updateprogress.f.l -bg gray95 -image $icon -bd 0 -relief flat -highlightthickness 0 -width [image width $icon] -height [image height $icon]
    pack .updateprogress.f.l -side left -fill both -expand yes

    frame .updateprogress.f.r -bg gray95 -bd 0 -highlightcolor gray95
    pack .updateprogress.f.r -side right -fill both -expand yes
    
    
    ttk::label .updateprogress.f.r.t -text "Checking for updates..." -padding 5
    pack .updateprogress.f.r.t -side top -fill both -expand yes

    ttk::frame .updateprogress.f.r.f -padding 5
    pack .updateprogress.f.r.f -side top -fill both -expand yes
    
    ttk::progressbar .updateprogress.f.r.f.progress -mode indeterminate -orient horizontal
    pack .updateprogress.f.r.f.progress -fill both -expand yes -side top

    .updateprogress.f.r.f.progress start

    ttk::button .updateprogress.f.r.f.b -text "Cancel" -command {destroy .updateprogress}

    pack .updateprogress.f.r.f.b -side bottom -fill both -expand no

    wm geometry .updateprogress 400x100
    wm resizable .updateprogress 0 0

    wm deiconify .updateprogress
    raise .updateprogress

    wm transient .updateprogress .

}

#dialog if current version is installed
proc upToDate {} {
    variable appname
    variable currentversion

    catch {destroy .updateprogress}

    tk_messageBox  -icon info -title "Up to Date" -message "You're up to date!" -detail "$appname $currentversion is the currently the newest version available."

}

#show progress of installation
proc progressDialog {} {

    variable appname
    variable status
    variable icon

    catch {destroy .downloadprogress}

    toplevel .downloadprogress
    wm title .downloadprogress "Updating $appname"

    wm transient .downloadprogress .

    label .downloadprogress.label -image $icon  -anchor w -bg gray95 -highlightthickness 0

    pack .downloadprogress.label -side left -fill both -expand yes


    ttk::frame .downloadprogress.frame -padding 5
    pack .downloadprogress.frame -side right -fill both -expand yes

    ttk::label .downloadprogress.frame.l -textvariable softwareupdate::status -width 40 -text ""
    pack .downloadprogress.frame.l -side top -fill both -expand yes

    ttk::progressbar .downloadprogress.frame.bar -mode indeterminate -orient horizontal  -maximum 100
    pack .downloadprogress.frame.bar -side top -fill both -expand yes

    .downloadprogress.frame.bar start
    update

    ttk::button .downloadprogress.frame.b -text "Cancel" -command {destroy .updateprogress}
    pack .downloadprogress.frame.b -side right -fill both -expand no

    wm geometry .downloadprogress 400x100
    wm resizable .downloadprogress 0 0
    
}

#download and install the update
proc installUpdate {} {
    variable currentinstall
    variable status
    variable appname
    variable tmpdir

    catch {destroy .update}

    softwareupdate::findCurrentInstallation

    softwareupdate::progressDialog
    set status "Downloading update for $appname"
    
    switch [tk windowingsystem] {

	"aqua" {
	    http::geturl https://www.codebykevin.com/updates/[list $appname].dmg -channel [open $tmpdir/[list $appname].dmg w] 
	    update
	    after 1000
	    cd $tmpdir
	    set status "Attaching [list $appname].dmg"
	    update
	    exec hdiutil attach [list $appname].dmg
	}
	
	"win32" {
	    
	    http::geturl https://www.codebykevin.com/updates/[list $appname]_Setup.exe -channel [open $tmpdir/[list $appname]_Setup.exe w]

	}
	
	"x11" {
	    tk_messageBox -icon info -parent . -message "Please ask the maintainer of $appname on your platform to prepare a release of the latest version."
	    return
	}
    }
    
    
    set status "Ready to install"
    .downloadprogress.frame.bar configure -mode determinate
    .downloadprogress.frame.bar configure -value 100
    .downloadprogress.frame.bar stop
    destroy .downloadprogress.frame.b 
    pack [ttk::button .downloadprogress.frame.b -text "Install and Relaunch" -command softwareupdate::launchUpdate] -side right -fill both -expand no
    return
}


#launch the update
proc launchUpdate {}  {

    variable currentinstall
    variable appname
    variable tmpdir
    
    switch [tk windowingsystem] {

	"aqua" {

		file rename -force $currentinstall [file join /Users [exec whoami] .Trash [file tail $currentinstall]]

		file copy -force /Volumes/[list $appname]/[list $appname].app $currentinstall

		exec $currentinstall/Contents/MacOS/$appname &

		exec hdiutil detach /Volumes/[list $appname]

		exit
	    }
	
	"win32" {
	    
	    eval exec [auto_execok start] $tmpdir/[list $appname]_Setup.exe &
	    exit
	}
	
	"x11" {
	    tk_messageBox -icon info -parent . -message "Please ask the maintainer of $appname on your platform to prepare a release of the latest version."
	    return
	}
    }

    catch {destroy .downloadprogress}

    

}




namespace export *

}