Table of Contents

EventLoop
are_arrays_identical
array_to_keyed_list
calculate_ratio_of_month_left
copy_array
day_month_calculations
days_in_month
die
dollar_format
fail_exit
force_width
getargs
keyed_list_to_array
load_stanza_file
next_month_year
parse_rfc822_line
parse_rfc822_mail_address
parse_stanza_line
prompt
prompt_choices
prompt_yn
read_rfc822
read_rfc822_group
read_stanza_body
read_stanza_file
read_stanza_header
require
rfc931
save_stanza_file
spawn_child
store_stanza_field
write_rfc822
write_rfc822_group
write_stanza
xkeylget


[next] [TOC]

Command

EventLoop - an [incr tcl] class

Synopsis

EventLoop object -selectTimeout 10 -timeoutCallout {}

inherits

object make_select_list
object run
object stop
object add_trigger file command
object remove_trigger file

Description

#@package: EventLoop EventLoop
#
# Copyright (C) 1992-1996 NeoSoft.
#
# Permission to use, copy, modify, and distribute this software and its
# documentation for any purpose and without fee is hereby granted, provided
# that the above copyright notice appear in all copies.  NeoSoft makes no 
# representations about the suitability of this software for any purpose.
# It is provided "as is" without express or implied warranty.
### 
#
#
# $Id: neolib.html,v 1.1.1.1 1999/03/31 20:34:36 damon Exp $
#
# Incr Tcl Event Loop class.
#
# For use with Extended Tcl, but not Wishx, which has its
# own mechanism (addinput).  A functionally identical EventLoop 
# class for Wishx would be really nice.
#




    constructor {config} {
    }

    destructor {
    }

    # make a list containing the file handles of all the sockets,
    # pipes, fifos, etc, we are waiting for data from.
    method make_select_list {} {
	set readSelectList [array names readSelectorCallouts]
    }

    #
    # run an event loop, waiting for input from any of the file handles
    # we've been told to look at, and calling the timeoutCallout,
    # if it exists, every selectTimeout floating point seconds.
    #
    method run {} {
	set running 1
	make_select_list

	while {$running} {

	    set selectResult  [select $readSelectList "" "" $selectTimeout]
	    set readReadyList [lindex $selectResult 0]

            if {$readReadyList == ""} {
		eval $timeoutCallout
	    }
	    foreach readReady $readReadyList {
		set command $readSelectorCallouts($readReady)
		if {[gets $readReady line] < 0} {
		    close $readReady
		    continue
		}
		[lindex $command 0] [lindex $command 1] $line
	    }
	}
    }

    # stop the event loop after the event that invoked this method
    # finishes
    method stop {} {
	set running 0
    }

    # add a trigger whereby data on the specified filehandle causes
    # command to execute
    method add_trigger {file command} {
	set readSelectorCallouts($file) $command
    }

    # remove the trigger on the specified filehandle
    method remove_trigger {file} {
	unset readSelectorCallouts($file)
    }

    # true while the event loop is running
    protected running 0

    # array where keys are file handles and data are commands to execute
    protected readSelectorCallouts

    # list of file handles to select on as a list
    protected readSelectList

    # timeout interval, default 10 seconds
    public selectTimeout 10

    # timeout callout code, default is to do nothing
    public timeoutCallout ""

[next] [prev] [TOC]

Command

are_arrays_identical

Synopsis

are_arrays_identical array1Name array2Name

Description

#
# Return true if two arrays are identical, else false.
#



    upvar $array1Name array1 $array2Name array2

    # if they don't have the same number of elements, no way are they identical
    if {[array size array1] != [array size array2]} {return 0}

    # For each element in the first array,
    #    If the element isn't in the second array, they're not identical.
    #    If the contents of both elements aren't the same, the arrays aren't
    #      identical.
    # If you get to the end, the arrays are identical.

    set searchId [array startsearch array1]
    while {[array anymore array1 $searchId]} {
	set elementName [array nextelement array1 $searchId]
	if ![info exists array2($elementName)] {return 0}
	if {$array1($elementName) != $array2($elementName)} {
	    return 0
	}
    }
    array donesearch sourceArray $searchId
    return 1

[next] [prev] [TOC]

Command

array_to_keyed_list

Synopsis

array_to_keyed_list arrayName

Description

