New Defect Utility (todo.txt and Perforce)

newdefect.tcl

# Name: New Defect Automation
# Author: Jeff Parent
# Date: 2016/08/12 20:40:03
# Changes:
#   0.5 - Added P4PORT configuration and using Promises
#   0.3 - Writes to Todo.txt and Perforce
set version "0.5"

package provide app-newdefect $version

package require Tk
package require Mk4tcl
package require promise

proc initializeDb {} {
  mk::row append db.config
}

proc loadConfigUI {} {
  if {[winfo exists .config]} {
    focus .config
  } else {
    tk::toplevel .config

    wm title .config "Configuration"
    wm resizable .config 0 0

    grid [ttk::frame .config.fr] -column 0 -row 0 -sticky nesw

    grid [ttk::label .config.fr.lb1 -text [join [list "Perforce parameters are available in the graphical version (P4V). In the latest version" \
                                                      "the title bar should display:" \
                                                      "<client spec>, <p4port>, <user> - Perforce P4V" \
                                                      "" \
                                                      "Todo.txt path is optional, for those who useTodo.txt for task management."] \n]] -column 0 -row 0 -columnspan 4 -sticky nesw

    grid [ttk::label .config.fr.lb2 -text "User:"] -column 0 -row 1 -sticky ew
    grid [ttk::entry .config.fr.user -textvariable cfgUser -width 80] -column 1 -row 1 -sticky ew
    .config.fr.user delete 0 end
    .config.fr.user insert 0 [mk::get db.config!0 username]

    grid [ttk::label .config.fr.lbl3 -text "ClientSpec:"] -column 0 -row 2 -sticky ew
    grid [ttk::entry .config.fr.clientspec -textvariable cfgClientSpec -width 80] -column 1 -row 2 -sticky ew
    .config.fr.clientspec delete 0 end
    .config.fr.clientspec insert 0 [mk::get db.config!0 clientspec]

    grid [ttk::label .config.fr.lbl4 -text "P4PORT:"] -column 0 -row 3 -sticky ew
    grid [ttk::entry .config.fr.p4port -textvariable cfgP4Port -width 80] -column 1 -row 3 -stick ew
    .config.fr.p4port delete 0 end
    .config.fr.p4port insert 0 [mk::get db.config!0 p4port]

    grid [ttk::label .config.fr.lbl5 -text "Todo.txt Path:"] -column 0 -row 4 -sticky ew
    grid [ttk::entry .config.fr.todofile -textvariable cfgTodoFile -width 80] -column 1 -row 4 -sticky ew
    .config.fr.todofile delete 0 end
    .config.fr.todofile insert 0 [mk::get db.config!0 todofile]

    proc closeConfig {} { destroy .config }

    proc closeConfigAndSave {} {
      mk::set db.config!0 username $::cfgUser
      mk::set db.config!0 clientspec $::cfgClientSpec
      mk::set db.config!0 p4port $::cfgP4Port
      mk::set db.config!0 todofile $::cfgTodoFile
      mk::file commit db

      set ::user [mk::get db.config!0 username]
      set ::clientspec [mk::get db.config!0 clientspec]
      set ::p4port [mk::get db.config!0 p4port]
      set ::todofile [mk::get db.config!0 todofile]

      closeConfig
    }
    grid [ttk::button .config.fr.save -text "Save" -command closeConfigAndSave] -column 0 -row 5 -sticky e

    grid [ttk::button .config.fr.close -text "Close" -command closeConfig] -column 1 -row 5 -sticky e
  }
}


# Database
mk::file open db [file nativename [file join $env(HOME) newdefect.db]]
mk::view layout db.config "username clientspec todofile p4port"

if {[mk::view size db.config] == 0} {
  initializeDb
  loadConfigUI
}

set user [mk::get db.config!0 username]
set cfgUser $user
set clientspec [mk::get db.config!0 clientspec]
set cfgClientSpec $clientspec
set p4port [mk::get db.config!0 p4port]
set cfgP4Port $p4port
set todofile [mk::get db.config!0 todofile]
set cfgTodoFile $todofile
set number ""
set project ""
set domain ""
set priority ""
set title ""

