Parsing HPGL Plotter commands - sanity check 1

bengR · Mar 23, 2009

I am running perl v5.8.0 on Windows Vista via ActiveState perl build 824.
The following code parses HPGL commands out of a print stream and prints the command's offset in the file, the
command, and any parameters.

The code compiles without any errors or warnings when I run "perl -c hpgl2.pl".
However the output is mangled - some of the parameters are either missing or replaced with ';'.

I must be making some silly assumption or logic error in my code, but I cannot seem to find it.
Does anyone have any hints/suggestions?

The script:

Code:

#! /usr/bin/perl

use warnings;
use strict;
use constant OFFSET => 3_050;

{
   local $/ = \1;
   
   my ($pos, $line, $command, $value);
   my %HPGL = (
         'AC' => \&AC,
         'IR' => \&IR,
         'IW' => \&IW,
         'PP' => \&PP,
         'PW' => \&PW,
         'RO' => \&RO,
         'SC' => \&SC,
         'SP' => \&SP,
         'TD' => \&TD,
         'WU' => \&WU
   );
   
   sub AC {
      my ($pos, $command, $value) = @_;
      printf "%2s|%s|%s\n", ($pos - OFFSET), $command, $value;
      return 1;
   }
   
   sub IR {
      my ($pos, $command, $value) = @_;
      printf "%2s|%s|%s\n", ($pos - OFFSET), $command, $value;
      return 1;
   }
   
   sub IW {
      my ($pos, $command, $value) = @_;
      printf "%2s|%s|%s\n", ($pos - OFFSET), $command, $value;
      return 1;
   }
   
   sub PP {
      my ($pos, $command, $value) = @_;
      printf "%2s|%s|%s\n", ($pos - OFFSET), $command, $value;
      return 1;
   }
   
   sub PW {
      my ($pos, $command, $value) = @_;
      printf "%2s|%s|%s\n", ($pos - OFFSET), $command, $value;
      return 1;
   }
   
   sub RO {
      my ($pos, $command, $value) = @_;
      printf "%2s|%s|%s\n", ($pos - OFFSET), $command, $value;
      return 1;
   }
   
   sub SC {
      my ($pos, $command, $value) = @_;
      printf "%2s|%s|%s\n", ($pos - OFFSET), $command, $value;
      return 1;
   }
   
   sub SP {
      my ($pos, $command, $value) = @_;
      printf "%2s|%s|%s\n", ($pos - OFFSET), $command, $value;
      return 1;
   }
   
   sub TD {
      my ($pos, $command, $value) = @_;
      printf "%2s|%s|%s\n", ($pos - OFFSET), $command, $value;
      return 1;
   }
   
   sub WU {
      my ($pos, $command, $value) = @_;
      printf "%2s|%s|%s\n", ($pos - OFFSET), $command, $value;
      return 1;
   }
   
   sub ERROR {
      my ($pos, $command, $value) = @_;
      printf "%2s|%s|%s\n", ($pos - OFFSET), $command, "Unknown command";
      return 0;
   }
   
   sub peek {
      my ($nextChar) = @_;
      my ($pos, $nextRecord);
      
      $pos = tell DATA;
      $nextRecord = <DATA> || "EOF\n";
      seek (DATA, $pos, 0);
      
      return 1 if $nextRecord =~ /($nextChar)/;
      return 0;
   }
   
   $pos = tell(DATA);
   
   until (peek("~")) {
      $line .= <DATA>;
      <DATA> if peek("[;\\s]");
      
      if ((length($line) == 2) && (peek("[A-Za-z]"))) {
         ($command, $value) = unpack("A2a*", $line);
         ($HPGL{$command} || \&ERROR) -> ($pos, $command, $value);
         $line = "";
         $pos = tell(DATA);
      } elsif ((length($line) == 2) && (peek("[^A-Za-z~]"))) {
         
         until (peek("[A-Za-z~]")) {
            $line .= <DATA>;
            <DATA> if peek("[;\\s]");
         }
         
         ($command, $value) = unpack("A2a*", $line);
         ($HPGL{$command} || \&ERROR) -> ($pos, $command, $value);
         $line = "";
         $pos = tell(DATA);
      }
   }
}
__DATA__
WU;AC14,4;SP1;PP1;PW0;TD1;IW;SC0,1.6933,0,-1.6933,2;RO0;IR0,100,8,100;~