#
# Convert an array to a keyed list.  Only handles "flat" keyed lists.
#



    upvar $arrayName array

    set list ""
    foreach key [array names array] {
        keylset list $key $array($key)
    }
    return $list

[next] [prev] [TOC]

Command

calculate_ratio_of_month_left

Synopsis

calculate_ratio_of_month_left month day year

Description

#
# What is the floating point ratio of days left from the specified
# day, in the specified month, of the specified year?
#



    set daysInThisMonth [days_in_month $month $year]

    set daysLeftInThisMonth [expr $daysInThisMonth - $day + 1]
    return [expr $daysLeftInThisMonth.0/$daysInThisMonth]

[next] [prev] [TOC]

Command

copy_array

Synopsis

copy_array sourceArrayName destArrayName

Description

#@package: array_utilities copy_array array_to_keyed_list keyed_list_to_array are_arrays_identical
#
# Array Utility Functions
#
#
# $Id: neolib.html,v 1.1.1.1 1999/03/31 20:34:36 damon Exp $
#
# Copy the contents of one array into another.
#



    upvar $sourceArrayName sourceArray $destArrayName destArray

    set searchId [array startsearch sourceArray]
    while {[array anymore sourceArray $searchId]} {
	set elementName [array nextelement sourceArray $searchId]
	set destArray($elementName) sourceArray($elementName)
    }
    array donesearch sourceArray $searchId

[next] [prev] [TOC]

Command

day_month_calculations

Synopsis

day_month_calculations clock thisMonthVar thisYearVar daysInThisMonthVar daysLeftInThisMonthVar ratioLeftVar nextMonthMonthVar nextMonthYearVar

Description

#
# Given a integer-seconds-since-1970 and the names of some variables,
# return in those variables the month number (1-12), the year number,
# the days in the current month (28-31), the days left in this month,
# the ratio of days left in the month, the month number (1-12) of
# the month following this date's month, and the year number of the month
# following this date's month.
#



    upvar $thisMonthVar thismonth
    upvar $thisYearVar thisyear
    upvar $daysInThisMonthVar daysInThisMonth
    upvar $daysLeftInThisMonthVar daysLeftInThisMonth
    upvar $ratioLeftVar ratioLeft
    upvar $nextMonthMonthVar nextmonth
    upvar $nextMonthYearVar nextyear

    lassign [fmtclock $clock "%m %d %Y"] thismonth thisday thisyear
    scan $thismonth %d thismonth
    scan $thisday %d thisday

    next_month_year $thismonth $thisyear nextmonth nextyear
    set monthStartSeconds [convertclock $nextmonth/1/$nextyear]

    set daysInThisMonth [days_in_month $thismonth $thisyear]

    set daysLeftInThisMonth [expr $daysInThisMonth - $thisday + 1]
    set ratioLeft [expr $daysLeftInThisMonth.0/$daysInThisMonth]

[next] [prev] [TOC]

Command

days_in_month

Synopsis

days_in_month month year

Description

#
# How many days are in the specified month, in the specified year?
#



    switch $month {
	1 {return 31}
	2 {
	    if {$year % 4 == 0} {
		return 29
	    } else {
		return 28
	    }
	}
	3 {return 31}
	4 {return 30}
	5 {return 31}
	6 {return 30}
	7 {return 31}
	8 {return 31}
	9 {return 30}
       10 {return 31}
       11 {return 30}
       12 {return 31}
    }
    error "month out of range ($month)"

[next] [prev] [TOC]

Command

die

Synopsis

die message {exitStatus 1}

Description



    puts stderr $message
    exit $exitStatus

[next] [prev] [TOC]

Command

dollar_format

Synopsis

dollar_format number

Description

#
# format a number and return it as a dollar field (two digits precision
# to the right of the decimal place.)
#



    return [format "%.2f" $number]

[next] [prev] [TOC]

Command

fail_exit

Synopsis

fail_exit command {exitStatus 1}

Description

#@package: catchers fail_exit die
#
# Copyright (C) 1992-1996 NeoSoft.
#
# Permission to use, copy, modify, and distribute this software and its
# documentation for any purpose and without fee is hereby granted, provided
# that the above copyright notice appear in all copies.  NeoSoft makes no 
# representations about the suitability of this software for any purpose.
# It is provided "as is" without express or implied warranty.
# $Id: neolib.html,v 1.1.1.1 1999/03/31 20:34:36 damon Exp $
#
#  fail_exit command [exitStatus]
#      execute command and, if it gets a tcl error, write the program
#      name and error message to stderr and exit the program.
#      If exit is taken, exit status is 1 unless specified.
#



    if {[catch {uplevel $command} result] == 1} {
        global argv0
	puts stderr "$argv0: $result"
	exit $exitStatus
    }

