ZPL2pbm.pl

   1 #!/usr/bin/perl
   2 use warnings;
   3 use strict;
   4 use autodie;
   5
   6 # convert Zebra label printer ZPL to pbm image
   7
   8 my $file = shift @ARGV || die "usage: $0 dump.zpl > dump.pbm";
   9
  10 open(my $in, '<', $file);
  11
  12 while(<$in>) {
  13         chomp;
  14         if ( /~DG(\w+:)?(.+)/ ) {
  15                 my ( $name, $t,$w ) = split(/,/,$2,4);
  16
  17                 warn "# $_ => [$name] t=$t w=$w\n";
  18
  19                 my $data;
  20                 read $in, $data, $t;
  21
  22                 my $out;
  23                 # ZPL decompress
  24                 my $repeat = 1;
  25                 foreach my $p ( 0 .. length($data) ) {
  26                         my $c = substr($data,$p,1);
  27                         if ( $c eq ',' ) {
  28                                 my $l = ( $w * 2 ) - length($out) % ( $w * 2 );
  29                                 $l = $w * 2 if $l == 0;
  30                                 warn "# $p ZERO-to-EOL $c [$l]\n";
  31                                 $out .= "0" x $l;
  32                         } elsif ( $c eq ':' ) {
  33                                 $out .= length($out) > $w ? substr($out,-$w*2) : "00" x $w;
  34                                 warn "# $p :\n";
  35                         } elsif ( $c eq 'z' ) {
  36                                 $repeat += 400;
  37                         } elsif ( $c ge 'g' && $c le 'y' ) {
  38                                 $repeat += 20 * ( ord($c) - ord('f') );
  39                         } elsif ( $c ge 'G' && $c le 'Y' ) {
  40                                 $repeat += ord($c) - ord('F');
  41                         } elsif ( $c =~ m/[0-9A-F]/ ) {
  42                                 if ( $repeat ) {
  43                                         warn "# $p $repeat $c\n";
  44                                         $out .= $c x $repeat;
  45                                         $repeat = 0;
  46                                 } else {
  47                                         warn "# $p hex $c\n";
  48                                         $out .= $c;
  49                                 }
  50                         } else {
  51                                 warn "ABORT: offset $p data [$c]";
  52                                 last;
  53                         }
  54
  55                         warn "## $repeat [$c] out = ",length($out);
  56                 }
  57
  58
  59                 my $bitmap = pack('H*', $out);
  60                 warn "# graphics of ",length($data)," bytes ZPL decompressed to ",length($out)," hex and ", length($bitmap), " bytes bitmap\n";
  61                 my $pw = $w * 8;
  62                 my $ph = int(length($bitmap) / $w);
  63                 print "P4\n$pw $ph\n", substr($bitmap,0,$ph*$w);
  64
  65         } else {
  66                 warn "IGNORED: $_\n";
  67         }
  68 }