Developer

From tTiMe
Jump to: navigation, search

Contents

Data Base Format (tTiMe Format)

tTiMe database format is a plain text file with ;-separated:

1;;Alvheim, Atle;HA;Fana IL;;87000;
2;;Alvheim, Martin;HA;Fana IL;;24717;
...
246;X;Vikingstad, Anne Kari;DA;IL Gular;E,0,S,18:45:43,F,19:30:16,D,12.12.2007,G,19:30:25,H,2245,O,37,N,37,M,37,L,1,K,0:00,R,3|DA|44:33|0:00|0:00,J,DA|12:00|0,C,DA|12:00;88826;44:33;102;1:41;1:41;155;2:20;4:01;156;1:50;5:51;142;1:31;7:22;143;2:55;10:17;176;0:53;11:10;146;2:17;13:27;147;1:33;15:00;148;0:52;15:52;149;1:36;17:28;150;1:59;19:27;151;3:01;22:28;152;4:42;27:10;153;1:58;29:08;154;4:45;33:53;174;9:00;42:53;175;1:09;44:02;167;0:31;44:33
...

The fields:

  • 0 : Unique runner number
  • 1 : Runner entry status:
    • ' ': not active / entered
    • X : entered
    • P : entered, group or pair, when several runners run with same ECard.
    • A : first entered, but then resigned or no show
  • 2 : Name
  • 3 : Class
  • 4 : Club
  • 5 : Option for additional internal information:
    • A : Eventor ID's: event ID, organization ID, club ID, runner ID, class ID
    • B : alternative ECard
    • C : chase start: class|chase start time
    • D : date at MTR
    • E : runner time status / error code
    • F : real time at finish control
    • G : real time at MTR
    • H : MTR serial number
    • J : ranking: class|ranking|order & points or time
    • K : ranking: rank / after time
    • L : course
    • M : incoming order at MTR
    • N : logfile order
    • O : incoming order at finish control
    • P : placement: total, 1. splittime, 1. total split, 2. splittime, ...
    • R : ranking: race|class|time|after time|rank / after time
    • S : real time at start
    • T : Micr-O penalties
    • U : start time
    • V : seed
    • W : random number
    • Z : register state/fee
  • 6 : ECard
  • 7 : Time
  • Splittimes (optional):
    • 8  : 1. control;
    • 9  : 1. split time;
    • 10 : 1. total time;
    • 11 : 2. control;
    • ...

Reading Option Field

Simple perl function to retrieve option values (field 5):

sub getOptVal {
    my ( $set, $opt ) = @_;
    return undef unless defined($set);
    while ( $set =~ /(?:^|\,)([A-Z])(.*?)(?=\,[A-Z]\,|\,[A-Z]$|$)/g ) {
        my $a = $1;
        my $b = $2;
        if ( $opt eq $a ) {
            $b =~ s/^\,//;
            return $b;
        }
    }
    return undef;
}


Installing Perl on Windows

ppm install http://www.bribes.org/perl/ppm/Tk.ppd
ppm install http://www.bribes.org/perl/ppm/Win32-SerialPort.ppd
ppm install http://www.bribes.org/perl/ppm64/Tk.ppd
ppm install http://www.bribes.org/perl/ppm64/Win32-SerialPort.ppd
  • ActiveState Perl 5.10 or later requires explicit install of Tk

More information:

Installing Perl on Linux

export PERL5LIB=$HOME/perl/lib/perl5:$HOME/perl/lib/perl5/site_perl

More perl modules can be found at CPAN.

Eventor XML

  • set RaceId as EventId for XML results

Eventor status

  • 1 : Ansökt
  • 2 : Godkänd av distriktet
  • 3 : Godkänd av SOFT
  • 4 : Skapad (för tävlingar utan ansökningsprocedur)
  • 5 : Anmälan öppnad
  • 6 : Anmälan pausad
  • 7 : Anmälan stängd
  • 8 : Pågående
  • 9 : Genomfört
  • 10 : Inställt
  • 11 : Rapporterat

