source: core/trunk/client/flarmclient.pl @ 204

#!/usr/bin/perl
#-------------------------------------------------------------------------------
# This file is part of the FLARM¨-Radar Project.
#   
#   Copyright 2013 Netzschmiede GmbH (http://www.netzschmiede.ch)
# 
# Licensed under the Apache License, Version 2.0 (the "License");
# you may not use this file except in compliance with the License.
# You may obtain a copy of the License at
# 
#   http://www.apache.org/licenses/LICENSE-2.0
# 
# Unless required by applicable law or agreed to in writing, software
# distributed under the License is distributed on an "AS IS" BASIS,
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# See the License for the specific language governing permissions and
# limitations under the License.
# 
#   Project Website: www.flarmradar.ch
#   Email: info@flarmradar.ch
#-------------------------------------------------------------------------------

use strict;
use warnings;
use Getopt::Std;
use File::Basename;
use POSIX qw(strftime);
use POSIX qw(setsid);
use LWP::UserAgent;

my %config;
my %options;
my $ua;
my $trace = 0;

# default values
my $log = "$ENV{'HOME'}/.flarmclient/client.trace";
my $cfile = "$ENV{'HOME'}/.flarmclient/client.config";
my $fifo = "$ENV{'HOME'}/.flarmclient/client.fifo";

# functions
sub usage {
  print <<EOF;
NAME
  $0 -- stream flarm data to server

SYNOPSIS
  $0 [-c config_file] [-f data_file] [-h]

DESCRIPTION
  The following options are available:
  
  -c    Use the specified configuration file. Use the default configuration
                file as a starting point for customization.
                
  -f    Read the data from the specified data file. This is mainly used for
                testing and development.
                
  -h    Print this help.

EOF
  exit 0;
}

# print statistic information to logfile
$SIG{USR1} = sub {
        if ($trace) {
                $trace = 0;
        } else {
                $trace = 1;
        }
};

sub logit {
        my ($level, $msg) = @_;
        if ($trace) {
                open(LOG, "> $log");
                print LOG localtime() . " $level $msg\n";
                close(LOG);
        }
}

sub cleanup {
        if (-e "$fifo") {
                unlink($fifo) || die("unable to remove $fifo: $!");
        }
}

sub readconfig {
        open(CONF, "< $cfile") || die("failed to open config file for reading: $!");
        while(my $line = <CONF>) {
                chomp($line);
                next if $line =~ /^\s*#/;
                next if $line =~ /^\s*$/;
                if ($line =~ /^\s*(\S*)\s*=\s*(\S*)\s*$/) {
                        $config{$1} = $2;
                }
        }
        close(CONF);
}

# send the records to the server. We don't make a request for each record for
# performance reasons.
sub flush {
        my ($records, $url) = @_;
        my $date = strftime "%Y/%m/%d", localtime;
        my $resturl = $url . "/" . $date;
        my $request = HTTP::Request->new('PUT');
        $request->url($resturl);
        $request->header('stationKey'=>$config{'key'});
        $request->content($records);
        # run the request
        my $response = $ua->request($request);
        # analyze the response
        my $code = $response->code;
        $response->code == 200 || logit("ERROR", "error processing records (" . $response->code . ") records=[" . $records . "]");
}

# parse options
getopts('c:f:h', \%options);

# read config file
if (defined($options{'c'})) {
        $cfile = $options{'c'};
}
if (defined($options{'h'})) {
        usage();
}

# read config file
readconfig();

# validation: key must be present in config file
die("no key found in config file (option: key)") unless defined($config{'key'});

# remove old leftovers
cleanup();

# create pipe
die("no fifo found in config file (option: fifo)") unless defined($fifo);
if (! -d dirname($fifo)) {
        system("mkdir", "-p", dirname($fifo)) == 0 || die("failed to create fifo directory " . dirname($fifo) . ": $!")
}
system("mkfifo", $fifo) == 0 || die("failed to create fifo: $!");

# force a flush right away and after every write or print
local $| = 1;

# fork minicom and write to pipe
defined( my $pid = fork() ) or die "can't fork: $!";
unless ($pid) {
        # we're the child
        # detach from session
        setsid() or die "can't start a new session: $!";
        close(STDIN);
        close(STDOUT);
        close(STDERR);
        
        if (defined($options{'f'})) {
                open(DATA, "< $options{'f'}") || die("failed to open data file $options{'f'}: $!");
                open(FIFO, "> $fifo") || die("failed to open fifo for writing: $!");
                while(my $line = <DATA>) {
                        chomp($line);
                        next if ($line =~ /^\s*$/);
                        print FIFO $line, "\n" || die("failed to execute child command: $!");
                }
                close(DATA);
                close(FIFO);
        } else {
                exec("minicom", "-t", "xterm-color", "-C", $fifo) == 0 || die("failed to run minicom: $!");
        }
        exit 0;
}

# create UserAgent object
$ua = new LWP::UserAgent;
my $buf;
# read data from pipe
open(FIFO, "< $fifo") || die("failed to open fifo for reading: $!");
while(my $record = <FIFO>) {
        chomp($record);
        logit("TRACE", $record);
        $buf = (defined($buf)) ? "$buf;$record" : $record;
        if ($record =~ /^\$GPGGA,/) {
                flush($buf, $config{'url'});
                if (defined($options{'f'})) {
                        sleep(1);
                }
                $buf = undef;
        }
}
close(FIFO);

cleanup();
exit 0;