perl でファイルダンプ（クラス風味）

perl のファイルダンプをクラス風味に書き直してみた。perl には例外処理は実装されていないようだ。代わりとなるモジュールやevalがそれに当たるとされているが、代替モジュールは正式サポートされているものでもなく、evalは意味合いが異なる。クラスと継承くらいを利用しておくのが良いのだろう。

#! /usr/bin/perl

package main;
{
   package Dump;
   sub new {
      my $pkg = shift;
      bless {
         file => shift,
      },$pkg;
   }
   
   sub adrdump {
      my $self = shift;
      my($adr) = @_;
   
      printf("%08x :",$x);
      1;
   }
   
   sub hexdump {
      my $self = shift;
      my($buf) = @_;
      my($cnt) = 0;
      my($out) = "";
   
      foreach $x (unpack("C*",$buf)) {
         $out .= sprintf("- ") if ($cnt == 8);
         $out .= sprintf("%02x ",$x);
         $cnt++;
      }
      printf("%-50s",$out);
      1;
   }
   
   sub chrdump {
      my $self = shift;
      my($buf,$size) = @_;
      my($out) = "";
   
      foreach $x (unpack("C*",$buf)) {
         if ((0x00 <= $x && $x <= 0x1f) || 0x7f <= $x) {  
            $out .= "." 
         }
         else {
            $out .= sprintf("%c",$x);
         }
      }
      printf("| %-16s",$out);
      1;
   }
   
   sub display {
      my $self = shift;
      my($cnt,$size) = 0;
      my($buf) = undef;

      if (!open(fp,$self->{file})) {
         printf(STDERR "Can't open file[%s]\n",$self->{file});
         return(undef);
      }
      while($size=read(fp,$buf,16)) {
         $self->adrdump($adr*16);
         $self->hexdump($buf);
         $self->chrdump($buf);
         printf("\n");
     
         $cnt++;
      }
      close(fp); 
      1;
   }
}

if (scalar(@ARGV) != 1) {
   printf(STDERR "Usage : test02.pl file\n");
   exit(1);
}

my $dump = Dump->new(@ARGV[0]);
if (!$dump->display()) {
   printf(STDERR "エラー:display()\n");
   exit(1);
}
exit(0);