1#
2# crossge@crd.ge.com
3#
4
5package FrostAPI;
6
7use MIME::Base64;
8use IO::Socket;
9
10use vars qw( $frosttype $frostsocket );
11
12# globals
13$frosttype= "";
14$frostsocket= "STDOUT";
15
16
17#StartFrost( "icehouse", "vxl", "vxluser", "");
18#DefineGauge("Errors", "Errors found in build or test cases", "numeric/integer");
19#DefineGauge("Warnings", "Warnings found in build or test cases", "numeric/integer");
20#DefineGauge("TimeStarted", "Time an operation started", "text/string");
21#DefineGauge("TimeElapsed", "Elapsed time for operation", "numeric/integer");
22#DefineGauge("FileCount", "Count of files", "numeric/integer");
23
24#DefineTest("BuildLibrary", "Library build results", "Warnings", "Errors", "TimeStarted", "TimeElapsed");
25#DefineTest("BuildDirectory", "Directory build results", "Warnings", "Errors", "FileCount");
26
27#StartDefineTestGroup("vxl", "vxl");
28#AddTest("BuildLibrary");
29#EndDefineTestGroup();
30
31#StartRunTestGroup("vxl");
32#StartRunTestGroup("vxl/vnl");
33#StartRunTest("BuildDirectory");
34#RunMeasurement( "Errors", 5);
35#EndRunTest();
36#EndRunTestGroup();
37#EndRunTestGroup();
38
39#EndFrost();
40
41sub StartRunTestGroup
42  {
43    my ($name,$date)= @_;
44
45    if (!$date)
46      {
47        $date= localtime;
48      }
49
50    print $frostsocket "<TestGroupRun Name=\"$name\">\n";
51    print $frostsocket "  <StartDateTime>$date</StartDateTime>\n";
52  }
53
54sub StartRunTest
55  {
56    my ($name,$date)= @_;
57
58    if (!$date)
59      {
60        $date= localtime;
61      }
62
63    print $frostsocket "<TestRun Name=\"$name\">\n";
64    print $frostsocket "  <StartDateTime>$date</StartDateTime>\n";
65  }
66
67sub RunMeasurement
68  {
69    my ($name,$value)= @_;
70
71    print $frostsocket "<Measurement Gauge=\"$name\">\n";
72    print $frostsocket "  <Value>".$value."</Value>\n";
73    print $frostsocket "</Measurement>\n";
74  }
75
76sub RunMeasurementBase64
77  {
78    my ($name,$value)= @_;
79
80    print $frostsocket "<Measurement Gauge=\"$name\">\n";
81    print $frostsocket "  <Value Encoding=\"base64\">\n".MIME::Base64::encode($value)."\n</Value>\n";
82    print $frostsocket "</Measurement>\n";
83  }
84
85sub EndRunTest
86  {
87    my ($success)= @_;
88
89    if ( !$success)
90      {
91        $success= "t";
92      }
93    elsif ($success eq "1")
94      {
95        $success= "t";
96      }
97    elsif ($success eq "0")
98      {
99        $success= "f";
100      }
101
102    print $frostsocket "  <Passed>$success</Passed>\n";
103    print $frostsocket "</TestRun>\n";
104  }
105
106sub SetMachine
107  {
108    my ($name)= @_;
109
110    print $frostsocket "<SetMachine Name=\"$name\"/>\n";
111  }
112
113sub EndRunTestGroup
114  {
115    my ($date)= @_;
116
117    if (!$date)
118      {
119        $date= localtime;
120      }
121
122    print $frostsocket "  <EndDateTime>$date</EndDateTime>\n";
123    print $frostsocket "</TestGroupRun>\n";
124  }
125
126sub StartFrost
127  {
128    my ($host,$database,$username,$password)= @_;
129
130    if ( $host eq "FILE")
131      {
132        $frostsocket= "";
133        open( $frostsocket, ">$database");
134        $frosttype= "FILE";
135      }
136    else
137      {
138        $frostsocket = IO::Socket::INET->new( PeerAddr => $host, PeerPort => 4444, Proto => "tcp", Type => SOCK_STREAM, TimeOut => 10 )
139          or die $@;
140
141        print $frostsocket "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n";
142        print $frostsocket "<!DOCTYPE FrostImmediate SYSTEM \"http://pragmatic.crd.ge.com/blezek/xml/FrostImmediate.dtd\">\n";
143        print $frostsocket "<FrostImmediate Database=\"$database\" Server=\"$host\" Username=\"$username\" Password=\"$password\">\n\n";
144
145        StartSchema();
146      }
147  }
148
149sub EndFrost
150  {
151    if ( $frosttype eq "FILE")
152      {
153        close( $frostsocket);
154      }
155    else
156      {
157        EndSchema();
158
159        print $frostsocket "</FrostImmediate>\n";
160
161        my $in= <$frostsocket>;
162
163        if ($in!~ /<Status>true<\/Status>/i)
164          {
165            print "Error from server: $in\n";
166          }
167      }
168  }
169
170sub EndSchema
171  {
172    print $frostsocket "</Schema>\n";
173  }
174
175sub StartSchema
176  {
177    print $frostsocket "<Schema>\n";
178  }
179
180sub DefineGauge
181  {
182    my ($name,$description,$type)= @_;
183
184    print $frostsocket "<Gauge Name=\"$name\" Type=\"$type\" PartSpecific=\"f\">\n";
185    print $frostsocket "  <Description>$description</Description>\n";
186    print $frostsocket "</Gauge>\n\n";
187  }
188
189sub DefineTest
190  {
191    my ($name,$description)= @_;
192    shift;
193    shift;
194    my (@gauges)= @_;
195    my $i;
196
197    print $frostsocket "<Test Name=\"$name\">\n";
198    print $frostsocket "   <Description>$description</Description>\n";
199
200    for ($i=0; $i<= $#gauges; $i++)
201      {
202        print $frostsocket "   <Gauge Name=\"$gauges[$i]\"/>\n";
203      }
204
205    print $frostsocket "</Test>\n\n";
206  }
207
208sub DefineMachine
209  {
210    my ($name,$location,$architecture)= @_;
211
212    print $frostsocket "<Machine Name=\"$name\" Location=\"$location\" Architecture=\"$architecture\"/>\n\n";
213  }
214
215sub StartDefineTestGroup
216  {
217    my ($name,$description)=@_;
218
219    print $frostsocket "<TestGroup Name=\"$name\" Cardinality=\"1\">\n";
220    print $frostsocket "  <Description>$description</Description>\n";
221  }
222
223sub EndDefineTestGroup
224  {
225    print $frostsocket "</TestGroup>\n\n";
226  }
227
228sub AddTest
229  {
230    my ($name)= @_;
231
232    print $frostsocket "  <Test Name=\"$name\"/>\n";
233  }
234