#!/usr/local/bin/tclsh
#
# $Id: cvs-stable.tcl,v 1.1.3.2 2005/09/09 21:40:50 andy Exp $
#
# For each filename given on the command line, lists all files which
# do NOT have the stable-staging cvs tag on the current working
# revision of the file.
#
# by Andrew Piskorski <atp@piskorski.com>, originally 2001/05/14


proc empty_string_p { query_string } {
   return [string equal $query_string ""]
}


set TAG_STAGING    {stable-staging}
set TAG_PRODUCTION {stable-production}

# Default value, override with -r switch:
set stable_tag $TAG_STAGING


set USAGE "
Usage:
  $argv0 \[-h\] {-n|-t|-u} \[-p\] \[-r TAG\] \[ file ... \]
Description:

  Does one of three things, all related to the 'one branch' method of
  using CVS version control - see also:
    \"http://www.piskorski.com/cvs-conventions.html\"
  You MUST specify either the -n, -t, or -u switch, as the FIRST
  option after the command name.  Here's what each does:

  -n : Displays all files which do NOT have the tag TAG on the current
  working revision of the file.  Use to answer the question, which
  files on Dev are committed but NOT yet marked as ready to go to
  Staging?

  -t : Tags files as '$TAG_STAGING' or '$TAG_PRODUCTION', ready to go
  to Staging or Production, respectively.  Also keeps a short rolling
  history of where the cvs tag was before, to help you in case you
  mess up.

  -u : Runs a cvs update command which updates the files in a working
  updates files to the version currently tagged with '$TAG_STAGING'
  (or '$TAG_PRODUCTION').  It also sets that as a sticky tag, as is
  normal for the 'cvs update -r TAG' command.

Options:
  -h     : Display this help message.
  -r TAG : Use cvs tag TAG.  Defaults to '$TAG_STAGING'.
  -p     : Use the Production default tag '$TAG_PRODUCTION' rather than
           '$TAG_STAGING'.

  Note:  The command-line option parsing currently isn't very
  sophisticated so keep the options in the exact same order as shown
  in the pattern above, and do NOT try to do unix-style combined flags
  like '-htp'.
"

# Don't have a built-in getopts like with sh, so do a little special
# case checking of command-line switches:

# TODO: Get a real Tcl version of getopts.  This ad-hoc stuff sucks.

proc arglist_helper {argv index default_tag} {
   if { [string equal [lindex $argv $index] {-r}] } {
      set tag   [lindex $argv [expr {$index +1}]]
      set files [lrange $argv [expr {$index +2}] end]
   } else {
      set tag {}
      set files [lrange $argv $index end]
   }
   if { [empty_string_p $tag] } {
      set tag $default_tag
   }
   return [list $tag $files]
}

set do_what {}
if { [regexp {^-+[hH?]} [lindex $argv 0]] } {
   puts $USAGE
   return

} elseif { [string equal [lindex $argv 0] {-n}] } {
   set do_what {not_tag}
} elseif { [string equal [lindex $argv 0] {-t}] } {
   set do_what {tag}
} elseif { [string equal [lindex $argv 0] {-u}] } {
   set do_what {update}
} else {
   puts $USAGE
   return
}
set index 1

if { [string equal [lindex $argv $index] {-p}] } {
   set stable_tag $TAG_PRODUCTION
   incr index
}

foreach [list stable_tag cvs_files] [arglist_helper $argv $index $stable_tag] { break }


# This proc depends on the fact that the cvs output looks like this:
#
#   $ cvs stat -v first-file last-file
#   ===================================================================
#   File: first-file
#   
#   [ ... ]
#   
#   ===================================================================
#   File: last-file
#   
#   [ ... ]

# Basic idea: We run the cvs stat -v command once using the passed in
# command-line arguments.  We save the output of the command to a temp
# file.  Then we loop throug the file getting a line one at a time.
# When we see the first "======" line, we know that's the start of the
# cvs stat output for the file 1.  When we see the next big "======"
# line, we know that's the end of the output for file 1 and the start
# for file 2.  Plus there is no trailing "======" line, so we take
# that into account.

