|
1
|
<th1> |
|
2
|
proc doSomeTclSetup {} { |
|
3
|
# |
|
4
|
# NOTE: Copy repository file name to the Tcl interpreter. This is |
|
5
|
# done first (once) because it will be necessary for almost |
|
6
|
# everything else later on. |
|
7
|
# |
|
8
|
tclInvoke set repository [repository] |
|
9
|
|
|
10
|
# |
|
11
|
# NOTE: Create some procedures in the Tcl interpreter to perform |
|
12
|
# useful operations. This could also do things like load |
|
13
|
# packages, etc. |
|
14
|
# |
|
15
|
tclEval { |
|
16
|
# |
|
17
|
# NOTE: Returns an [exec] command for Fossil, using the provided |
|
18
|
# sub-command and arguments, suitable for use with [eval] |
|
19
|
# or [catch]. |
|
20
|
# |
|
21
|
proc getFossilCommand { repository user args } { |
|
22
|
global env |
|
23
|
|
|
24
|
lappend result exec [info nameofexecutable] |
|
25
|
|
|
26
|
if {[info exists env(GATEWAY_INTERFACE)]} then { |
|
27
|
# |
|
28
|
# NOTE: This option is required when calling |
|
29
|
# out to the Fossil executable from a |
|
30
|
# CGI process. |
|
31
|
# |
|
32
|
lappend result -nocgi |
|
33
|
} |
|
34
|
|
|
35
|
eval lappend result $args |
|
36
|
|
|
37
|
if {[string length $repository] > 0} then { |
|
38
|
# |
|
39
|
# NOTE: This is almost certainly required |
|
40
|
# when calling out to the Fossil |
|
41
|
# executable on the server because |
|
42
|
# there is almost never an open |
|
43
|
# checkout. |
|
44
|
# |
|
45
|
lappend result -R $repository |
|
46
|
} |
|
47
|
|
|
48
|
if {[string length $user] > 0} then { |
|
49
|
lappend result -U $user |
|
50
|
} |
|
51
|
|
|
52
|
# th1Eval [list html $result<br>] |
|
53
|
|
|
54
|
return $result |
|
55
|
} |
|
56
|
} |
|
57
|
} |
|
58
|
|
|
59
|
proc getLatestTrunkCheckIn {} { |
|
60
|
tclEval { |
|
61
|
# |
|
62
|
# NOTE: Get the unique Id of the latest check-in on trunk. |
|
63
|
# |
|
64
|
return [lindex [regexp -line -inline -nocase -- \ |
|
65
|
{^(?:uuid|hash):\s+([0-9A-F]{40}) } [eval [getFossilCommand \ |
|
66
|
$repository "" info trunk]]] end] |
|
67
|
} |
|
68
|
} |
|
69
|
|
|
70
|
proc theSumOfAllFiles { id } { |
|
71
|
# |
|
72
|
# NOTE: Copy check-in Id value to the Tcl interpreter. |
|
73
|
# |
|
74
|
tclInvoke set id $id |
|
75
|
|
|
76
|
tclEval { |
|
77
|
set count 0 |
|
78
|
|
|
79
|
foreach line [split [eval [getFossilCommand \ |
|
80
|
$repository "" artifact $id]] \n] { |
|
81
|
# |
|
82
|
# NOTE: Is this an "F" (file) card? |
|
83
|
# |
|
84
|
if {[string range $line 0 1] eq "F "} then { |
|
85
|
incr count |
|
86
|
} |
|
87
|
} |
|
88
|
|
|
89
|
return $count |
|
90
|
} |
|
91
|
} |
|
92
|
|
|
93
|
doSomeTclSetup; # perform some extra setup for the Tcl interpreter. |
|
94
|
|
|
95
|
set checkIn [getLatestTrunkCheckIn] |
|
96
|
set totalFiles [theSumOfAllFiles $checkIn] |
|
97
|
</th1> |
|
98
|
|
|
99
|
<br /> |
|
100
|
As of trunk check-in <th1>decorate \[$checkIn\]</th1>, this |
|
101
|
repository contains <th1>html $totalFiles</th1> files. |
|
102
|
<br /> |
|
103
|
|