This is what I am expecting to print:

Code:

 0|WU|
 3|AC|14,4
10|SP|1
14|PP|1
18|PW|0
22|TD|1
26|IW|
29|SC|0,1.6933,0,-1.6933,2
52|RO|0
56|IR|0,100,8,100

This is what is actually printing:

Code:

 0|WU|
 3|AC|14,4
10|SP|1
14|PP|1
18|PW|;
22|TD|1
26|IW|
29|SC|,1.6933,,-1.6933,2
52|RO|;
56|IR|,1
62|0,|Unknown command

Thank you for your time.

KevinADC · Mar 23, 2009

Well, your script appears to be having trouble parsing zeros: 0. Your code is quite hard to follow (for me anyway) so I don't know why that is.

------------------------------------------
- Kevin, perl coder unexceptional! [wiggle]

bengR · Mar 23, 2009

Kevin said:
Well, your script appears to be having trouble parsing zeros: 0.
Your code is quite hard to follow (for me anyway) so I don't know why that is.

Here is a commented version of the code.
This should (hopefully) be clearer.
(Please note that the offsets will be incorrect now).

Code:

#! /usr/bin/perl

use warnings;
use strict;
use constant OFFSET => 3_050;

{
   local $/ = \1;
   
   my ($pos, $line, $command, $value);
   
   # dispatch table for the HPGL commands
   my %HPGL = (
         'AC' => \&AC,
         'IR' => \&IR,
         'IW' => \&IW,
         'PP' => \&PP,
         'PW' => \&PW,
         'RO' => \&RO,
         'SC' => \&SC,
         'SP' => \&SP,
         'TD' => \&TD,
         'WU' => \&WU
   );
   
   sub AC {
      my ($pos, $command, $value) = @_;
      printf "%2s|%s|%s\n", ($pos - OFFSET), $command, $value;
      return 1;
   }
   
   sub IR {
      my ($pos, $command, $value) = @_;
      printf "%2s|%s|%s\n", ($pos - OFFSET), $command, $value;
      return 1;
   }
   
   sub IW {
      my ($pos, $command, $value) = @_;
      printf "%2s|%s|%s\n", ($pos - OFFSET), $command, $value;
      return 1;
   }
   
   sub PP {
      my ($pos, $command, $value) = @_;
      printf "%2s|%s|%s\n", ($pos - OFFSET), $command, $value;
      return 1;
   }
   
   sub PW {
      my ($pos, $command, $value) = @_;
      printf "%2s|%s|%s\n", ($pos - OFFSET), $command, $value;
      return 1;
   }
   
   sub RO {
      my ($pos, $command, $value) = @_;
      printf "%2s|%s|%s\n", ($pos - OFFSET), $command, $value;
      return 1;
   }
   
   sub SC {
      my ($pos, $command, $value) = @_;
      printf "%2s|%s|%s\n", ($pos - OFFSET), $command, $value;
      return 1;
   }
   
   sub SP {
      my ($pos, $command, $value) = @_;
      printf "%2s|%s|%s\n", ($pos - OFFSET), $command, $value;
      return 1;
   }
   
   sub TD {
      my ($pos, $command, $value) = @_;
      printf "%2s|%s|%s\n", ($pos - OFFSET), $command, $value;
      return 1;
   }
   
   sub WU {
      my ($pos, $command, $value) = @_;
      printf "%2s|%s|%s\n", ($pos - OFFSET), $command, $value;
      return 1;
   }
   
   sub ERROR {
      my ($pos, $command, $value) = @_;
      printf "%2s|%s|%s\n", ($pos - OFFSET), $command, "Unknown command";
      return 0;
   }
   
   # Retrieve the next character in the data without moving the file pointer or "EOF" if at the end of the file
   # (this is used in another section of the larger program)
   # Returns '1' if the next character matches the given regex. 
   sub peek {
      my ($nextChar) = @_;
      my ($pos, $nextRecord);
      
      $pos = tell DATA;
      $nextRecord = <DATA> || "EOF\n";
      seek (DATA, $pos, 0);
      
      return 1 if $nextRecord =~ /($nextChar)/;
      return 0;
   }
   
   $pos = tell(DATA); # get the current byte offset in the data
   
   until (peek("~")) { # continue parsing until we reach a '~'
      $line .= <DATA>; 
      <DATA> if peek("[;\\s]"); # skip the optional HPGL terminators
      
      # HPGL command without any parameters
      if ((length($line) == 2) && (peek("[A-Za-z]"))) {
         
         # separate the two character command from the parameters
         ($command, $value) = unpack("A2a*", $line);
         
         # call the correct sub with the %HPGL dispatch table hash
         # the sub gets passes the byte offset, the command name, and the parameters
         # if the command name does not match one of the hash keys then go to the default 'ERROR' sub
         ($HPGL{$command} || \&ERROR) -> ($pos, $command, $value);
         $line = "";
         $pos = tell(DATA);
      
      # HPGL command with parameters
      } elsif ((length($line) == 2) && (peek("[^A-Za-z~]"))) {
         
         # read in the parameter data until the next command is reached, or we hit the end of the HPGL string
         until (peek("[A-Za-z~]")) { # keep on processing until we reach an alpha character or '~'
            $line .= <DATA>;
            <DATA> if peek("[;\\s]"); # skip the optional HPGL terminators
         }
         
         # separate the two character command from the parameters
         ($command, $value) = unpack("A2a*", $line);
         
         # call the correct sub with the %HPGL dispatch table hash
         # the sub gets passes the byte offset, the command name, and the parameters
         # if the command name does not match one of the hash keys then go to the default 'ERROR' sub
         ($HPGL{$command} || \&ERROR) -> ($pos, $command, $value);
         $line = "";
         $pos = tell(DATA);
      }
   }
}
__DATA__
WU;AC14,4;SP1;PP1;PW0;TD1;IW;SC0,1.6933,0,-1.6933,2;RO0;IR0,100,8,100;~

