Overview
| SHA1 Hash: | 2b9c6df430776725bde3d45e0bdbbcb3c1f29548 |
|---|---|
| Date: | 2008-02-19 18:05:51 |
| User: | mjanssen |
| Comment: | tclfossil: initial directory structure and package split up |
| Timelines: | ancestors | descendants | both | tclfossil-1 |
| Other Links: | files | ZIP archive | manifest |
Tags And Properties
- bgcolor=#d0c0ff inherited from [abbdb0e8c9]
- branch=tclfossil-1 inherited from [abbdb0e8c9]
- sym-tclfossil-1 inherited from [abbdb0e8c9]
Changes
[hide diffs]Deleted tools/tclfossil/clone.tcl version [0462e3e7ea]
Deleted tools/tclfossil/lib/tf_db.tcl version [a0e7b78210]
Added tools/tclfossil/lib/vc/fossil/blob-1.0.tm version [bbd6f28e03]
@@ -1,1 +1,52 @@
+## -*- tcl -*-
+# # ## ### ##### ######## ############# #####################
+## Copyright (c) 2008 Mark Janssen.
+#
+# This software is licensed as described in the file LICENSE, which
+# you should have received as part of this distribution.
+#
+# This software consists of voluntary contributions made by many
+# individuals. For exact contribution history, see the revision
+# history and logs, available at http://fossil-scm.hwaci.com/fossil
+# # ## ### ##### ######## ############# #####################
+
+## Commands for creating and managing fossil blobs.
+
+# # ## ### ##### ######## ############# #####################
+## Requirements
+
+package require Tcl 8.5 ; # Required runtime.
+package require sqlite3 ; # Fossil database access
+package require snit ; # OO system.
+package require zlib
+
+package provide vc::fossil::blob 1.0
+
+# # ## ### ##### ######## ############# #####################
+##
+
+namespace eval ::vc::fossil {
+ namespace export blob
+ snit::type blob {
+ option -data ""
+
+ constructor {args} {
+ $self configurelist $args
+ }
+
+ method compress {} {
+ set data [$self cget -data]
+ set n [string length $data]
+ set data [zlib compress $data 9]
+ set header [binary format I $n]
+ return $header$data
+ }
+
+ method decompress {} {
+ set data [$self cget -data]
+ binary scan $data I length
+ return [zlib decompress [string range $data 4 end] $length ]
+ }
+ }
+}
Added tools/tclfossil/lib/vc/fossil/cmd-1.0.tm version [0e21eeca20]
@@ -1,1 +1,43 @@
+## -*- tcl -*-
+# # ## ### ##### ######## ############# #####################
+## Copyright (c) 2008 Mark Janssen.
+#
+# This software is licensed as described in the file LICENSE, which
+# you should have received as part of this distribution.
+#
+# This software consists of voluntary contributions made by many
+# individuals. For exact contribution history, see the revision
+# history and logs, available at http://fossil-scm.hwaci.com/fossil
+# # ## ### ##### ######## ############# #####################
+
+## Fossil subcommand managment.
+
+# # ## ### ##### ######## ############# #####################
+## Requirements
+
+package require Tcl 8.5 ; # Required runtime.
+package require sqlite3 ; # Fossil database access
+package require snit ; # OO system.
+
+
+package provide vc::fossil::cmd 1.0
+
+# # ## ### ##### ######## ############# #####################
+##
+
+namespace eval ::vc::fossil {
+ namespace export cmd
+ snit::type cmd {
+ typevariable commands ""
+
+ typemethod add {command} {
+ lappend commands $command
+
+ }
+
+ typemethod list {} {
+ return $commands
+ }
+ }
+}
Added tools/tclfossil/lib/vc/fossil/cmd/clone-1.0.tm version [fdf07a0fb7]
@@ -1,1 +1,82 @@
+## -*- tcl -*-
+# # ## ### ##### ######## ############# #####################
+## Copyright (c) 2008 Mark Janssen.
+#
+# This software is licensed as described in the file LICENSE, which
+# you should have received as part of this distribution.
+#
+# This software consists of voluntary contributions made by many
+# individuals. For exact contribution history, see the revision
+# history and logs, available at http://fossil-scm.hwaci.com/fossil
+# # ## ### ##### ######## ############# #####################
+
+
+# # ## ### ##### ######## ############# #####################
+## Requirements
+
+package require Tcl 8.5 ; # Required runtime.
+package require snit ; # OO system.
+package require vc::fossil::cmd 1.0 ; # Subcommand management
+package require vc::fossil::blob 1.0
+
+package provide vc::fossil::cmd::clone 1.0
+
+# # ## ### ##### ######## ############# #####################
+## Imports
+
+namespace import ::vc::fossil::blob
+
+
+# # ## ### ##### ######## ############# #####################
+##
+
+vc::fossil::cmd add clone
+
+namespace eval ::vc::fossil::cmd {
+ proc clone {args} {
+ if {[ui argc] != 4} {
+ ui usage "FILE-OR-URL NEW-REPOSITORY"
+ }
+
+ set local_file [lindex [ui argv] 3]
+ if {[file exists $local_file]} {
+ ui panic "file already exists: $local_file"
+ }
+ puts "cloning: $args"
+ package require http
+ package require sha1
+ package require autoproxy
+
+ autoproxy::init
+ puts [autoproxy::configure]
+
+ proc login_card {userid password message} {
+ # calculates the login card for the specific user for this msg
+
+ set nonce [sha1::sha1 -hex $message]
+ set signature [sha1::sha1 -hex $nonce$password]
+ return "login $userid $nonce $signature\n"
+ }
+
+ proc http_req {url user password message} {
+ set login_card [login_card $user $password $message]
+ blob blob_a -data $login_card$message
+ set message [blob_a compress]
+ blob_a destroy
+ return [http::geturl $url/xfer -binary 1 -query $message -type application/x-fossil]
+ }
+
+
+ set tok [http_req http://www.fossil-scm.org/fossil MJanssen {} clone\n]
+ http::wait $tok
+ set zip_body [http::data $tok]
+ blob blob_a -data $zip_body
+ set body [blob_a decompress]
+ blob_a destroy
+ set lines [split $body \n]
+ puts $body
+ puts "Received:\t[string length $body] ([string length $zip_body]) bytes,\t[llength $lines] messages"
+
+ }
+}
Added tools/tclfossil/lib/vc/fossil/db-1.0.tm version [a0e7b78210]
@@ -1,1 +1,19 @@
+package require Tcl 8.5
+package require sqlite3
+package require snit
+
+snit::type ::vc::fossil::db {
+ variable db
+ method open_repository {{name {}}} {
+ sqlite3 db1 c:/src/fossil.fsl
+ set db db1
+ }
+ method revlist {} {
+ $db eval {select uuid from blob}
+ }
+}
+
+vc::fossil::db create fossildb
+fossildb open_repository
+puts [fossildb revlist]
Added tools/tclfossil/lib/vc/fossil/ui-1.0.tm version [ab205caa27]
@@ -1,1 +1,77 @@
+## -*- tcl -*-
+# # ## ### ##### ######## ############# #####################
+## Copyright (c) 2008 Mark Janssen.
+#
+# This software is licensed as described in the file LICENSE, which
+# you should have received as part of this distribution.
+#
+# This software consists of voluntary contributions made by many
+# individuals. For exact contribution history, see the revision
+# history and logs, available at http://fossil-scm.hwaci.com/fossil
+# # ## ### ##### ######## ############# #####################
+
+## Command line user interface for tclfossil.
+
+# # ## ### ##### ######## ############# #####################
+## Requirements
+
+package require Tcl 8.5 ; # Required runtime.
+package require snit ; # OO system.
+package require vc::fossil::cmd::clone 1.0 ; # Clone command
+
+package provide vc::fossil::ui 1.0
+
+# # ## ### ##### ######## ############# #####################
+##
+
+namespace eval ::vc::fossil {
+ snit::type ui {
+ typevariable argv
+ typevariable argc
+ typevariable command
+ typevariable fSqlTrace
+ typevariable fUser
+
+ typemethod run {args} {
+
+ # TODO parse options
+ set argv $args
+ set argc [llength $args]
+
+ if {$argc < 2} {
+ ui usage "COMMAND ..."
+ }
+
+ # TODO better command searching so prefixes work
+ set command [lindex $argv 1]
+ set commands [vc::fossil::cmd list]
+
+ if {[lsearch $commands $command] < 0} {
+ puts "unknown command: $command"
+ puts {use "help" for more information}
+ exit 1
+ }
+ vc::fossil::cmd::$command {*}[lrange $argv 1 end]
+ return
+ }
+
+ typemethod usage {str} {
+ puts stderr "Usage: [lrange $argv 0 1] $str"
+ exit 1
+ }
+
+ typemethod panic {str} {
+ puts stderr "[lindex $argv 0]: $str"
+ exit 1
+ }
+
+
+ typemethod argc {} {
+ return $argc
+ }
+ typemethod argv {} {
+ return $argv
+ }
+ }
+}
Added tools/tclfossil/tf version [28a95507a5]
@@ -1,1 +1,32 @@
+#!/bin/sh
+## -*- tcl -*- \
+exec tclsh "$0" ${1+"$@"}
+
+# # ## ### ##### ######## ############# #####################
+## Copyright (c) 2008 Mark Janssen.
+#
+# This software is licensed as described in the file LICENSE, which
+# you should have received as part of this distribution.
+#
+# This software consists of voluntary contributions made by many
+# individuals. For exact contribution history, see the revision
+# history and logs, available at http://fossil-scm.hwaci.com/fossil
+# # ## ### ##### ######## ############# #####################
+
+## Command line application wrapped around the import packages.
+
+# # ## ### ##### ######## ############# #####################
+## Requirements, extended package management for local packages.
+
+::tcl::tm::path add [file normalize [file join [file dirname [info script]] lib]]
+
+package require Tcl 8.5 ; # Required runtime.
+package require vc::fossil::ui ; # Main functionality.
+
+# # ## ### ##### ######## ############# #####################
+## Execution
+
+vc::fossil::ui run $::argv0 {*}$argv
+exit 0
+# # ## ### ##### ######## ############# #####################