# Main UI
wm title . "New Defect Automation - $version"
wm resizable . 0 0

grid [ttk::frame .fr] -column 0 -row 0 -sticky nesw

grid [ttk::label .fr.lb1 -text "SCR Number:"] -column 0 -row 0 -sticky ew
grid [ttk::entry .fr.scrnum -textvariable number] -column 1 -row 0 -sticky ew
grid [ttk::combobox .fr.prio -textvariable priority] -column 2 -row 0 -sticky ew
.fr.prio configure -values [list Showstopper High Medium Low Enhancement]
grid [ttk::button .fr.new -text "New" -command clearfields] -column 3 -row 0 -padx 5 -pady 5

grid [ttk::label .fr.lb2 -text "Project/Domain:"] -column 0 -row 1 -sticky ew
grid [ttk::entry .fr.proj -textvariable project] -column 1 -row 1 -stick ew
grid [ttk::entry .fr.domain -textvariable domain] -column 2 -row 1 -stick ew
grid [ttk::button .fr.close -text "Close" -command exit] -column 3 -row 1

grid [ttk::label .fr.lb4 -text "Title:"] -column 0 -row 3 -sticky ew
grid [ttk::entry .fr.title -textvariable title] -column 1 -row 3 -columnspan 2 -sticky ew
grid [ttk::button .fr.submit -text "Submit" -command submit] -column 3 -row 3 -padx 5 -pady 5

grid [ttk::button .fr.config -text "Configure" -command loadConfigUI] -column 3 -row 4 -padx 5 -pady 5

focus .fr.scrnum

proc clearfields {} {
  .fr.scrnum delete 0 end
  .fr.title delete 0 end
  .fr.proj delete 0 end
  .fr.domain delete 0 end
  .fr.prio set ""
  focus .fr.scrnum
}

proc mustExist {} {
  return [expr "[info exists ::number] & [info exists ::project] & [info exists ::priority] & [info exists ::title]"]
}

proc perforceChange {clientspec user number title} {
  set p4Change [open "|p4.exe change -i" r+]
  puts $p4Change "Change: new"
  puts $p4Change ""
  puts $p4Change "Client: $clientspec"
  puts $p4Change ""
  puts $p4Change "User: $user"
  puts $p4Change ""
  puts $p4Change "Status: new"
  puts $p4Change ""
  puts $p4Change "Description:"
  puts $p4Change "    $number -- $title"
  puts $p4Change ""
  flush $p4Change
  chan close $p4Change write
  set changeStatus [read $p4Change]
  close $p4Change

  # Check if successful
  set prefix [string range $changeStatus 0 3]
  if { $prefix == "Chan" } {
    set change [lindex $changeStatus 1]
  } else {
    set change 0
  }

  return $change
}

proc perforceJob {number user title} {
  set p4Job [open "|p4.exe job -i" r+]
  puts $p4Job "Job: $number"
  puts $p4Job ""
  puts $p4Job "Status: open"
  puts $p4Job ""
  puts $p4Job "User: $user"
  puts $p4Job ""
  puts $p4Job "Description:"
  puts $p4Job "    $title"
  puts $p4Job ""
  flush $p4Job
  chan close $p4Job write
  set jobStatus [read $p4Job]
  close $p4Job

  puts "JOB STATUS: $jobStatus"

  # Check if successful
  set prefix [string range $jobStatus 0 2]
  if { $prefix == "Job" } {
    set job [lindex $jobStatus 1]
  } else {
    set job 0
  }

  return $job
}

proc todoTxt {todofile num prio pro dom title} {
  # Todo.txt
  switch $prio {
    Showstopper { set pri B }
    High { set pri C }
    Medium { set pri D }
    Low { set pri E }
    Enhancement { set pri F }
    default { set pri F }
  }

  set systemTime [clock seconds]
  set date [clock format $systemTime -format %Y-%m-%d]

  if {[string length $dom] == 0} {
    set pd "+$pro"
  } else {
    set pd "+$pro.$dom"
  }

  set fp [open $todofile a+]
  puts -nonewline $fp "\n($pri) $date Correct $pd @SCR $num -- $title"
  close $fp
}