Annihilannic · Mar 23, 2009

I think the problem is with this line:

Code:

      $nextRecord = <DATA> || "EOF\n";

When <DATA> returns "0", you get "EOF" instead. Changing || to or fixes it... however I don't think it will ever result in an "EOF" so you may as well take that out or change the logic.

Annihilannic.

KevinADC · Mar 23, 2009

Yea makes sense, 0 is a false value in perl. Most of those subroutines do the same thing, you could get rid of a lot of code by just having one.

------------------------------------------
- Kevin, perl coder unexceptional! [wiggle]

bengR · Mar 24, 2009

Annihilannic said:
When <DATA> returns "0", you get "EOF" instead.

Aha! I knew I was making a silly logic error somewhere!
Thank you for your help Annihilannic.

I changed peek() to the following, which works as expected:

Code:

sub peek {
   my ($nextChar) = @_;
   my ($pos, $nextRecord);
   
   $pos = tell DATA;
   $nextRecord = <DATA>;
   seek (DATA, $pos, 0);
   
   $nextRecord = "EOF\n" unless defined($nextRecord);
   return 1 if $nextRecord =~ /($nextChar)/;
   return 0;
}

however I don't think it will ever result in an "EOF" so you may as well take that out or change the logic.

Most of those subroutines do the same thing, you could get rid of a lot of code by just having one.

The code is a small test case from a much larger module.
$nextRecord eventually becomes "EOF" and the subroutines do much more than print offset|command|parameter

Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

Parsing HPGL Plotter commands - sanity check 1

bengR

Technical User

KevinADC

Technical User

bengR

Technical User

Annihilannic

MIS

KevinADC

Technical User

bengR

Technical User

Similar threads

Part and Inventory Search

Sponsor