I praktiken används inte 8 och 11 än.

Eventor GET & POST

use LWP::UserAgent;
use URI::https;
use LWP::Protocol::https;
use LWP::Authen::Basic;
use constant EVENTOR_API_BASE_URL => "eventor.orientering.no/api/";
sub eventorApiCallGet
{
   my ( $url , $apikey, $username, $password) = @_;
   my $ua = LWP::UserAgent->new;
   if (defined($apikey) && $apikey ne "")
   {
       $ua->default_header(ApiKey =>  $apikey);
   }
   else
   {
       $ua->default_header(Username =>  $username);
       $ua->default_header(Password =>  $password);
   }
   $ua->agent("Perlmonky");
   $ua->timeout(10);
   my $u = "https://".EVENTOR_API_BASE_URL . $url;
   my $res = $ua->get($u );
   if ( !$res->is_success() ) 
   {
       return ("", $res->status_line);
   }
   return ($res->content, "");
}
sub eventorApiCallPost
{
   my ( $url , $apikey, $username, $password, $data) = @_;
   my $ua = LWP::UserAgent->new;
   $ua->agent("Perlmonky");
   $ua->timeout(10);
   my $u = "https://".EVENTOR_API_BASE_URL . $url;
   my $res;
   if (defined($apikey) && $apikey ne "")
   {
       $res = $ua->post($u, ApiKey =>  $apikey, Content => $data);
   }
   else
   {
       $res = $ua->post($u, Username =>  $username, Password =>  $password, Content => $data);
   }
   if ( !$res->is_success() ) 
   {
       return ($res->status_line);
   }
   return ("");
}

Proper Encoding File Name with Special Characters

use Encode;
sub latin { return encode("iso-8859-1", shift);}

Reading / Writing MTR

Stand alone perl script to read/write to MTR, works under Windows and Linux.

#!/usr/bin/perl
use strict;
  
# port
my $portId = $^O eq 'MSWin32' ? 1 : 0;
$portId = shift if @ARGV && int($ARGV[0]) eq $ARGV[0]; 
my $port = $^O eq 'MSWin32' ? "COM$portId" : "/dev/ttyS$portId";

# command
my $cmd = uc(@ARGV ? shift:"ST");
my $opt = "";
if($cmd eq "SB" || $cmd eq "GB"){
    $opt = pack("V",(@ARGV ? shift:0));
}
elsif($cmd eq "SC"){
    my $year = shift;
    my $mon = shift;
    my $mday = shift;
    my $hour = shift;
    my $min = shift;
    my $sec = shift;
    $opt = pack("CCCCCC",$year,$mon,$mday,$hour,$min,$sec);
}

my $handler = openPort($port) or die "could not open port $port\n";

die "could not write " unless writePort($handler,"/".$cmd.$opt);
my ($ok,$type,$count,$size,$line,$status,$n0,$all,@rec) = readRecord($handler,3);
print "$ok,$type,$count,$size,$line,$status,$n0\n";

die "could not write " unless writePort($handler,"/ST");
($ok,$type,$count,$size,$line,$status,$n0,$all,@rec) = readRecord($handler,3);
print "$ok,$type,$count,$size,$line,$status,$n0\n";
closePort($handler);

exit;