[next] [prev] [TOC]

Command

force_width

Synopsis

force_width string width

Description

#@package: neo_misc_procs force_width dollar_format
#
# Copyright (C) 1992-1996 NeoSoft.
#
# Permission to use, copy, modify, and distribute this software and its
# documentation for any purpose and without fee is hereby granted, provided
# that the above copyright notice appear in all copies.  NeoSoft makes no 
# representations about the suitability of this software for any purpose.
# It is provided "as is" without express or implied warranty.
#
# return a string forceed to a specified width either by padding, if it
# is too short, or by truncation, if it is too long.
#



    return [crange [format "%-${width}s" $string] 0 $width-1]

[next] [prev] [TOC]

Command

getargs

Synopsis

getargs arrayName argList

Description

#@package: getargs getargs
#
# Copyright (C) 1992-1996 NeoSoft.
#
# Permission to use, copy, modify, and distribute this software and its
# documentation for any purpose and without fee is hereby granted, provided
# that the above copyright notice appear in all copies.  NeoSoft makes no 
# representations about the suitability of this software for any purpose.
# It is provided "as is" without express or implied warranty.
# $Id: neolib.html,v 1.1.1.1 1999/03/31 20:34:36 damon Exp $
#
# parses an arglist of key-value pairs where the key starts with a
# dash and the value must always be present.
#
# we want to use it in this manner 
#
# dialog_box -bitmap @/bitmap -text "hi there" -suppress 1
#
# in dialog_box,
#
# proc dialog_box {blah blah blah args} {}
comment {#     getargs $args parms}
comment {# }
#
# and have the parms array set as follows:
#
# bitmap=@/bitmap
# text="hi there"
# suppress="1"
#
#



    upvar $arrayName array

    set length [llength $argList]
    if {$length % 2 != 0} {
        error "list of key-value pairs is missing a value"
    }
    for {set i 0} {$i < $length} {incr i 2} {
        set key [lindex $argList $i]
        if {[cindex $key 0] != "-"} {
            error "key '$key' of key-value pairs doesn't start with '-'"
        }
        set array([crange $key 1 end]) [lindex $argList [expr $i + 1]]
    }

[next] [prev] [TOC]

Command

keyed_list_to_array

Synopsis

keyed_list_to_array list arrayName

Description

#
# Convert a keyed list to an array.  Only handles "flat" keyed lists.
#



    upvar $arrayName array

    foreach key [keylkeys list] {
        set array($key) [keylget list $key]
    }

[next] [prev] [TOC]

Command

load_stanza_file

Synopsis

load_stanza_file fileName arrayVarName

Description

#
# load_stanza_file and save_stanza_file work differently from the
# above.  these guys read the stanza bodies into keyed lists indexed
# by the header names through an array
#
#
#
# load_stanza_file
#
# load in a stanza file where the stanza headers becomne array names
# and the bodies become keyed lists
#
# slight optimization hack was to append up the list instead of
# keylsetting it, don't know if that really helped or not
#



    upvar $arrayVarName stanzaArray
    
    set fp [open $fileName]
    while 1 {
        if {[read_stanza_header $fp section] == 0} {
            close $fp
            return
        }
        set keyedList ""
        while {[gets $fp line] >= 0} {
            if ![parse_stanza_line $line key value] break
            lappend keyedList "$key $value"
        }
        set stanzaArray($section) $keyedList
    }

[next] [prev] [TOC]

Command

next_month_year

Synopsis

next_month_year currentMonth currentYear nextMonthVar nextMonthYearVar

Description

#@package: timedate-utility next_month_year days_in_month calculate_ratio_of_month_left day_month_calculations
#
# Copyright (C) 1992-1996 NeoSoft.
#
# Permission to use, copy, modify, and distribute this software and its
# documentation for any purpose and without fee is hereby granted, provided
# that the above copyright notice appear in all copies.  NeoSoft makes no 
# representations about the suitability of this software for any purpose.
# It is provided "as is" without express or implied warranty.
#
# Time/Date utility functions
#
# $Id: neolib.html,v 1.1.1.1 1999/03/31 20:34:36 damon Exp $
#
#
#
# given the current month and year and the names of two variables,
# put in the first the numeric month following this one and in the
# second, the year of that month.
#



    upvar $nextMonthVar nextMonth
    upvar $nextMonthYearVar nextMonthYear

    set nextMonthYear $currentYear
    set nextMonth $currentMonth

    if {$nextMonth < 12} {
	incr nextMonth
    } else {
	set nextMonth 1
	incr nextMonthYear
    }

[next] [prev] [TOC]

Command

parse_rfc822_line

Synopsis

parse_rfc822_line line keyVar valueVar

Description

#@package: rfc822 parse_rfc822_line read_rfc822_group read_rfc822 write_rfc822_group write_rfc822 parse_rfc822_mail_address
#
# Copyright (C) 1992-1996 NeoSoft.
#
# Permission to use, copy, modify, and distribute this software and its
# documentation for any purpose and without fee is hereby granted, provided
# that the above copyright notice appear in all copies.  NeoSoft makes no 
# representations about the suitability of this software for any purpose.
# It is provided "as is" without express or implied warranty.
#
# we really need to rewrite this in C and be truly RFC-822 compliant,
# it's a pig.
#
# RFC noncompliance issues: Line order isn't maintained, multiple
# lines with the same key aren't supported.
# There may be stuff in there about quoting, too.
#
#
# parse_rfc822_line
#
# Given a line of RFC822 header text and the names of two variables,
# parse the key into one and the value into the other.
#
# Warning, can't do multiple line messages unless line argument contains
# all necessary lines.
#
#



    upvar $keyVar key
    upvar $valueVar value

    set key ""
    set colon [string first ":" $line]
    if {$colon < 2} {
	return 0
    }
    set key [string trim [string range $line 0 [expr $colon-1]]]
    set value [string trim [string range $line [expr $colon+1] end]]
    return 1

[next] [prev] [TOC]

Command

parse_rfc822_mail_address

Synopsis

parse_rfc822_mail_address line emailAddressVar fullNameVar

Description

#
# parse_rfc822_mail_address
#
# take the body of an address line and convert it into a name and address
#



    upvar $emailAddressVar emailAddress
    upvar $fullNameVar fullName
 
    # in the form "Ellyn Jones <ellyn@NeoSoft.com>"?
    if {[regexp {(.*) <(.*)>} $line dummy fullName emailAddress]} {
        set emailAddress [string tolower $emailAddress]
        return
    }   
    
    # in the form "ellyn@NeoSoft.com (Ellyn Jones)"?
    if {[regexp {(.*) \((.*)\)} $line dummy emailAddress fullName]} {
        set emailAddress [string tolower $emailAddress]
        return
    }
 
    # hmm, take whatever's there as the reply address 
    set emailAddress [string tolower $line]
    set fullName $emailAddress

[next] [prev] [TOC]

Command

parse_stanza_line

Synopsis

parse_stanza_line line keyVarName dataVarName

Description

# parse_stanza_line
#
# given a line and the names of key and value variables, put
# the key and value in variables and return 1, else 0 or error
#



    upvar $keyVarName key
    upvar $dataVarName value
    
    if {[string trim $line] == ""} {return 0}
    if {[cindex $line 0] == "\["} {
        error "called parse_stanza_line with a header line '$line'"
    }

    set separator [string first "=" $line]
    if {$separator < 2} {
        error "malformed stanza line '$line'"
    }
    set key [string trim [string range $line 0 [expr $separator-1]]]
    set value [string trim [string range $line [expr $separator+1] end]]
    return 1

[next] [prev] [TOC]

Command

prompt

Synopsis

prompt promptText varName {default ""}

Description

#@package: prompts prompt prompt_yn prompt_choices
#
# Copyright (C) 1992-1996 NeoSoft.
#
# Permission to use, copy, modify, and distribute this software and its
# documentation for any purpose and without fee is hereby granted, provided
# that the above copyright notice appear in all copies.  NeoSoft makes no 
# representations about the suitability of this software for any purpose.
# It is provided "as is" without express or implied warranty.
#
# prompt - given some prompt text, the name of a variable, and a possible
# default value, emit the text, read a line into the named variable and,
# if an empty string is entered, use the default instead, and set the
# result into the named variable.
#



    upvar $varName line
    set line ""

    if {$default == ""} {
        puts stdout "$promptText: " nonewline
    } else {
        puts stdout "$promptText \[$default\]: " nonewline
    }
    if {[gets stdin line] < 0} return
    if {$line == ""} {
        set line $default
    }

[next] [prev] [TOC]

Command

prompt_choices

Synopsis

prompt_choices promptText choiceList {default ""}

Description

#
# prompt_choices - emit some prompt text and get a selection of one
# of a number of responses.
#



    while 1 {
	set nChoices 0
	echo $promptText
	foreach element $choiceList {
	    echo "  $nChoices $element"
	    incr nChoices
	}
	prompt "Your selection?" input $default
	if {([catch {set choice [lindex $choiceList $input]} result] == 1) ||  ($choice == "" && $default != "")} {
	    echo "Please enter a number between 1 and $nChoices."
	    continue
	}
	if {$choice == ""} {return $default}
	return $choice
    }

[next] [prev] [TOC]

Command

prompt_yn

Synopsis

prompt_yn promptText {default ""}

Description

#
# prompt_yn - emit some prompt text and get a yes or no response,
# returning 1 for yes and 0 for no.
#



    while 1 {
        if {$default == ""} {
            puts stdout "$promptText (y/n): " nonewline
        } else {
            puts stdout "$promptText (y/n) \[$default\]: " nonewline
        }
        if {[gets stdin line] < 0} return
        if {$line == ""} {set line $default}
        set char [string tolower [cindex $line 0]]
        if {$char == "n"} {return 0}
        if {$char == "y"} {return 1}
        echo "Please answer y)es or n)o"
    }

[next] [prev] [TOC]

Command

read_rfc822

Synopsis

read_rfc822 fileName arrayVarName

Description

#
# read_rfc822
#
# load in a file containing one rfc822 group
#



    upvar $arrayVarName rfcArray
    
    set fp [open $fileName]
    read_rfc822_group $fp rfcArray
    close $fp

[next] [prev] [TOC]

Command

read_rfc822_group

Synopsis

read_rfc822_group fp arrayVarName

Description

#
# read_rfc822_group
#
# given a filehandle and an array name, read the file, pulling key-value
# pairs and putting them into the named array, returning when an empty
# line or EOF is found
#
#



    upvar $arrayVarName rfcArray
    set success 0
    
    while {[gets $fp line] >= 0} {
        if {$line == ""} break

	set firstchar [cindex $line 0]
	if {$firstchar == " " || $firstchar == "\t"} {
	    if {$key != ""} {
	        append rfcArray($key) "\n$line"
	    } else {
		puts stderr "rfc-822 line starts with whitespace with no prior key '$line'"
	    }
	    continue
	}
        set key ""
        set colon [string first ":" $line]
        if {$colon < 2} {
            puts stderr "malformed rfc-822 line '$line'"
        }
        set success 1
        set key [string trim [string range $line 0 [expr $colon-1]]]
        set value [string trim [string range $line [expr $colon+1] end]]
        set rfcArray($key) $value
    }
    return $success

[next] [prev] [TOC]

Command

read_stanza_body

Synopsis

read_stanza_body fp arrayVarName

Description

# read_stanza_body
#
# given a filehandle and an array name, read the file, pulling key-value
# pairs and putting them into the named array, returning when an empty
# line or EOF is found
#
#



    upvar $arrayVarName stanzaArray
    set success 0
    
    while {[gets $fp line] >= 0} {
        if ![parse_stanza_line $line key value] break
        set success 1
        set stanzaArray($key) $value
    }
    return $success

[next] [prev] [TOC]

Command

read_stanza_file

Synopsis

read_stanza_file fileName arrayVarPrefix {global ""}

Description



    set upLevel "2"
    if {$global != ""} {set upLevel "#0"}
    set fp [open $fileName]
    while 1 {
        if {[read_stanza_header $fp section] == 0} {
            close $fp
            return
        }
        store_stanza_field $arrayVarPrefix$section $upLevel ID $section
        while {[gets $fp line] >= 0} {
            if ![parse_stanza_line $line key value] break
            store_stanza_field $arrayVarPrefix$section $upLevel $key $value
        }
    }

[next] [prev] [TOC]

Command

read_stanza_header

Synopsis

read_stanza_header fp headerVarName

Description

#@package: stanza read_stanza_header read_stanza_body read_stanza_file load_stanza_file write_stanza save_stanza_file
#
# Copyright (C) 1992-1996 NeoSoft.
#
# Permission to use, copy, modify, and distribute this software and its
# documentation for any purpose and without fee is hereby granted, provided
# that the above copyright notice appear in all copies.  NeoSoft makes no 
# representations about the suitability of this software for any purpose.
# It is provided "as is" without express or implied warranty.
# $Id: neolib.html,v 1.1.1.1 1999/03/31 20:34:36 damon Exp $
#
# we really need to rewrite this in C and be truly stanza compliant,
# it's kind of a pig.
#
# stanza noncompliance issues: lots
#
# seems to work, though.
#
# read_stanza_header
#
# given a filehandle and an array name, read the file, pulling key-value
# pairs and putting them into the named array, returning when an empty
# line or EOF is found
#
#



    upvar $headerVarName headerVar
    
    if {[gets $fp line] <= 0} {return 0}
    if {[string index $line 0] != "\["} {
        error "malformed stanza file - no '[' in header"
    }
    if {[cindex $line [clength $line]-1] != "]"} {
        error "malformed stanza file - no ']' in header"
    }
    set headerVar [crange $line 1 [clength $line]-2]
    return 1

[next] [prev] [TOC]

Command

require

Synopsis

require commandName

Description

#@package: libmanager require
#
# Copyright (C) 1992-1996 NeoSoft.
#
# Permission to use, copy, modify, and distribute this software and its
# documentation for any purpose and without fee is hereby granted, provided
# that the above copyright notice appear in all copies.  NeoSoft makes no 
# representations about the suitability of this software for any purpose.
# It is provided "as is" without express or implied warranty.
#
# This little thing will force the autoloading of the specified command,
# without actually executing it.
#




    # already loaded?
    if {[info commands $commandName] != ""} return

    # get it
    if ![auto_load $commandName] {
	error "couldn't auto_load $commandName"
    }

[next] [prev] [TOC]

Command

rfc931

Synopsis

rfc931 fp resultVar

Description

#@package: rfc931 rfc931
#
# Copyright (C) 1992-1996 NeoSoft.
#
# Permission to use, copy, modify, and distribute this software and its
# documentation for any purpose and without fee is hereby granted, provided
# that the above copyright notice appear in all copies.  NeoSoft makes no 
# representations about the suitability of this software for any purpose.
# It is provided "as is" without express or implied warranty.
#
# Perform an rfc931 authentication request on the socket bound to the
# specified filehandle.  Returns username and hostname if found,
# username and ip if no hostname is found, or an empty string if
# the remote site isn't running an rfc931 authentication server.
#
# $Id: neolib.html,v 1.1.1.1 1999/03/31 20:34:36 damon Exp $
#



    upvar $resultVar result

    lassign [fstat $fp localhost] localAddr localPort
    lassign [fstat $fp remotehost] remoteAddr remotePort

    if {[catch {lassign [server_open -myip $localAddr $remoteAddr ident] readIdent writeIdent} result] == 1} {
	global errorCode errorInfo
	if {[lindex $errorCode 1] == "ECONNREFUSED"} {return 0}
	error $result $errorInfo $errorCode
    }
    set remoteName [server_info address_name $remoteAddr]

    puts $writeIdent "$remotePort,$localPort\r"
    close $writeIdent

    if {[gets $readIdent authLine] < 0} {
	close $readIdent
	set result "read failed"
	return 0
    }

    set result $authLine
    if {[scan $authLine {%u , %u : USERID :%*[^:]:%s} remote local user] != 3} {
	close $readIdent
	return 0
    }

    if {$remote != $remotePort || $local != $localPort} {
	close $readIdent
	set result "ports didn't match"
	return 0
    }

    if {[cindex $user end] == "\r"} {
	set user [crange $user 0 end-1]
    }
    set result $user@$remoteName
    close $readIdent
    return 1

[next] [prev] [TOC]

Command

save_stanza_file

Synopsis

save_stanza_file fileName arrayVarPrefix {global ""}

Description

#
# save_stanza_file
#
# save a stanza file where the stanza headers come from an array's keys
# and the bodies are from keyed lists indexed by the keys
#



    set upVar "1"
    if {$global != ""} {set upVar "#0"}
    set varPrefixLength [string length $arrayVarPrefix]

    set fp [open $fileName w]
    foreach arrayVarName [uplevel $upVar "info vars $arrayVarPrefix*"] {
        upvar $upVar $arrayVarName stanzaArray

        set setName [string range $arrayVarName $varPrefixLength end]
    
	puts $fp "\[$setName\]"
        foreach key [array names stanzaArray] {
            if {[cindex $key 0] != "_"} {
	        puts $fp "$key=$stanzaArray($key)"
	    }
	}
        puts $fp ""
    }
    close $fp

[next] [prev] [TOC]

Command

spawn_child

Synopsis

spawn_child command stdinPipeVarName stdoutPipeVarName stderrPipeVarName

Description

#@package: spawn_child spawn_child
#
# Copyright (C) 1992-1996 NeoSoft.
#
# Permission to use, copy, modify, and distribute this software and its
# documentation for any purpose and without fee is hereby granted, provided
# that the above copyright notice appear in all copies.  NeoSoft makes no 
# representations about the suitability of this software for any purpose.
# It is provided "as is" without express or implied warranty.
#
# spawn_child - fork a tcl subprocess, redirecting standard input,
# output and error to pipes.
#
# Three variable names are specified.
# Within those variables spawn_child writes the filehandles of pipes that
# correspond to standard input, standard output and standard error of
# the subprocess.
#




    upvar $stdinPipeVarName stdinPipe  $stdoutPipeVarName stdoutPipe  $stderrPipeVarName stderrPipe

    pipe childStdinPipe stdinPipe
    pipe stdoutPipe childStdoutPipe
    pipe stderrPipe childStderrPipe

    if {[set childPid [fork]] == 0} {

        dup $childStdinPipe stdin
        close $childStdinPipe

        dup $childStdoutPipe stdout
        close $childStdoutPipe

        dup $childStderrPipe stderr
        close $childStderrPipe

        eval "execl $command"
    }
    return $childPid

[next] [prev] [TOC]

Command

store_stanza_field

Synopsis

store_stanza_field varName upLevel key value

Description



    upvar $upLevel $varName myArray

    set myArray($key) $value

[next] [prev] [TOC]

Command

write_rfc822

Synopsis

write_rfc822 fileName arrayVarName

Description

#
# write_rfc822
#
# write out a file containing one rfc822 group
#



    upvar $arrayVarName rfcArray
    
    set fp [open $fileName w]
    write_rfc822_group $fp rfcArray
    close $fp

[next] [prev] [TOC]

Command

write_rfc822_group

Synopsis

write_rfc822_group fp arrayVarName

Description

#
# write_rfc822_group
#
# given a filehandle and an array name, write the file, pulling key-value
# pairs from the named array, returning when finished.
#
#



    upvar $arrayVarName rfcArray 

    foreach name [array names rfcArray] {
        set data [split $rfcArray($name) "\n"]
        puts $fp "$name: [lindex $data 0]"
        foreach additionalLine [lrange $data 1 end] {
            puts $fp "\t$additionalLine"
        }
    }
    puts $fp ""

[next] [prev] [TOC]

Command

write_stanza

Synopsis

write_stanza fp headerName arrayVarName

Description

#
# write_stanza
#
# given a filehandle, an array name containing stanza elements
# and a stanza header name, write it out
#
#



    upvar $arrayVarName stanzaArray
    
    puts $fp "\[$headerName\]"
    foreach name [array names stanzaArray] {
        puts $fp "$name=$rfcArray($name)"
    }
    puts $fp ""

[prev] [TOC]

Command

xkeylget

Synopsis

xkeylget keylistName args

Description

#
#
# Copyright (C) 1992-1996 NeoSoft.
#
# Permission to use, copy, modify, and distribute this software and its
# documentation for any purpose and without fee is hereby granted, provided
# that the above copyright notice appear in all copies.  NeoSoft makes no 
# representations about the suitability of this software for any purpose.
# It is provided "as is" without express or implied warranty.
#
# $Id: neolib.html,v 1.1.1.1 1999/03/31 20:34:36 damon Exp $
#
#@package: xkeylget xkeylget



    upvar $keylistName keylist
    if {[llength $args] % 2 != 0} {error "odd number of key-varname pairs"}
    while {$args != ""} {
        set elementName [lindex $args 0]
        set varName [lindex $args 1]
        set args [lrange $args 2 end]
        keylget keylist $elementName value
        uplevel set $varName [list $value]
    }