Tk Library Source Code

Artifact [fd3ba2f269]
Login

Artifact fd3ba2f2697594ef1fb1bcb56f16fd9bd50fe7aa:

Attachment "recordTest.itcl" to ticket [1519755fff] added by momann 2006-07-10 10:41:49.
#!/usr/bin/expect --
################################################################################
# [incr] TCL Extention Calls -mgarcia 12/29/2005 10:52:10 AM
################################################################################
set dbg 0;
set sysEnv{itclVersion} [package require Itcl];
namespace import -force itcl::*
lappend auto_path "/home/comcast/module"
#create auto_mkindex for itcl object calls
auto_mkindex /home/comcast/scriptTest  *.tcl;
set catFile [exec cat /home/comcast/scriptTest/tclIndex]
set dir "/home/comcast/scriptTest/"
if {$dbg} {print "DEBUG - Procname: $procname - TCL-INDEX FILE: $catFile"}
eval "$catFile"
if {$dbg} {
	print "DEBUG - Procname: $procname - FIND-CLASSES"
	find classes
}
puts [package require struct::record]
namespace import ::struct::record::*

puts [package require ip]


itcl::class testClass {

	private variable a aaaaaaaaaaaaaaaaa;
	private variable b bbbbbbbbbbbbbbbbb;
	private variable objTest ;



	public method getAllValuesFromRecord { recordName }
	public method setLengthInObject { recordName }
	public method copsBuild2ByteLengthField { decLength }
	public method delObject {};

	constructor {} {

		set  cmd "
			record define sub {
						{reserved1 $a}
						{reserved2 $b}
					};

			record define amId {
				  {objectLength 0008}
					{sNum 02}
					{sType 01}
					{applicationType 0000}
					{applicationMgtTag 0000}
					{record sub sub1}
				};
		"; eval $cmd;


    set objTest [amId applicationManagerId]
	 	getAllValuesFromRecord $objTest;
	 	setLengthInObject $objTest

		#puts [record show values $objTest]

# 		catch {record delete record $objTest.applicationType} rtn;
# 		puts "DELETE: $objTest.sub - $rtn"
# 		puts [record show values $objTest]

    delObject

	}
}

################################################################################
body testClass::getAllValuesFromRecord { recordName } {
	set values [record show values $recordName];

	regsub -all {\{|\}} $values "" values

	foreach element $values {
		if {![regexp -- "\-" $element]} {
			append memberValueList $element
		}
	}
	puts "$memberValueList"
	return $memberValueList;
}
################################################################################
body testClass::setLengthInObject { recordName } {
  set values [getAllValuesFromRecord  $recordName];
	puts "\n\nBEFORE - $values"
  set strlen [string length $values];
	if {[expr $strlen%2]} {
		puts "ERROR - NOT DIVISABLE BY 2"
	}
	set totalBytesRepresents [expr $strlen/2];
  set totalBytesRepresentsHex [copsBuild2ByteLengthField $totalBytesRepresents];
	$recordName.objectLength =  $totalBytesRepresentsHex;
  set values [getAllValuesFromRecord  $recordName];
	puts "\n\nAFTER - $values"
	return $totalBytesRepresents;
}
################################################################################
body testClass::copsBuild2ByteLengthField { decLength } {

  set totalBytesRepresentsHex [format "%04x" $decLength]
  puts "PADDED: $totalBytesRepresentsHex"
	return $totalBytesRepresentsHex

}
################################################################################
body testClass::delObject { } {

		record delete instance $objTest.sub1.reserved1
		puts [record show values $objTest]

}


################################################################################
################################################################################
################################################################################
################################################################################
testClass tc;
puts [record show values ::testClass::applicationManagerId]
tc getAllValuesFromRecord ::testClass::applicationManagerId;
tc setLengthInObject ::testClass::applicationManagerId

set str "Maurice"
set out_ [binary format a* $str]
set new_ [binary scan $out_ H* i ]

puts "\n\n$str"
puts "CHAR-TO-HEX => $i"


set str "10000000.100"
set out_ [binary format f $str]
set new_ [binary scan $out_ H* i ]

puts "$str"
puts "DOUBLE-TO-HEX => $i"

puts [ip::normalize fec0::1]