##################################################################
sub readRecord {
##################################################################
    my ($ob,$timeout) = @_;

    my $ok = 0;
    my $type = "";
    my $count = 0;
    my $line = "";
    my $status = "";
    my $n0;
    my @rec;
    my $size = 0;
    my $all = "";
    my $t = time;

    do {
        my $byte = readPort($ob);
        if($byte>=0){
            $t = time;
            push(@rec,$byte);
            $count++;
            $ok = 1;
        }		
    }
    while((($#rec >3 && $rec[4]+4 > $count) || $#rec <= 3) && $t+$timeout > time);
    $all = join(",",@rec);
    
    my $sum = 255*4;
    foreach (1 .. 4){
        if(@rec && $rec[0] == 255){
            shift @rec;
            $count--;
        }
    }
    $size = $rec[0] if @rec;
    for my $j (0 .. $#rec-2){
        $sum += $rec[$j];
    }
    $sum %= 256;
    
    if($count < 1 && $size < 1){
        $status = "No response, check cable and/or check port.";
        $ok = 0;
    }
    elsif($size != $count){
        $status = "Could not read complete record! Read $count byte(s).";
        $ok = 0;
    }
    elsif($sum != $rec[$size-2] || $rec[$size-1] != 0){
        $status = "Check sum error!";
        $ok = 0;
    }
    else {
        $type = chr($rec[1]);	
        if($type eq 'S'){
            $status = "MTR ".($rec[2]+($rec[3]<<8)).", ".sprintf("%04d/%02d/%02d %02d:%02d:%02d",1900+$rec[4]+($rec[4]<50?100:0),$rec[5],$rec[6],$rec[7],$rec[8],$rec[9]).", battery ".($rec[12]>0?"low":"ok").", recent=".($rec[13]+($rec[14]<<8)+($rec[15]<<16)+($rec[16]<<24)).", oldest=".($rec[17]+($rec[18]<<8)+($rec[19]<<16)+($rec[20]<<24));
            my $mtrid = $rec[2]+($rec[3]<<8);
            my $timestamp = sprintf("%02d.%02d.%02d %02d:%02d:%02d.%03d",$rec[6],$rec[5],$rec[4],$rec[7],$rec[8],$rec[9],$rec[10],($rec[11]<<8));
            for my $i (0 .. 7){
                $status .= ", ".($rec[21+$i*4]+($rec[22+$i*4]<<8)+($rec[23+$i*4]<<16)+($rec[24+$i*4]<<24));
            }
            $status,".";
            $n0 = $rec[21]+($rec[22]<<8)+($rec[23]<<16)+($rec[24]<<24);
            my $m = $rec[13]+($rec[14]<<8)+($rec[15]<<16)+($rec[16]<<24);
            $n0 = $m if($m > $n0);
            $m = $rec[17]+($rec[18]<<8)+($rec[19]<<16)+($rec[20]<<24);
            $n0 = $m if($m > $n0);	    
            # "S","1019","22.04.03 23:48:07.000",000223,000001,000098,000036,000005,000004,000003,000001,000000,000000,0
            $line = "\"S\",\"$mtrid\",\"$timestamp\"";
            for my $i (0 .. 9){
                $line .= sprintf(",%06d",$rec[13+$i*4]+($rec[14+$i*4]<<8)+($rec[15+$i*4]<<16)+($rec[16+$i*4]<<24));
            }
            $line .= ",".$rec[12];
        }
        elsif($type eq 'M'){
            my $finish = 0;
            $n0 = $rec[12]+($rec[13]<<8)+($rec[14]<<16)+($rec[15]<<24);
            my $ecard = sprintf("%06d",$rec[16]+($rec[17]<<8)+($rec[18]<<16));
            my $mtrid = $rec[2]+($rec[3]<<8);
            my $timestamp = sprintf("%02d.%02d.%02d %02d:%02d:%02d.%03d",$rec[6],$rec[5],$rec[4],$rec[7],$rec[8],$rec[9],$rec[10],($rec[11]<<8));
            my @tmp =  localtime;
            my $timeactual = sprintf("%02d.%02d.%02d %02d:%02d:%02d.000",$tmp[3],$tmp[4]+1,$tmp[5]%100,$tmp[2],$tmp[1],$tmp[0]);
            $line = "\"M\",\"0\",\"$mtrid\",\"$ecard\",\"$timeactual\",\"$timestamp\",$ecard,0000,0000";
            for my $i (0 .. 49){
                my $c = $rec[22+$i*3];
                my $l = $rec[23+$i*3]+($rec[24+$i*3]<<8);
                $line .= sprintf(",%03d,%05d",$c,$l);
                $finish = $l if($i < 49 && $rec[22+$i*3+3] == 250);
            }
            $line .= sprintf(",%07d",$n0);
            $status = sprintf("%s %6d, %d:%02d",  $timestamp, $ecard,$finish/60,$finish%60);	
        }
        else {
            $status = "Was expecting a status or message record, but got type \"".$type."\".";
        }
    }
    return ($ok,$type,$count,$size,$line,$status,$n0,$all,@rec);
}

##################################################################
sub testPort {
##################################################################
    my ($port) = @_;
    my $ob;
    if($ob = openPort($port)){
        closePort($ob);
        return 1;
    }
    return 0;
}

##################################################################
sub openPort {
##################################################################
    my ($port) = @_;
    
    my $quiet;
    my $ob = undef;
    if ($^O eq 'MSWin32'){
        require Win32::SerialPort;                                                                    
        Win32::SerialPort->import;		 					               
        $ob = Win32::SerialPort->new ("\\\\.\\$port",$quiet);	
    }
    else {
        eval ' require Device::SerialPort; ';
        if(!$@){
            require Device::SerialPort;                                                                    
            Device::SerialPort->import;		 					               
            $ob = Device::SerialPort->new ("$port",$quiet);	
        }
    }
    my $ok = 0;
    
    if($ob){
        #	$ob->debug(0);
        my @baud_opt = $ob->baudrate;
        my @parity_opt = $ob->parity;
        my @data_opt = $ob->databits;
        my @stop_opt = $ob->stopbits;
        my @hshake_opt = $ob->handshake;
        
        foreach $a (@baud_opt) {
            if($a == 9600){
                $ok++;
                last;
            }
        }
        foreach $a (@parity_opt) {
            if($a eq 'none' ){
                $ok++;
                last;
            }
        }
        foreach $a (@data_opt) {
            if($a == 8){
                $ok++;
                last;
            }
        }
        foreach $a (@stop_opt) {
            if($a == 1){
                $ok++;
                last;
            }
        }
        foreach $a (@hshake_opt) {
            if($a eq 'none'){
                $ok++;
                last;
            }
        }
        $ok++ if($ob->is_rs232);
        
        $ob->baudrate(9600);
        $ob->parity('none');
        $ob->databits(8);
        $ob->stopbits(1);
        $ob->handshake('none');
        $ob->buffers(4096,4096);
        $ob->read_interval(100) if $^O eq 'MSWin32';
        $ob->read_char_time(5);
        $ob->read_const_time(100);
        $ob->write_char_time(5) if $^O eq 'MSWin32';
        $ob->write_const_time(100) if $^O eq 'MSWin32';
        $ok++ if($ob->write_settings);
        
        $ob->close if $ok < 6;
    }
    undef $ob if $ok < 6;
    return $ob;
}

##################################################################
sub closePort {
##################################################################
    my $ob = @_;
    if($ob){
        $ob->close;
        undef $ob;
    }
}

##################################################################
sub readPort {
##################################################################
    my ($ob) = @_;
    return -1 unless($ob);
    my ($count_in, $string_in) = $ob->read(1);
    return $count_in > 0 ? ord($string_in) : -1;
}
##################################################################
sub writePort {
##################################################################
    my ($ob,$wbuf) = @_;
    return 0 unless($ob);
    
    my $n = $ob->write("$wbuf");
    return $n == length($wbuf);
}
##################################################################
sub getPorts {
##################################################################
    my @res;
    
    for my $i(0..99){
        my $port =  $^O eq 'MSWin32' ? "COM$i" : "/dev/ttyS$i";
        if(($^O ne 'MSWin32' || $i > 0) && testPort($port)){
            push(@res,$port);
            push(@res,"RS232 Serial Port, Communications Port ($port)");
        }
    }
    return @res;
}
Personal tools