File Coverage

blib/lib/FIX/Lite.pm
Criterion Covered Total %
statement 27 419 6.4
branch 0 264 0.0
condition 0 69 0.0
subroutine 9 45 20.0
pod 11 33 33.3
total 47 830 5.6


line stmt bran cond sub pod time code
1             package FIX::Lite;
2              
3 1     1   14147 use vars qw($VERSION @ISA);
  1         2  
  1         57  
4 1     1   5 use warnings;
  1         2  
  1         26  
5 1     1   5 use strict;
  1         4  
  1         19  
6              
7 1     1   457 use IO::Socket;
  1         18077  
  1         4  
8 1     1   714 use POSIX qw(strftime);
  1         4320  
  1         5  
9             #use Net::Cmd;
10 1     1   1470 use FIX::Lite::Dictionary;
  1         2  
  1         22  
11 1     1   357 use IO::Select;
  1         1066  
  1         38  
12 1     1   400 use Time::HiRes qw(gettimeofday);
  1         1357  
  1         6  
13 1     1   132 use Carp qw( croak );
  1         2  
  1         3667  
14              
15             #@ISA = qw(Net::Cmd IO::Socket::INET);
16             @ISA = qw(IO::Socket::INET);
17             $VERSION = "0.06";
18              
19             my $fixDict;
20             my $MsgSeqNum = 0;
21             my %fieldDefaults = (
22             EncryptMethod => 0,
23             HeartBtInt => 30,
24             );
25             my $sel;
26              
27             sub new {
28 0     0 1   my $class = shift;
29 0   0       my $type = ref($class) || $class;
30 0           my %arg = @_;
31 0           my $obj;
32 0           print "----\n";
33 0 0 0       if (defined $arg{Feed} && $arg{Feed}) {
34             my $self = {
35             Host => defined $arg{Host} ? $arg{Host} : '0.0.0.0',
36             Port => defined $arg{Port} ? $arg{Port} : '5201',
37             Timeout => defined $arg{Timeout} ? $arg{Timeout} : 60,
38             Listen => defined $arg{ListenQueueSize} ? $arg{ListenQueueSize} : 64,
39 0 0 0       Feed => $arg{Feed} || 0
    0          
    0          
    0          
40             };
41 0           $obj = bless $self, $class;
42             } else {
43             $obj = $type->SUPER::new(
44             PeerHost => defined $arg{Host} ? $arg{Host} : '127.0.0.1',
45             PeerPort => defined $arg{Port} ? $arg{Port} : '5201',
46 0 0         Timeout => defined $arg{Timeout} ? $arg{Timeout} : 60,
    0          
    0          
47             Proto => 'tcp'
48             );
49 0           $sel = IO::Select->new( $obj );
50              
51             return undef
52 0 0         unless defined $obj;
53              
54 0           $obj->autoflush(1);
55             }
56              
57             # Initialize $fixDict
58              
59 0 0         if ( defined $arg{version} ) {
60 0           FIX::Lite::Dictionary::load( $arg{version} );
61             }
62             else {
63 0           FIX::Lite::Dictionary::load('FIX44');
64             }
65 0           $fixDict = FIX::Lite::Dictionary->new();
66              
67 0           $obj;
68             }
69              
70             sub logon {
71 0     0 1   my $self = shift;
72 0           my %arg = @_;
73              
74             # By default this is logon request which will wait for the response
75 0 0         if (! defined $arg{WaitResponse}) { $arg{WaitResponse} = 1; }
  0            
76              
77 0           $arg{ResetSeqNumFlag} = 'Y';
78 0           $MsgSeqNum=0;
79              
80 0           my $msgBody = constructMessage('Logon',\%arg);
81 0 0         print "----\nPrepared Logon FIX Message:\n".readableFix($msgBody)."\n" if ($arg{Debug});
82              
83 0           my $size = $self->send($msgBody);
84 0 0         print " Sent data of length $size\n" if ($arg{Debug});
85              
86 0 0         return unless ($arg{WaitResponse});
87              
88             # receive a response of up to 1024 characters from server
89 0           my $response = "";
90 0           $self->recv($response, 1024);
91 0 0         print "----\nReceived Logon response:\n".readableFix($response)."\n" if ($arg{Debug});
92 0           my $parsedResp;
93 0 0         $parsedResp = parseFixMessage($response) if ($response);
94 0           ${*$self}->{logon}=$parsedResp;
  0            
95 0           ${*$self}->{args}=\%arg;
  0            
96 0           return $parsedResp;
97             }
98              
99             sub request {
100 0     0 1   my $self = shift;
101 0           my %arg = @_;
102              
103             # By default this is logon request which will wait for the response
104 0 0         if (! defined $arg{WaitResponse}) { $arg{WaitResponse} = 1; }
  0            
105              
106 0   0       $arg{SenderCompID} ||= ${*$self}->{args}->{SenderCompID};
  0            
107 0   0       $arg{TargetCompID} ||= ${*$self}->{args}->{TargetCompID};
  0            
108 0 0 0       $arg{TargetSubID} ||= (${*$self}->{args}->{TargetSubID}) ? ${*$self}->{args}->{TargetSubID} : undef;
  0            
  0            
109              
110 0           my $msgBody = constructMessage($arg{MsgType},\%arg);
111 0 0         print "----\nPrepared FIX Message:\n".readableFix($msgBody)."\n" if ($arg{Debug});
112              
113 0           my $size = $self->send($msgBody);
114 0 0         print " Sent data of length $size\n" if ($arg{Debug});
115              
116 0 0         return unless ($arg{WaitResponse});
117              
118 0           my $response = "";
119              
120 0           $self->recv($response, 4096);
121              
122 0 0         print "----\nReceived response:\n".readableFix($response)."\n" if ($arg{Debug});
123 0           my $parsedResp;
124 0 0         $parsedResp = parseFixMessage($response) if ($response);
125 0           ${*$self}->{request}=$parsedResp;
  0            
126              
127 0           return $parsedResp;
128             }
129              
130             sub heartbeat {
131 0     0 1   my $self = shift;
132 0           my %arg = @_;
133              
134 0   0       $arg{SenderCompID} ||= ${*$self}->{args}->{SenderCompID};
  0            
135 0   0       $arg{TargetCompID} ||= ${*$self}->{args}->{TargetCompID};
  0            
136 0 0 0       $arg{TargetSubID} ||= (${*$self}->{args}->{TargetSubID}) ? ${*$self}->{args}->{TargetSubID} : undef;
  0            
  0            
137              
138 0           my $msgBody = constructMessage('Heartbeat',\%arg);
139 0 0         print "----\nPrepared FIX Heartbeat:\n".readableFix($msgBody)."\n" if ($arg{Debug});
140 0           my $size = $self->send($msgBody);
141 0 0         print " Sent data of length $size\n" if ($arg{Debug});
142             }
143              
144             sub listen {
145 0     0 1   my $self = shift;
146 0           my $handler = shift;
147 0           my %arg = @_;
148              
149 0   0       my $HeartBtInt = $arg{HeartBtInt} || $fieldDefaults{HeartBtInt};
150 0           my $response;
151 0           my $lastHbTime = time;
152 0           while (1) {
153 0           my @ready = $sel->can_read(0);
154 0 0         if (scalar(@ready)) {
155 0           my $sock = $ready[0];
156 0 0         if (! sysread($ready[0], $response, 4096)) {
157 0           print "recv failed :$!\n";
158 0           return 1;
159             } else {
160 0 0         print "----\nReceived FIX message:\n".readableFix($response)."\n" if ($arg{Debug});
161              
162             #Split into each single msg
163 0           for my $fixMsg ( split /8=FIX.4.4\x{01}/, $response ) { # Split on FIX version
164 0 0         next if (length($fixMsg)<=0);
165              
166 0 0         print " Splitted FIX message:\n".readableFix($fixMsg)."\n" if ($arg{Debug});
167              
168 0           my $parsedResp = parseFixMessage($fixMsg);
169              
170 0 0         if ( ! defined $parsedResp->{MsgType} ) {
    0          
    0          
171 0 0         print " Cannot parse message\n" if ($arg{Debug});
172             }
173             elsif ( $parsedResp->{MsgType} eq '0' ) {
174 0 0         print " This is heartbeat. Will not pass it to handler\n" if ($arg{Debug});
175             }
176             elsif ( $parsedResp->{MsgType} eq '1' ) {
177 0 0         my $TestReqID = (defined $parsedResp->{TestReqID})?$parsedResp->{TestReqID}:'TEST';
178 0 0         print " This is TestRequest. Will send heartbeat with TestReqID $TestReqID\n" if ($arg{Debug});
179             $self->heartbeat(
180             TestReqID => $TestReqID,
181             Debug => $arg{Debug}
182 0           );
183             }
184             else {
185 0           $handler->($parsedResp);
186             }
187              
188             }
189             }
190             }
191              
192 0 0         if ( time - $lastHbTime > $HeartBtInt ) {
193 0           $lastHbTime = time;
194 0           $self->heartbeat( Debug => $arg{Debug} );
195             }
196 0           select(undef, undef, undef, 0.002);
197              
198             }
199             }
200              
201             sub startServer {
202 0     0 1   my $self = shift;
203 0           my $msgHandler = shift;
204 0           my $periodicHandler = shift;
205 0           my %arg = @_;
206              
207 0 0         if (! $self->{Feed}) {
208 0           die "startServer method is only applicable in feed-mode"
209             }
210              
211 0 0         my $lsnSel = IO::Select->new() or die "IO::Select";
212 0 0         my $clnSel = IO::Select->new() or die "IO::Select";
213              
214             my $sock = new IO::Socket::INET (
215             LocalHost => $self->{Host},
216             LocalPort => $self->{Port},
217             Timeout => $self->{Timeout},
218             Proto => 'tcp',
219             Listen => $self->{Listen},
220 0   0       Reuse => 1
221             ) || die "cannot create socket $!\n";
222              
223 0           $lsnSel->add($sock);
224 0           print "Server waiting for client connection on $self->{Host}:$self->{Port}\n";
225              
226 0           my $lastPeriodicHandlerTime = gettimeofday;
227 0           my %sessions;
228              
229 0           while (1) {
230 0           my @ready = $lsnSel->can_read(0);
231 0 0         if (scalar(@ready)) {
232 0           my $clientSocket = $sock->accept();
233 0           print "connection from ".$clientSocket->peerhost().":".$clientSocket->peerport()."\n";
234              
235 0           $clnSel->add($clientSocket);
236             }
237              
238 0           @ready = $clnSel->can_read(0);
239 0           foreach my $socket (@ready) {
240 0 0         if (! sysread($socket, my $response, 4096)) {
241 0           print "Client has disconnected: ".$socket->peerhost().':'.$socket->peerport()."\n";
242 0           delete $sessions{delete $sessions{$socket->peerhost().':'.$socket->peerport()}};
243 0           $clnSel->remove($socket);
244 0           close($socket);
245             } else {
246 0 0         print "----\nReceived FIX message:\n".readableFix($response)."\n" if ($arg{Debug});
247              
248             #Split into each single msg
249 0           for my $fixMsg ( split /8=FIX.4.4\x{01}/, $response ) { # Split on FIX version
250 0 0         next if (length($fixMsg)<=0);
251              
252 0 0         print " Splitted FIX message:\n".readableFix($fixMsg)."\n" if ($arg{Debug});
253              
254 0           my $parsedResp = parseFixMessage($fixMsg);
255 0 0         if ( ! defined $parsedResp->{MsgType} ) {
    0          
    0          
    0          
256 0 0         print " Cannot parse message\n" if ($arg{Debug});
257             }
258             elsif ( $parsedResp->{MsgType} eq '0' ) {
259 0 0         print " This is heartbeat. Will not pass it to handler\n" if ($arg{Debug});
260             heartbeat($socket,
261             SenderCompID => $parsedResp->{TargetCompID},
262             TargetCompID => $parsedResp->{SenderCompID},
263             Debug => $arg{Debug}
264 0           );
265             }
266             elsif ( $parsedResp->{MsgType} eq '1' ) {
267 0 0         my $TestReqID = (defined $parsedResp->{TestReqID})?$parsedResp->{TestReqID}:'TEST';
268 0 0         print " This is TestRequest. Will send heartbeat with TestReqID $TestReqID\n" if ($arg{Debug});
269             heartbeat($socket,
270             TestReqID => $TestReqID,
271             SenderCompID => $parsedResp->{TargetCompID},
272             TargetCompID => $parsedResp->{SenderCompID},
273             Debug => $arg{Debug}
274 0           );
275             }
276             elsif ( getMsgByType($self, $parsedResp->{MsgType}) eq 'Logon' ) {
277 0 0         if ($parsedResp->{TargetCompID} ne $arg{SenderCompID} ) {
278 0 0         print "Received logon with invalid TargetCompID ".$parsedResp->{TargetCompID}."\n" if ($arg{Debug});
279 0           next;
280             }
281 0           $sessions{$socket->peerhost().':'.$socket->peerport()}->{TargetCompID} = $parsedResp->{SenderCompID};
282 0           $sessions{$parsedResp->{SenderCompID}} = $socket->peerhost().':'.$socket->peerport();
283 0 0         if ( $arg{AutoLogon} ) {
284 0 0         print "AutoLogon\n" if ($arg{Debug});
285             logon($socket,
286             SenderCompID => $parsedResp->{TargetCompID},
287             TargetCompID => $parsedResp->{SenderCompID},
288             TargetSubID => $parsedResp->{TargetSubID} || 'PRICE',
289             Debug => $arg{Debug},
290 0   0       WaitResponse => 0
291             );
292             } else {
293 0           my $msg = $msgHandler->($parsedResp);
294 0 0         if (defined $msg->{MsgType}) {
295             request($socket,
296             SenderCompID => $parsedResp->{TargetCompID},
297             TargetCompID => $parsedResp->{SenderCompID},
298 0           %{$msg},
299             Debug => $arg{Debug},
300 0           WaitResponse => 0
301             );
302 0 0 0       if ($msg->{MsgType} eq 'Reject' or $msg->{MsgType} eq '3') {
303 0           print "Client authorization failed: ".$socket->peerhost().':'.$socket->peerport()."\n";
304 0           delete $sessions{delete $sessions{$socket->peerhost().':'.$socket->peerport()}};
305 0           $clnSel->remove($socket);
306 0           close($socket);
307             }
308             }
309             }
310             }
311             else {
312 0           my $msg = $msgHandler->($parsedResp);
313 0 0         if (defined $msg->{MsgType}) {
314             request($socket,
315             SenderCompID => $parsedResp->{TargetCompID},
316             TargetCompID => $parsedResp->{SenderCompID},
317 0           %{$msg},
318             Debug => $arg{Debug},
319 0           WaitResponse => 0
320             );
321             }
322             }
323              
324             }
325             }
326             }
327              
328             # Trigger the periodical handler
329 0 0 0       if ( $clnSel->count() && gettimeofday - $lastPeriodicHandlerTime > $arg{Period}/1000 ) {
330 0           $lastPeriodicHandlerTime = gettimeofday;
331 0           my $MD = $periodicHandler->();
332 0 0         if ($MD) {
333 0           foreach my $client (keys %{$MD}) {
  0            
334 0 0         if (defined $sessions{$client}) {
335 0           my $socket;
336 0           foreach my $sck ($clnSel->can_write(0)) {
337 0 0         if ($sessions{$client} eq $sck->peerhost().':'.$sck->peerport()) {
338 0 0         print "Found alive socket ".$sck->peerhost().':'.$sck->peerport().' for client '.$client."\n" if ($arg{Debug});
339 0           $socket = $sck;
340 0           last;
341             }
342             }
343 0 0         if (! defined $socket) {
344 0 0         print "ERROR. Could not find writable socket for ". $client."\n" if ($arg{Debug});
345 0           next;
346             }
347              
348 0           foreach my $msg (@{$MD->{$client}}) {
  0            
349             request($socket,
350             SenderCompID => $arg{SenderCompID},
351             TargetCompID => $client,
352 0           %{$msg},
353             Debug => $arg{Debug},
354 0           WaitResponse => 0
355             )
356             }
357             } else {
358 0 0         print "Got a message for dead session $client. Dropping it.\n" if ($arg{Debug});
359 0           next;
360             }
361             }
362             }
363             }
364 0           select(undef, undef, undef, 0.002);
365             }
366             }
367              
368             sub loggedIn {
369 0     0 1   my $self = shift;
370 0 0 0       return 1 if (defined ${*$self}->{logon}->{'MsgType'} && ${*$self}->{logon}->{'MsgType'} eq getMessageType('Logon'));
  0            
  0            
371 0           return 0;
372             }
373              
374             sub lastRequest {
375 0     0 1   my $self = shift;
376 0           my $field = shift;
377 0           return getFieldDescription($field, ${*$self}->{request}->{$field});
  0            
378             }
379              
380             # This sub recursively builds group and component fields
381             sub constructField {
382 0     0 0   my $val = shift;
383 0           my $field = shift;
384 0           my @result;
385 0 0         if (! ref($val)) { # if scalar value
    0          
    0          
386 0           return getFieldNumber($field->{name})."=".getFieldValue($field->{name},$val);
387             }
388             elsif (ref($val) eq 'ARRAY') {
389 0 0         if (! isGroup($field->{name})) {
390 0           croak $field->{name}." is not a group field";
391             }
392 0           foreach my $entry (@{$val}) {
  0            
393 0           foreach my $f ( @{$field->{group}} ) {
  0            
394 0 0         if (defined $entry->{$f->{name}}) {
    0          
395 0           push @result, constructField($entry->{$f->{name}}, $f);
396             } elsif ($f->{required} eq 'Y') {
397 0           croak "ERROR: field $f->{name} is required"
398             }
399             }
400             }
401 0           unshift @result, getFieldNumber($field->{name})."=".scalar @{$val};
  0            
402             } elsif (ref($val) eq 'HASH') {
403 0 0         if (! isComponent($field->{name})) {
404 0           croak $field->{name}." is not a component field";
405             }
406 0           my @componentFields = @{getComponentFields($field->{name})};
  0            
407 0           foreach my $f ( @componentFields ) {
408 0 0         if ( defined $val->{$f->{name}} ) {
    0          
409 0           push @result, constructField($val->{$f->{name}}, $f);
410             } elsif ($f->{required} eq 'Y') {
411 0           croak "ERROR: field $f->{name} is required"
412             }
413             }
414             }
415 0           return @result;
416             }
417              
418             sub constructMessage($$) {
419 0     0 0   my $msgtype = shift;
420 0           my $arg = shift;
421 0 0         if (! $msgtype) {
422 0           die "MsgType not defined";
423             }
424              
425 0           my @fields;
426 0           undef $arg->{MsgType};
427 0           $MsgSeqNum++;
428              
429 0           my $time = strftime "%Y%m%d-%H:%M:%S.".getMilliseconds(), gmtime;
430 0           push @fields, getFieldNumber('MsgType')."=".getMessageType($msgtype);
431 0           push @fields, getFieldNumber('SendingTime')."=".$time;
432 0           push @fields, getFieldNumber('MsgSeqNum')."=".$MsgSeqNum;
433              
434 0           my @allFields = ( @{getMessageHeader()}, @{getMessageFields($msgtype)} );
  0            
  0            
435              
436 0           foreach my $field ( @allFields ) {
437 0 0 0       if ( defined $arg->{$field->{name}} ) {
    0 0        
    0 0        
      0        
      0        
      0        
438 0           push @fields, constructField($arg->{$field->{name}}, $field);
439             }
440             elsif ( $field->{required} eq 'Y' && defined $fieldDefaults{$field->{name}} ) {
441             push @fields, getFieldNumber($field->{name})."=".$fieldDefaults{$field->{name}}
442 0           }
443             elsif ( $field->{required} eq 'Y' && $field->{name} ne 'BeginString' and $field->{name} ne 'BodyLength'
444             and $field->{name} ne 'MsgType' and $field->{name} ne 'MsgSeqNum' and $field->{name} ne 'SendingTime') {
445 0 0         if ($field->{name} eq "MDReqID") {
446 0           push @fields, getFieldNumber($field->{name})."=".randomString();
447             } else {
448 0           croak "ERROR: field $field->{name} is required";
449             }
450             }
451             }
452              
453 0           my $req = join "\x01",@fields;
454 0           $req .= "\x01";
455 0           $req = getFieldNumber('BeginString')."=FIX.4.4\x01".getFieldNumber('BodyLength')."=".length($req)."\x01".$req;
456 0           my $checksum = unpack("%8C*", $req) % 256;
457 0           $checksum = sprintf( "%03d", $checksum );
458 0           $req .= getFieldNumber('CheckSum')."=$checksum\x01";
459 0           return $req."\n";
460             }
461              
462             sub getField($) {
463 0     0 0   my $f = shift;
464 0           return $fixDict->{hFields}->{$f};
465             }
466              
467             # returns 1 if given field is a group header field
468             # isGroup('NoAllocs') -> returns 1
469             # isGroup('Symbol') -> returns 0
470             sub isGroup($) {
471 0     0 0   my $f = shift;
472 0           my $ff = getField($f);
473 0 0         return defined $ff ? $ff->{type} eq 'NUMINGROUP' : 0;
474             }
475              
476             # returns true if given field is a member of the given group of given message.
477             sub isFieldInGroup($$$) {
478 0     0 0   my ( $m, $g, $f ) = @_;
479              
480 0           my $gn = getFieldName($g);
481 0 0         return 0 if ! defined $gn;
482 0 0         return 0 if ! isGroup($gn);
483              
484 0           my $msg = getGroupInMessage($m, $g);
485 0 0         return 0 if ! defined $msg;
486 0           return _isFieldInStructure($msg, $f);
487             }
488              
489             # return a ref on group of a message, this then allows us to work on the group elements.
490             # $d->getGroupInMessage('D','NoAllocs')
491             # will return a ref on the NoAllocs group allowing us to then parse it
492             #
493             # Looks recursively into groups of groups if needed.
494             sub getGroupInMessage($$) {
495 0     0 0   my ( $m, $g ) = @_;
496 0           my $s = getMessageFields($m);
497 0 0         return undef if ! defined $s;
498 0           my $gn = getFieldName($g);
499 0 0         return undef if ! defined($gn);
500              
501 0 0         return undef if ! isGroup($g);
502              
503 0           return _getGroupInStructure( $s, $gn );
504             }
505              
506             # returns true if given field is found in the structure.
507             sub _isFieldInStructure($$);
508              
509             sub _isFieldInStructure($$) {
510 0     0     my ( $m, $f ) = @_;
511 0 0 0       return 0 unless ( defined $m && defined $f );
512 0           my $fn = getFieldName($f);
513 0 0         return 0 if ! defined $fn;
514              
515 0           for my $f2 ( @{$m} ) {
  0            
516             # found the field? return 1. Beware that if the element is a component then we don't accept
517             # it as a valid field of the structure.
518 0 0 0       return 1 if ( $f2->{name} eq $fn && !defined $f2->{component} );
519              
520             # if the field is a group then scan all elements of the group
521 0 0         if ( defined $f2->{group} ) {
522 0 0         return 1 if _isFieldInStructure( $f2->{group}, $fn ) == 1;
523             }
524              
525             # if the field is a component, we need to go to the component hash and check out its
526             # composition.
527 0 0         if ( defined $f2->{component} ) {
528 0 0         return 1 if _isFieldInStructure( getComponentFields($f2->{name}), $fn ) == 1;
529             }
530             }
531 0           return 0;
532             }
533              
534             sub _getGroupInStructure($$);
535              
536             sub _getGroupInStructure($$) {
537 0     0     my ($s, $gn) = @_;
538              
539 0           my $ret;
540             # parse each field in the structure, and ....
541 0           for my $e ( @{$s} ) {
  0            
542             # we found the group name
543 0 0 0       return $e->{group} if ($e->{name} eq $gn && defined $e->{group});
544              
545             # stop at each group header
546 0 0         if (defined $e->{group}) {
547             # and research recursively
548 0           $ret = _getGroupInStructure($e->{group},$gn);
549 0 0         return $ret if defined $ret;
550             }
551              
552             # if we run into a component we need to check that out too
553 0 0         if (defined $e->{component}) {
554 0           $ret = _getGroupInStructure(getComponentFields($e->{name}), $gn);
555 0 0         return $ret if defined $ret;
556             }
557             }
558 0           undef;
559             }
560              
561              
562             sub getFieldName($) {
563 0     0 0   my $f = shift;
564 0           my $fh = getField($f);
565 0 0         return defined $fh ? $fh->{name} : undef;
566             }
567              
568             sub getTagById {
569 0     0 1   my ($self, $f) = @_;
570 0           return getFieldName($f);
571             }
572              
573             sub getFieldNumber($) {
574 0     0 0   my $f = shift;
575 0 0         return $f if ( $f =~ /^[0-9]+$/ );
576 0           my $fh = getField($f);
577 0 0         warn("getFieldNumber($f) returning undef") if !defined $fh;
578 0 0         return defined $fh ? $fh->{number} : undef;
579             }
580              
581             sub getFieldValue($$) {
582 0     0 0   my $f = shift;
583 0           my $v = shift;
584 0 0         return $v if ( $v =~ /^[0-9]+$/ );
585 0           my $fh = getField($f);
586 0 0         warn("getField($f) returning undef") if !defined $fh;
587 0 0         if ($fh->{enum}) {
588 0           foreach ( @{$fh->{enum}} ) {
  0            
589 0 0         if ($_->{description} eq $v) {
590 0           return $_->{name};
591             }
592             }
593             }
594 0           return $v;
595             }
596              
597             sub getFieldDescription($$) {
598 0     0 0   my $f = shift;
599 0           my $v = shift;
600 0           my $fh = getField($f);
601 0 0         warn("getField($f) returning undef") if !defined $fh;
602 0 0         if ($fh->{enum}) {
603 0           foreach ( @{$fh->{enum}} ) {
  0            
604 0 0         if ($_->{name} eq $v) {
605 0           return $_->{description};
606             }
607             }
608             }
609 0           return $v;
610             }
611              
612             sub getMessage($) {
613 0     0 0   my $f = shift;
614 0           return $fixDict->{hMessages}->{$f};
615             }
616              
617             sub getMessageType($) {
618 0     0 0   my $f = shift;
619 0 0         return $f if ( $f =~ /^[0-9]+$/ );
620 0           my $fh = getMessage($f);
621 0 0         warn("getMessage($f) returning undef") if !defined $fh;
622 0 0         return defined $fh ? $fh->{msgtype} : undef;
623             }
624              
625             sub getMessageName($) {
626 0     0 0   my $f = shift;
627 0           my $fh = getMessage($f);
628 0 0         warn("getMessage($f) returning undef") if !defined $fh;
629 0 0         return defined $fh ? $fh->{name} : undef;
630             }
631              
632             sub getMsgByType {
633 0     0 1   my ($self, $f) = @_;
634 0           return getMessageName($f);
635             }
636              
637             sub getMessageFields($) {
638 0     0 0   my $f = shift;
639 0           my $fh = getMessage($f);
640 0 0         warn("getMessage($f) returning undef") if !defined $fh;
641 0 0         return defined $fh ? $fh->{fields} : undef;
642             }
643              
644             sub getMessageHeader {
645 0     0 0   return $fixDict->{header};
646             }
647              
648             sub getComponent($) {
649 0     0 0   my $f = shift;
650 0           return $fixDict->{hComponents}->{$f};
651             }
652              
653             sub isComponent($) {
654 0     0 0   my $f = shift;
655 0           return defined $fixDict->{hComponents}->{$f};
656             }
657              
658             sub getComponentFields($) {
659 0     0 0   my $f = shift;
660 0           my $fh = getComponent($f);
661 0 0         warn("getComponent($f) returning undef") if !defined $fh;
662 0 0         return defined $fh ? $fh->{fields} : undef;
663             }
664              
665             sub parseFixMessage {
666 0     0 0   my $message = shift;
667 0 0         return unless defined $message;
668 0           my $parsedMsg;
669              
670 0           my @fields = split /\x01/, $message; # Split on "SOH"
671 0           _parseFixArray( \$parsedMsg, undef, undef, 0, \@fields );
672              
673 0           return $parsedMsg;
674             }
675              
676             sub _parseFixArray($$$$$);
677              
678             sub _parseFixArray($$$$$) {
679 0     0     my ( $result, $msgType, $groupTag, $iField, $fields ) = @_;
680 0           my $i = $iField;
681              
682 0           while ( $i < scalar(@$fields) ) {
683 0           my $field = $fields->[$i];
684 0           my ( $k, $v ) = ( $field =~ /^([^=]+)=(.*)$/ );
685              
686 0 0         if ( defined $$result->{$k} ) {
687 0 0         return $i if defined $groupTag;
688 0           warn("Field $k is already in hash!");
689             }
690 0 0         if ( defined $groupTag ) {
691 0 0         return $i if !isFieldInGroup( $msgType, $groupTag, $k );
692             }
693             # Store both using Tag and FieldName.
694 0           $$result->{$k} = $v;
695 0           my $fieldName = getFieldName($k);
696 0 0         if ( defined $fieldName ) {
697 0           $$result->{$fieldName} = $v;
698             } else {
699 0           warn("Haven't found field $k in dictionary");
700             }
701              
702 0 0         if ( $fieldName eq 'MsgType' ) {
    0          
703 0           $msgType = $v;
704             }
705             elsif ( isGroup($k) ) {
706 0           my @elems;
707 0           $i++;
708 0           for ( 1 .. $v ) {
709 0           my $localResult;
710 0           $i = _parseFixArray( \$localResult, $msgType, $k, $i, $fields );
711 0           push( @elems, $localResult );
712             }
713             # Store both using Tag and FieldName.
714 0           $$result->{$k} = \@elems;
715 0           $$result->{$fieldName} = \@elems;
716 0           $i--;
717             }
718 0           $i++;
719             }
720             }
721              
722             sub randomString {
723 0     0 0   my @chars = ("A".."Z", "a".."z");
724 0           my $string;
725 0           $string .= $chars[rand @chars] for 1..6;
726 0           return $string;
727             }
728              
729             sub readableFix {
730 0     0 0   my $fixMsg = shift;
731 0           $fixMsg =~ s/\x01/\|/g;
732 0           return $fixMsg;
733             }
734              
735             sub quit {
736 0     0 1   my $self = shift;
737              
738 0           $self->close;
739             }
740              
741             sub getMilliseconds {
742 0     0 0   my $time = gettimeofday;
743 0           return sprintf("%03d",int(($time-int($time))*1000));
744             }
745             1; # End of FIX::Lite
746             __END__