852
853
854
855
856
857
858
859
860
861
862
863
864
865
|
#
# NOTE: Otherwise, return the system default, which is "anonymous"
# packages only (i.e. those without any owners).
#
return [list]
}
#
# NOTE: This procedure verifies that the specified value is indeed a valid
# server identifier. The serverId argument is the value to verify.
# This procedure may raise script errors.
#
# <internal>
proc verifyServerId { serverId } {
|
>
>
>
>
>
>
>
>
>
>
>
>
|
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
|
#
# NOTE: Otherwise, return the system default, which is "anonymous"
# packages only (i.e. those without any owners).
#
return [list]
}
#
# NOTE: This procedure verifies the language specified by the caller. The
# language argument must be an empty string -OR- the literal string
# "Eagle" or "Tcl". This procedure may raise script errors.
#
# <internal>
proc verifyMetadataLanguage { language } {
if {[lsearch -exact [list "" Tcl Eagle] $language] == -1} then {
error "unsupported metadata language"
}
}
#
# NOTE: This procedure verifies that the specified value is indeed a valid
# server identifier. The serverId argument is the value to verify.
# This procedure may raise script errors.
#
# <internal>
proc verifyServerId { serverId } {
|
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
|
#
# NOTE: Grab the language for the package script. It must be an empty
# string, "Tcl", or "Eagle". If it is an empty string, then the
# current language will be assumed (but not by this procedure).
#
set language [getDictionaryValue $result Language]
if {[lsearch -exact [list "" Tcl Eagle] $language] == -1} then {
error "unsupported language"
}
#
# NOTE: Grab the package script. If it is an empty string, then the
# package cannot be loaded and there is nothing to do. In that
# case, just raise an error.
#
set script [getDictionaryValue $result Script]
|
<
|
<
|
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
|
#
# NOTE: Grab the language for the package script. It must be an empty
# string, "Tcl", or "Eagle". If it is an empty string, then the
# current language will be assumed (but not by this procedure).
#
set language [getDictionaryValue $result Language]
verifyMetadataLanguage $language
#
# NOTE: Grab the package script. If it is an empty string, then the
# package cannot be loaded and there is nothing to do. In that
# case, just raise an error.
#
set script [getDictionaryValue $result Script]
|
1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
1629
|
# NOTE: The target language is Tcl; therefore, a bit of
# special handling is needed here.
#
{%tclMustBeReady%}; return [tcl eval [tcl master] [list \
uplevel #0 $script(inner)]]
}
default {
error "unsupported language"
}
}
} finally {
#
# NOTE: Perform any necessary cleanup steps.
#
eval ${%cleanup%}
|
|
|
1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
1636
1637
1638
1639
|
# NOTE: The target language is Tcl; therefore, a bit of
# special handling is needed here.
#
{%tclMustBeReady%}; return [tcl eval [tcl master] [list \
uplevel #0 $script(inner)]]
}
default {
error "unsupported metadata language"
}
}
} finally {
#
# NOTE: Perform any necessary cleanup steps.
#
eval ${%cleanup%}
|
1783
1784
1785
1786
1787
1788
1789
1790
1791
1792
1793
1794
1795
1796
1797
|
tclMustBeReady; return [tcl eval [tcl master] [list \
uplevel #0 $script(inner)]]
} else {
return [uplevel #0 $script(inner)]
}
}
default {
error "unsupported language"
}
}
}
} else {
error "unsupported script certificate"
}
}
|
|
|
1793
1794
1795
1796
1797
1798
1799
1800
1801
1802
1803
1804
1805
1806
1807
|
tclMustBeReady; return [tcl eval [tcl master] [list \
uplevel #0 $script(inner)]]
} else {
return [uplevel #0 $script(inner)]
}
}
default {
error "unsupported metadata language"
}
}
}
} else {
error "unsupported script certificate"
}
}
|