Now 'make build' builds stand-alone Tcl script 'seguid' from src/segu…

…id-cli.tcl, which in turn sources src/*.tcl files
seguid · Apr 28, 2024 · 862677d · 862677d
1 parent 548eed5
commit 862677d
Show file tree

Hide file tree

Showing 7 changed files with 696 additions and 123 deletions.
diff --git a/Makefile b/Makefile
@@ -1,6 +1,21 @@
 SHELL=bash
 
-all: check-cli
+all: build check-cli
+
+build: seguid
+
+seguid: src/seguid-cli.tcl src/base64.tcl src/sha1.tcl src/seguid.tcl
+	while IFS= read -r line; do \
+	    if [[ "$${line}" == "source "* ]]; then \
+	        file=$$(sed 's/source \[file join [$$]script_path /src\//' <<< "$${line}" | sed 's/\]//'); \
+	        echo "## DON'T EDIT: The source of this part is $${file}"; \
+	        cat "$${file}"; \
+	        echo; \
+	    elif [[ "$${line}" != "set script_path "* ]]; then \
+	        echo "$${line}"; \
+	    fi; \
+	done < "$<" > "$@.tmp"
+	mv "$@.tmp" "$@"
 
 
 #---------------------------------------------------------------

diff --git a/seguid b/seguid
@@ -2,125 +2,7 @@
 # the next line restarts using tclsh \
 exec tclsh "$0" "$@"
 
-
-##################
-## Find ldseguid for linear or cdseguid for circular
-##################
-proc calculate_seguid {text mode form} {
-  global info
-
-  if {[regexp {(.*)\n(.*)} $text -- top bottom]} {
-    set bottom [string reverse $bottom]
-    set text "$top;$bottom"
-  } elseif {[regexp {(.*);(.*)} $text -- top bottom]} {
-  }
-  switch $mode {
-    "lss" {
-      set prefix "lsseguid="
-    }
-    "css" {
-      lassign [short_rot $text] text --
-      set prefix "csseguid="
-    }
-    "lds" {
-      if {$top > $bottom} {
-        set text "$bottom;$top"
-      } 
-      set prefix "ldseguid="
-    }
-    "cds" {
-      set prefix "cdseguid="
-      lassign [short_rot $top $bottom] t t1
-      lassign [short_rot $bottom $top] b b1
-
-      if {[string compare $t $b] < 0} {
-        set text "$t;$t1"
-      } else {
-        set text "$b;$b1"
-      }
-    }
-    "s" -
-     default {
-      set prefix "seguid="
-     }
-  }
-  if {$mode ne "s"} {
-    set base [string range [string map {+ -  / _} [::base64::encode [binary format H* [::sha1::sha1 $text]]]] 0 26]
-  } else {
-    set base [string range [::base64::encode [binary format H* [::sha1::sha1 $text]]] 0 26]
-  }
-  switch $form {
-    "short" {
-      return "[string range $base 0 5]"
-    }
-    "both" {
-      return "[string range $base 0 5] $prefix$base"
-     }
-    "long" -
-    default {
-      return "$prefix$base"
-    }
-  }
-
-}
-
-##################
-## Find the shortest rotation of a string
-##################
-proc short_rot {s {d ""}} {
-
-  set b [string reverse $d]
-  set bsf_b $b
-
-  set bsf $s ;#best so far
-  set len [string length $s]; # length of string
-  set end $len
-  append s $s; # duplicate string - makes rotations easier
-  append b $b
-
-  for {set i 1} {$i < $len} {incr i} {
-    if {[string compare [string range $s $i $end] $bsf] < 0} { 
-      set bsf [string range $s $i $end]
-      set bsf_b [string range $b $i $end]
-    } 
-    incr end
-  }
-  # return best-so-far
-    return [list $bsf [string reverse $bsf_b]]
-}
-
-
-##########
-## returns the reverse complement of the input
-##########
-proc revcom {pattern} {
-  set temp ""
-  set length [string length $pattern]
-  for {set i [expr {$length-1}]} {$i >= 0} {incr i -1} {
-    append temp [string map {A T B V C G D H G C H D K M M K N N * * R Y S S T A V B W W Y R a t b v c g d h g c h d k m m k n n r y s s t a v b w w y r} [string index $pattern $i]]
-  }
-  return $temp
-}
-
-##########
-## returns the reverse of the input
-##########
-proc rev {args} {
-  set temp ""
-  set pattern [join $args " "]
-  foreach char [split $pattern ""] {
-    set temp "$char$temp"
-  }
-  return $temp
-}
-
-##########
-## returns the complement of the input
-##########
-proc com {args} {
-   return [string map {A T B V C G D H G C H D K M M K N N * * R Y S S T A V B W W Y R a t b v c g d h g c h d k m m k n n r y s s t a v b w w y r} [join $args " "]]
-}
-
+## DON'T EDIT: The source of this part is src/base64.tcl
 ##############
 ## base64 encoding from base64 package
 ##############
@@ -273,8 +155,7 @@ proc com {args} {
 	return
     }
 
-
-
+## DON'T EDIT: The source of this part is src/sha1.tcl
 ##############
 ## sha1 hashing from tcllib
 ##############
@@ -422,6 +303,126 @@ namespace eval ::sha1 {
 	return [format %0.8x%0.8x%0.8x%0.8x%0.8x $H0 $H1 $H2 $H3 $H4]
     }
 
+## DON'T EDIT: The source of this part is src/seguid.tcl
+##################
+## Find ldseguid for linear or cdseguid for circular
+##################
+proc calculate_seguid {text mode form} {
+  global info
+
+  if {[regexp {(.*)\n(.*)} $text -- top bottom]} {
+    set bottom [string reverse $bottom]
+    set text "$top;$bottom"
+  } elseif {[regexp {(.*);(.*)} $text -- top bottom]} {
+  }
+  switch $mode {
+    "lss" {
+      set prefix "lsseguid="
+    }
+    "css" {
+      lassign [short_rot $text] text --
+      set prefix "csseguid="
+    }
+    "lds" {
+      if {$top > $bottom} {
+        set text "$bottom;$top"
+      } 
+      set prefix "ldseguid="
+    }
+    "cds" {
+      set prefix "cdseguid="
+      lassign [short_rot $top $bottom] t t1
+      lassign [short_rot $bottom $top] b b1
+
+      if {[string compare $t $b] < 0} {
+        set text "$t;$t1"
+      } else {
+        set text "$b;$b1"
+      }
+    }
+    "s" -
+     default {
+      set prefix "seguid="
+     }
+  }
+  if {$mode ne "s"} {
+    set base [string range [string map {+ -  / _} [::base64::encode [binary format H* [::sha1::sha1 $text]]]] 0 26]
+  } else {
+    set base [string range [::base64::encode [binary format H* [::sha1::sha1 $text]]] 0 26]
+  }
+  switch $form {
+    "short" {
+      return "[string range $base 0 5]"
+    }
+    "both" {
+      return "[string range $base 0 5] $prefix$base"
+     }
+    "long" -
+    default {
+      return "$prefix$base"
+    }
+  }
+
+}
+
+##################
+## Find the shortest rotation of a string
+##################
+proc short_rot {s {d ""}} {
+
+  set b [string reverse $d]
+  set bsf_b $b
+
+  set bsf $s ;#best so far
+  set len [string length $s]; # length of string
+  set end $len
+  append s $s; # duplicate string - makes rotations easier
+  append b $b
+
+  for {set i 1} {$i < $len} {incr i} {
+    if {[string compare [string range $s $i $end] $bsf] < 0} { 
+      set bsf [string range $s $i $end]
+      set bsf_b [string range $b $i $end]
+    } 
+    incr end
+  }
+  # return best-so-far
+    return [list $bsf [string reverse $bsf_b]]
+}
+
+
+##########
+## returns the reverse complement of the input
+##########
+proc revcom {pattern} {
+  set temp ""
+  set length [string length $pattern]
+  for {set i [expr {$length-1}]} {$i >= 0} {incr i -1} {
+    append temp [string map {A T B V C G D H G C H D K M M K N N * * R Y S S T A V B W W Y R a t b v c g d h g c h d k m m k n n r y s s t a v b w w y r} [string index $pattern $i]]
+  }
+  return $temp
+}
+
+##########
+## returns the reverse of the input
+##########
+proc rev {args} {
+  set temp ""
+  set pattern [join $args " "]
+  foreach char [split $pattern ""] {
+    set temp "$char$temp"
+  }
+  return $temp
+}
+
+##########
+## returns the complement of the input
+##########
+proc com {args} {
+   return [string map {A T B V C G D H G C H D K M M K N N * * R Y S S T A V B W W Y R a t b v c g d h g c h d k m m k n n r y s s t a v b w w y r} [join $args " "]]
+}
+
+
 proc sputs {args} {
     puts stdout "$args"
 }
@@ -481,6 +482,8 @@ proc validate {text alphabet} {
   return "ok"
 }
 
+
+
 ##################
 ## Main
 ##################

diff --git a/seguid-tests b/seguid-tests