proc submit {} {
  # SCR Submission form
  set num [promise::pfulfilled $::number]
  set prio [promise::pfulfilled $::priority]
  set proj [promise::pfulfilled $::project]
  set dom [promise::pfulfilled $::domain]
  set title [promise::pfulfilled $::title]
  set formProm [promise::all* $num $prio $proj $dom $title]

  # Validate form entries, note that Domain is optional and not tested
  set submitFormProm [$formProm then [promise::lambda {lst} {
    if {[string length [lindex $lst 0]] == 0} {
      error "Missing SCR Number"
    } elseif {[string length [lindex $lst 1]] == 0} {
      error "Missing Priority"
    } elseif {[string length [lindex $lst 2]] == 0} {
      error "Missing Project Name"
    } elseif {[string length [lindex $lst 4]] == 0} {
      error "Missing Title"
    }
    return $lst
  }]]

  # Todo.txt promise, requires just form data. File path is passed in
  # directly and checked, always successfull even if nothing happens.
  set todoTxtProm [$submitFormProm then [promise::lambda {f lst} {
    set num [lindex $lst 0]
    set prio [lindex $lst 1]
    set proj [lindex $lst 2]
    set dom [lindex $lst 3]
    set title [lindex $lst 4]
    if {[string length $f] > 0} {
      todoTxt $f $num $prio $proj $dom $title
    }
  } $::todofile]]

  # Perforce parameters
  set cspec [promise::pfulfilled $::clientspec]
  set usr [promise::pfulfilled $::user]
  set p4p [promise::pfulfilled $::p4port]

  # P4 Params with form params
  set p4Prom [promise::all* $cspec $usr $p4p $submitFormProm]

  # Check all p4 parameters
  set p4VarsProm [$p4Prom then [promise::lambda {lst} {
    if {[string length [lindex $lst 1]] == 0} {
      error "Missing User, check config"
    } elseif {[string length [lindex $lst 0]] == 0} {
      error "Missing ClientSpec, check config"
    } elseif {[string length [lindex $lst 2]] == 0} {
      error "Missing P4Port, check config"
    }
    return $lst
  }]]

  set p4ApplyProm [$p4VarsProm then [promise::lambda {lst} {
    set lClientSpec [lindex $lst 0]
    set lUser [lindex $lst 1]
    set lP4port [lindex $lst 2]
    set lNumber [lindex $lst 3 0]
    set lPriority [lindex $lst 3 1]
    set lProject [lindex $lst 3 2]
    set lDomain [lindex $lst 3 3]
    set lTitle [lindex $lst 3 4]

    # Run set P4PORT
    set setPort [promise::pexec p4.exe set P4PORT=$lP4port]

    # Create CL using lst
    set setChangeList [$setPort then [promise::lambda {cp usr num tle ignore} {
      set cl [perforceChange $cp $usr $num $tle]
      if {$cl != 0} { return $cl } else { error "Failed Creating Change List" }
    } $lClientSpec $lUser $lNumber $lTitle]]

    # Create Job using lst
    set setJob [$setChangeList then [promise::lambda {cl} {
      set job [perforceJob $::number $::user $::title]
      if {$job != 0} { return [list $cl $job] } else { error "Failed Creating Job" }
    }]]

    promise::then_chain $setJob
  }]]


  set p4FixProm [$p4ApplyProm then [promise::lambda { cl_job } {
    set cl [lindex $cl_job 0]
    set job [lindex $cl_job 1]
    set job1 [promise::pexec p4.exe fix -c $cl $job]
    set job2 [$job1 then [promise::lambda {cl ignore} { return $cl } $cl] \
                         [promise::lambda {err edict} { return "Failed p4.exe fix" }]]
    promise::then_chain $job2
  }]]

  set p4Done [$p4FixProm then [promise::lambda {cl} {
    tk_messageBox -title "Success" -message "Created new changelist $cl"
  }]]

  set lastProm [promise::all* $p4Done $todoTxtProm]

  $lastProm done \
    [promise::lambda {ignore} { clearfields }] \
    [promise::lambda {msg err_dict} {
      tk_messageBox -title "Error" -message $msg
    }]
}