comread3.pl to HTML.

index -|- end

Generated: Tue Feb 2 17:54:28 2010 from comread3.pl 2005/07/22 14.1 KB.

#!c:\Perl\bin\Perl
#
# This is an example file showing how to send data to the serial port.
#
# It does not include error checking.
#
use strict;
#use Device::SerialPort; # on UNIX
use Win32::SerialPort; # on Windows
##use Term::Getch;
##use Term::ReadKey;
##ReadMode('cbreak');
my $prog = 'comread3';
my $vers = '0.0.2 July, 2005';
my $verb = 0; # add extra, if any
#my $DEVICE = "/dev/ttyS1"; # on UNIX
my $DEVICE = "COM5";  # on Windows
my $start_time = time();
my $msg = "Hello World!";
my $dbgon1 = 0; # off for normal running
my $dbgon2 = 0; # off for normal running
my $maxperfile = 30; # for testing 60; # assume one-per-second
my $cnt = 0;
my $InBytes = 256; # this 'seems' ok ...
# but if ftp xfer begins to cost more time ... either separate the processes, or ???
my $maxmsg = 1024; # not used, yet ...
###my $cfgfile = "com1.cfg";
my $cfgfile = "c:/Gtools/perl/comm5.txt";
##my $gpsbgn = '\$GPRMC'; not used
my ($OF, $HOUT);
# running set of LOG files ... to backtrack position, if diesired ...
my $logfile = "templ001.txt"; # is increment to 999, then overwrite occurs
my $logdir = 'pos/'; # offset into a log folder
my $outfile = $logdir . $logfile; # combined
# output HTML text file ... to be transferrred by FTP to the host server ...
my $destdir = '../java/';
my $desthtm = 'pos2.htm';
my $destfil = $destdir . $desthtm; # final DESTINATION file - to be xferrred to host
my $putpos = "PutPos2.BAT"; # do the FTP transfer through a BATCH file
open ($OF, ">$outfile") or die "Can NOT open log file ... [$outfile]!!! ...";
### sub openPort($);
### sub closePort($);
my $gps_first = 1;
# Now process the new RMC record - example
### $GPRMC,130210.030,A,3352.3955,S,15113.3678,E,0.257256,125.59,260605,,*10                                                                        
my $gps_time_rmc = ''; # join ':', unpack "a2" x 3, $field[1];
my $gps_ok_rmc = 0; # $field[2];
my $gps_lat_rmc = 0; # latitude(@field[3..4]);
my $gps_long_rmc = 0; # longitude(@field[5..6]);
my $gps_speed = 0; # $field[7];
my $gps_cmg = ''; # $field[8];
my $gps_date = ''; # join '/', unpack "a2" x 3, $field[9];
my $gps_mvar = ''; # $field[10] . $field[11];
my @field = (); # split /[,*]/, $line; # split on comma, and * (checksum)
my $currhr = -1; #$hms[0];
my $currmin = -1; #$hms[1];
my $currsec = -1; #$hms[2];
my $currday = -1; #$dte[0];
my $currmth = -1; #$dte[1];
my $curryr = -1; #$dte[2];
my $currtimed = ''; #"$currhr:$currmin:$currsec";
my $currdated = ''; #"$curryr/$currmth/$currday";
my $gps_dispdt = ''; #"$currdated $currtimed";
my $gps_lat_curr = 0; # latitude(@field[3..4]);
my $gps_long_curr = 0; # longitude(@field[5..6]);
my $gps_map = "map2011s.jpg";
my $gps_hour = 0;   # = $currhr;  # = $hms[0];
my $gps_minute = 0; # = $currmin; # = $hms[1];
my $gps_second = 0; # = $currsec; # = $hms[2];
my $gps_day = 0;    # = $currday; # = $dte[0];
my $gps_month = 0;  # = $currmth; # = $dte[1];
my $gps_year = 0;   # = $curryr;  # = $dte[2];
my ($count_in, $string_in); ### = $serial->read($InBytes);
### warn "read unsuccessful\n" unless ($count_in == $InBytes);
my $msglast = '';
my $msgend = "";
my $gotstg = 0;
my $pos1 = 0;
my $pos2 = 0;
my $gpsmsg = '';
my $outcnt = 0;
my $totcnt = 0;
###my $maxperfile = 60; # assume one-per-second
print "Started on " . localtime($start_time) . "...\n";
parse_arguments(@ARGV);
print "Openning $DEVICE ...\n";
my $serial = openPort($DEVICE);
print "Reading $InBytes from $DEVICE ...\n";
$msg = "";
print "Awaiting first GPS message ... Ctrl+C to exit!\n";
$serial->read_interval(0);
$serial->read_const_time(5000);
while (1) {
   # stay here until FIRST GPS message received, or at least the $GPRMC beginning
   ($count_in, $string_in) = $serial->read($InBytes);
   $msglast = $msg; # keep last
   $msg .= $string_in; # accumulate the input
   print "Read $count_in of $InBytes ... $string_in.\n";
   if ( $msg =~ /\$GPRMC/om ) {
      $pos1 = index ($msg, '$GPRMC');
      if ($pos1 > 0) {
         $msg = substr( $msg, $pos1 );
      }
      print "$msg ... Ctrl+C to exit";
      $gotstg = 1;
      last;
   }
}
print "\nBeginning GPS message accumulation ... Ctrl+C to exit\n" if $gotstg;
$| = 1; # set file flush on
while ($gotstg) {
   ($count_in, $string_in) = $serial->read($InBytes);
   $msglast = $msg;
   $msg .= $string_in;
   if ($gotstg) {
      # we already have a start of cycle on $GPRMC sentence
      $msgend = substr($msg,6);
      if ($msgend =~ /\$GPRMC/om) { # got NEXT
         $outcnt++; # bump the GPS message set count
         $totcnt++; # bump the GPS message total count
         if ($dbgon1) {
            print "\nGot GPS Count $totcnt/$outcnt ... Ctrl+C to exit!\n";
         } else {
            print "\rGot GPS Count $totcnt/$outcnt ... Ctrl+C to exit!";
         }
         $pos2 = index ($msgend, '$GPRMC');
         $gpsmsg = '$GPRMC' . substr($msgend, 0, $pos2);
         print $gpsmsg if $dbgon2;
         print $OF $gpsmsg;
         process_GPRMC_msg ( $gpsmsg );
         $msg = substr ($msgend, $pos2);
         print "NEW START: $msg" if $dbgon2;
         if ($outcnt >= $maxperfile) {
            close ($OF);
            $logfile = nextfilename($logfile);
            $outfile = $logdir . $logfile;
            print "\nNew log file = $outfile ...\n";
            open ($OF, ">$outfile") or die "Can NOT open log file ... $outfile ...";
            ### write_html_pos2 ( $dispdt, $gps_lat_curr, $gps_long_curr, "map2011s.jpg" );
            write_html_pos2 ( $gps_dispdt, $gps_lat_curr, $gps_long_curr, $gps_map );
            $outcnt = 0;
         }
      }
   }
##   if (defined ($char = ReadKey(-1)) ) {
##   if (defined ($char = getch()) ) {
##      # input was waiting and it was $char
##      last;
##   }
}
print "\nExit while ... len=" . length($msg) . "\n";
print "$msg\n";
close ($OF);
###print "Writing $DEVICE ...\n";
###$serial->write("Hello World");
###$cnt = $serial->write($msg);
###print "Written $cnt (", length($msg), ") ... Closing $DEVICE ...\n";
closePort($serial);
###ReadMode('normal');     # restore normal tty settings
### end of program
##############################################
######## subs
# @_ = (3352.3955,S) == -33 52.3955 == -33.8732583333333
sub latitude {
   my ($deg, $min) = unpack "a2a*", $_[0];
   my $lat = $deg + $min / 60;
   $lat = - $lat if $_[1] =~ /[Ss]/;
   return $lat;
}
# @_ = (15113.3678,E) == +151 13.6678 == 151.222796666667
sub longitude {
   my ($deg, $min) = unpack "a3a*", $_[0];
   my $long = $deg + $min / 60;
   $long = - $long if $_[1] =~ /[Ww]/;
   return $long;
}
### always have this set of CURRENT variables
### filled with the MOST recent date,time,lat,lon,...
sub gps_output {
   if ($gps_ok_rmc eq 'A') {
      # valid record
#   print OUTFILE $time_rmc, ',', $ok_rmc, ',', $lat_rmc, ',',
#      $long_rmc, ',', $speed, ',', $cmg, ',', $date, ',',
#      $mvar, ',';
      # $time_rmc = '13:02:10' HH:MM:SS format
      my (@hms) = split ':', $gps_time_rmc; # split TIME
      # $date = 26/07/05 # split DATE
      my (@dte) = split '/', $gps_date; # split date
      $currhr = $hms[0];
      $currmin = $hms[1];
      $currsec = $hms[2];
      $currday = $dte[0];
      $currmth = $dte[1];
      # $curryr = $dte[2];
      $curryr = $dte[2] + 2000;
      if( ( ($currhr >=  0) && ($currhr  < 24) ) &&
         ( ($currmin >= 0) && ($currmin < 60) ) &&
         ( ($currsec >= 0) && ($currsec < 60) ) ) {
         # got a VALID time - set it as CURRENT
         $currtimed     = "$currhr:$currmin:$currsec";
         # $currdated     = "$curryr/$currmth/$currday";
         $currdated     = "$currday/$currmth/$curryr";
         $gps_dispdt    = "$currdated $currtimed";
         $gps_lat_curr  = $gps_lat_rmc;  # latitude(@field[3..4]);
         $gps_long_curr = $gps_long_rmc; # longitude(@field[5..6]);
         $gps_hour      = $currhr;  # = $hms[0];
         $gps_minute    = $currmin; # = $hms[1];
         $gps_second    = $currsec; # = $hms[2];
         $gps_day       = $currday; # = $dte[0];
         $gps_month     = $currmth; # = $dte[1];
         $gps_year      = $curryr;  # = $dte[2];
      }
   }
}
sub process_GPRMC_msg {
   my ($line) = @_;
   @field = split /[,*]/, $line; # split on comma, and * (checksum)
   # recommended minimum specific GPS/Transit data
   if ($field[0] eq '$GPRMC') {
      #  Each time we see this
      # sentence, print out the accumulated information
      # from the previous burst.
      gps_output() unless ($gps_first) ;
      $gps_first = 0;
      # Now process the new RMC record - example
### $GPRMC,130210.030,A,3352.3955,S,15113.3678,E,0.257256,125.59,260605,,*10                                                                        
      $gps_time_rmc = join ':', unpack "a2" x 3, $field[1];
      $gps_ok_rmc = $field[2];
      $gps_lat_rmc = latitude(@field[3..4]);
      $gps_long_rmc = longitude(@field[5..6]);
      $gps_speed = $field[7];
      $gps_cmg = $field[8];
      $gps_date = join '/', unpack "a2" x 3, $field[9];
      $gps_mvar = $field[10] . $field[11];
      # field[12] is checksum
      ###last SWITCH;
   }
}
#**************************************************************************
#*  Serial functions
#**************************************************************************
#* Open raw serial port using:
#*    8 data bits
#*    1 stop bit
#*    19200 bps
#*    no parity
sub openPort($)
{
   my ($device) = @_;
   print "openPort $device ...\n";
   #my $serial = Device::SerialPort->new ($device, 1); # on UNIX
   my $serial = Win32::SerialPort->new ($device, 1); # on Windows
   die "Can't open serial port $serial: $^E\n" unless ($serial);
  my ($BlockingFlags, $InBytes, $OutBytes, $LatchErrorFlags) = $serial->status
        || warn "could not get port status\n";
  if ($BlockingFlags) {
     warn "Port is blocked";
#  if ($BlockingFlags & BM_fCtsHold) { warn "Waiting for CTS"; }
   if ($BlockingFlags & $serial->BM_fCtsHold) { warn "Waiting for CTS (BM_fCtsHold)"; }
   if ($BlockingFlags & $serial->BM_fDsrHold) { warn "Waiting for Dsr (BM_fDsrHold)"; }
   if ($BlockingFlags & $serial->BM_fRlsdHold) { warn "Waiting for Rlsd (BM_fRlsdHold)"; }
   if ($BlockingFlags & $serial->BM_fXoffHold) { warn "Got Xoff (BM_fXoffHold)"; }
   if ($BlockingFlags & $serial->BM_fXoffSent) { warn "Sent Xoff (BM_fXoffSent)"; }
   if ($BlockingFlags & $serial->BM_fEof) { warn "Is EOF (BM_fEof)"; }
   if ($BlockingFlags & $serial->BM_fTxim) { warn "Is Txim (BM_fTxim)"; }
   ### BM_fCtsHold     BM_fDsrHold     BM_fRlsdHold    BM_fXoffHold
    ### BM_fXoffSent    BM_fEof         BM_fTxim        BM_AllBits
  }
#  if ($LatchErrorFlags & CE_FRAME) { warn "Framing Error"; }
  if ($LatchErrorFlags & $serial->CE_FRAME) { warn "Framing Error"; }
        # The API resets errors when reading status, $LatchErrorFlags
        # is all $ErrorFlags seen since the last reset_error
   $serial->user_msg(1);
   $serial->databits(8);
   ###$serial->baudrate(19200);
   $serial->parity("none");
   $serial->stopbits(1);
   ###$serial->handshake("rts");
   $serial->buffers( 4096, 4096 );
#  my ($BlockingFlags, $InBytes, $OutBytes, $LatchErrorFlags) = $serial->status
#        || warn "could not get port status\n";
#  if ($BlockingFlags) { warn "Port is blocked"; }
#  if ($BlockingFlags & BM_fCtsHold) { warn "Waiting for CTS"; }
#  if ($LatchErrorFlags & CE_FRAME) { warn "Framing Error"; }
# $PortObj->transmit_char(0x03);        # bypass buffer (and suspend)
# $ModemStatus = $PortObj->modemlines;
# if ($ModemStatus & $PortObj->MS_RLSD_ON) { print "carrier detected"; }
   print "openPort writing settings ...\n";
   $serial->write_settings || die "Setting port FAILED";
   print "openPort saving configuration ...\n";
   $serial->save($cfgfile); # = 'comm?.txt';
    return $serial;
}
sub closePort($)
{
   my ($serial) = @_;
   print "closePort ...\n";
   $serial->close();
}
# using 'templ' + '001-999' numbers
sub nextfilename {
   my ($tx) = @_;
   my $tx1 = substr ($tx, 0, 5);
   my $tx2 = substr ($tx, 5);
   my $tx3 = substr ($tx2, 0, 3);
   my $tx4 = substr ($tx2, 3);
   $tx3++;
   if ($tx3 > 999) {
      $tx3 = '001';
   }
   return ($tx1 . $tx3 . $tx4);
}
sub write_html_pos2 {
   my ($dt, $lat, $lon, $map ) = @_;
   my $ct = localtime(time());
   ### if (open ($HOUT, ">../java/pos2.htm")) {
   if (open ($HOUT, ">$destfil")) {
      print $HOUT <<EOF;
<html>
<head>
<meta http-equiv="Content-Language" content="en-au">
<meta http-equiv="Content-Type" content="text/html; charset=windows-1252">
<meta http-equiv="refresh" content="30;url=pos2.htm">
<title>GPS Position - The Flower King</title>
</head>
<body>
<h1 align="center"><b>GPS Position - The Flower King</b></h1>
<div align="center">
  <center>
  <table border="2" cellpadding="6" cellspacing="6">
    <tr>
      <td>Date/Time</td>
      <td>Latitude</td>
      <td>Longitude</td>
    </tr>
    <tr>
      <td><b>$dt</b></td>
      <td><b>$lat</b></td>
      <td><b>$lon</b></td>
    </tr>
  </table>
  </center>
</div>
<p align="center"><img border="1" src="$map" width="581" height="373"></p>
<p><center>
<a href="index.html">Index</a>
</center></p>
<p align="right"><font size="-2">$ct</font></p>
</body>
</html>
<!-- java/pos2.htm - auto-generated by perl/comread3.pl - transferred to site by java/FtpPut.java -->
EOF
      close $HOUT;
      # transfer this HTML file up to the site ...
      ## system ("PutPos2.BAT"); ### how to CHECK?
      system ($putpos); ### how to CHECK?
      # onto next messages ...
   }
}
sub give_help {
   print "-version   - Shows version of perl program ...\n";
   print "-verbose   - Set verbose mode ...\n";
   print "-debug     - Set debug mode ...\n";
   print "-port COM1 - Set COM port (def=$DEVICE)\n";
   die "Adjust command line, and try again ...\n";
}
sub parse_arguments {
   my @av = @_; # take it off the passed stack
   while (@av) {
      my $tx = $av[0];
      if ($tx eq '-version') {
         print "$prog: Version $vers\n";
      } elsif (($tx eq '-verbose') || ($tx eq '-v')) {
         print "Setting verbose ...\n";
         $verb = 1;
      } elsif ($tx eq '-d') {
         print "Setting debug output ...\n";
         $dbgon1 = 1;
      } elsif ($tx eq '-debug') {
         print "Setting debug output ...\n";
         $dbgon2 = 1;
      } elsif (($tx eq '-port') || ($tx eq '-p')) {
         shift @av; # move to next argument to [0]
         if (@av) {
            $tx = $av[0]; # get desired PORT
            print "Changing PORT from $DEVICE to $tx ...\n";
            $DEVICE = $tx; # set new PORT
         } else {
            print "Failed setting port $tx ...\n";
            give_help();
         }
      } else {
         print "Unrecognised option $tx! ...\n";
         give_help();
      }
      shift @av; # move to next argument to [0]
   }
}
# eof

index -|- top

checked by tidy  Valid HTML 4.01 Transitional