ZPL2pbm.pl

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