I work on a tcl-based automated testing tool at
the Secure Design Center in the Schaumburg Campus of Motorola
and develop the hardware encryption modules (which
get tested by the tool).

Initiated the [Chicago Area Tcl Users Group].

Send me email at mailto:sheila@feafaroth.org if you're
interested.

----

I am trying to cut and past code, so I'll practice here first.

drat! the comments don't work.

#------------------------------------------------------------------------------
# Namespace        : ::message_queue
# Author           : Sheila Herndon
# Creation Date    : 2003/04/14
#--------------------------------- PURPOSE ------------------------------------
#
# Provides a simple set of enqueueing and dequeueing wrappers for the 
# struct::queue for a related set of queues containing messages in
# message_queue(<label>).
#
#--------------------------------- SYNOPSIS -----------------------------------
# CAUTIONS:
#    people might have old versions of tcl, so I made wrappers
#
#------------------------- GLOBAL DATA DESCRIPTION ----------------------------
#
#     message_queue(<label>) the queue that will be created if we have struct support
#     good_tcl a boolean to test for struct support
#     bad_tcl_queue a stand in for when we do not have struct support
#
#--------------------------------- REVISIONS ----------------------------------
# Date        Name          Description
# ----------  ------------  ---------------------------------------------------

package provide message_queue 1.0

namespace eval message_queue {
    variable good_tcl 1
    variable bad_tcl_queue

    # initialize our namespace. if we have the appropriate
    # support from tcl, then load up the struct package which
    # provides native queue support, otherwise set the variable
    # to tell us we don't have it.
    if {[catch {package require Tcl 8.2} err]} {
	if {[regexp {version conflict} $err]} {
	    set good_tcl 0
	}
    } else {
	package require struct
    }
}

# create the queue.
# the struct library creates a new procedure
# the other method creates a namespace array variable
proc ::message_queue::create {label} {
    variable good_tcl
    variable bad_tcl_queue
    if {$good_tcl} {
	struct::queue message_queue($label)
    } else {
	set bad_tcl_queue($label) ""
    }
}

proc ::message_queue::exists {label} {
    variable good_tcl
    variable bad_tcl_queue
    if {$good_tcl} {
	return [string equal [info commands message_queue($label)] \
		message_queue($label)]
    } else {
	return [info exist bad_tcl_queue($label)]
    }
}

# put a message into the queue
# if it doesn't exist, create it
proc ::message_queue::enqueue {label message} {
    variable good_tcl
    variable bad_tcl_queue

    # if it doesn't exist, create it
    if {![exists $label]} {
	create $label
    }    

    if {$good_tcl} {
	message_queue($label) put $message	 
    } else {
	lappend bad_tcl_queue($label) $message
    }
}

# remove a message from the queue and return it.
# if the queue becomes emptied due to this, destroy it.
proc ::message_queue::dequeue {label} {
    variable good_tcl    
    variable bad_tcl_queue    
    if {$good_tcl} {
	set message [message_queue($label) get]
    } else {
	set message [lindex $bad_tcl_queue($label) 0]
	set bad_tcl_queue($label) [lreplace $bad_tcl_queue($label) 0 0]
    }
    # if the queue is empty, destroy it.
    if {[size $label] == 0} {
	destroy $label
    }
    return $message
}

# delete the queue.
proc ::message_queue::destroy {label} {
    variable good_tcl    
    variable bad_tcl_queue
    if {$good_tcl} {
	message_queue($label) destroy
    } else {
	unset bad_tcl_queue($label)
    }
}

# return the size of the queue.
proc ::message_queue::size {label} {
    variable good_tcl    
    variable bad_tcl_queue

    # if it doesn't exist, return -1
    if {![exists $label]} {
	return -1
    }    
    
    if {$good_tcl} {
	return [message_queue($label) size]
    } else {
    	return [llength $bad_tcl_queue($label)]
    }
}


# a few test calls for queue commands
proc unit_test_message_queue {} {

    package require message_queue

    Log "Creating message queue for foo [message_queue::create foo]"
    Log "Check existence ([message_queue::exists foo])"    
    Log "Checking size ([expr [message_queue::size foo] == 0])"

    set i 0
    foreach msg {a a b} {
	puts "Adding $msg to message queue ([message_queue::enqueue foo $msg])\
		Checking size ([expr [message_queue::size foo] == [incr i]])"
    }

    foreach msg {a a b} size {2 1 -1} {
	Log "Get message ([string eq [message_queue::dequeue foo] $msg])\
		Checking size ([expr [message_queue::size foo] == $size])"
    }    

    Log "Check inexistence ([expr [message_queue::exists foo] == 0])"
}



----
[Category Person]