proc cvs_not_tag {stable_tag cvs_files} {
   set out {}
   append out "Tag:  ${stable_tag}\n\n"
   set io_id [open "|cvs stat -v [join $cvs_files { }]" r]

   set cvs_in {}
   set found_divider_p 0
   while { [gets $io_id line] >= 0 } {
      append cvs_in "${line}\n"

      if { [regexp {^======} $line] } {
         if { $found_divider_p } {
            set block [cvs_check_block $cvs_in $stable_tag]
            if { ![empty_string_p $block] } {
               append out $block "\n\n"
            }

            set cvs_in {}
         }
         set found_divider_p 1
      }
   }
   set block [cvs_check_block $cvs_in $stable_tag]
   if { ![empty_string_p $block] } {
      append out $block "\n\n"
   }

   if { [catch {close $io_id} cvs_std_error] } {
      append out "Standard Error output from CVS:\n${cvs_std_error}"
   }

   return $out
}

proc cvs_check_block {cvs_in stable_tag} {
   # Takes a string of cvs stat -v text output for a SINGLE file, and
   # checks where the stable-staging tag is.

   foreach v [list tagged_rev working_rev \
                  row_file_name row_working_rev row_repos_rev] {
      set $v {}
   }

   regexp -line {File: ([^ ]+)} $cvs_in match file_name
   regexp -line {Working revision:[^0-9.]*([0-9.]+)} $cvs_in match working_rev
   regexp -line "${stable_tag}\[^0-9.\]*\\(revision: (\[0-9.]\+)" $cvs_in match tagged_rev

   #puts "********\n${cvs_in}"
   #puts "revs:  $working_rev $tagged_rev    $file_name"

   if { ![empty_string_p $tagged_rev] && ![empty_string_p $working_rev] } {
      set current_p [string equal $working_rev $tagged_rev]
   } else {
      set current_p 0
   }

   if { ! $current_p } {
      regexp -line {^[^a-zA-Z]*File:.*$} $cvs_in row_file_name
      regexp -line {^[^a-zA-Z]*Working revision:.*$} $cvs_in row_working_rev
      regexp -line {^[^a-zA-Z]*Repository revision:.*$} $cvs_in row_repos_rev

      if { ! [regexp -line "^\[^a-zA-Z\]*${stable_tag}\[^0-9.\]*\\(revision:.*\$" $cvs_in row_tagged_rev] } {
         set row_tagged_rev ""
      }

      # Say whether working rev is higher (newer) or lower (older)
      # than tagged rev:
      set working_rev_is_than_tagged {}
      foreach w [split $working_rev .] t [split $tagged_rev .] {
         if { [expr {$w == $t}] } {
            continue
         } elseif { [empty_string_p $w] } {
            set working_rev_is_than_tagged {<}
         } elseif { [empty_string_p $t] } {
            set working_rev_is_than_tagged {>}
         } elseif { [expr {$w > $t}] } {
            set working_rev_is_than_tagged {>}
         } elseif { [expr {$w < $t}] } {
            set working_rev_is_than_tagged {<}
         }

         if { ![empty_string_p $working_rev_is_than_tagged] } {
            break
         }
      }
      set rev_mesg "   Working revision  '$working_rev_is_than_tagged'  tagged revision."

      return [string trim "${row_file_name}\n${row_working_rev}\n${row_repos_rev}\n${row_tagged_rev}\n${rev_mesg}"]
   } else {
      return {}
   }
}


proc cvs_tag_stable {stable_tag cvs_files} {
   set out {}
   append out "Tag:  ${stable_tag}\n"
   set cmd_1 "cvs tag -F -r ${stable_tag}-1 ${stable_tag}-2 $cvs_files"
   set cmd_2 "cvs tag -F -r ${stable_tag}   ${stable_tag}-1 $cvs_files"
   set cmd_3 "cvs tag -F $stable_tag $cvs_files"

   foreach cmd [list $cmd_1 $cmd_2 $cmd_3] {
      append out "\ncvs command: '$cmd'"
      append out "\n-------------------" "\n"
      if { [catch {
         append out [eval "exec $cmd"]
      } err] } {
         append out "${err}" "\n"
      }
   }

   return $out
}

proc cvs_update_stable {stable_tag cvs_files} {
   set out {}
   append out "Tag:  ${stable_tag}\n"
   set cmd "cvs update -d -r $stable_tag $cvs_files"

   append out "\ncvs command: '$cmd'"
   append out "\n-------------------" "\n"
   if { [catch {
      append out [eval "exec $cmd"]
   } err] } {
      append out "${err}" "\n"
   }

   return $out
}


switch -exact -- $do_what {
   not_tag {
      puts [cvs_not_tag $stable_tag $cvs_files]
   }
   tag {
      puts [cvs_tag_stable $stable_tag $cvs_files]
   }
   update {
      puts [cvs_update_stable $stable_tag $cvs_files]
   }
}