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