Net::Frame::Dump::Writer - tcpdump like implementation, writer mode

   use Net::Frame::Dump::Writer;

   my $oDump = Net::Frame::Dump::Writer->new(
      file       => 'new-file.pcap',
      firstLayer => 'ETH',
   );

   $oDump->start;

   $oDump->write({ timestamp => '10.10', raw => ('A' x 14) });

   $oDump->stop;

#
# $Id: Writer.pm 350 2011-03-28 17:34:02Z gomor $
#
package Net::Frame::Dump::Writer;
use strict;
use warnings;

use base qw(Net::Frame::Dump);
our @AS = qw(
   append
   _fd
);
__PACKAGE__->cgBuildIndices;
__PACKAGE__->cgBuildAccessorsScalar(\@AS);

use Net::Frame::Dump qw(:consts);

use Carp;

sub new {
   my $self = shift->SUPER::new(
      firstLayer => 'RAW',
      append     => 0,
      overwrite  => 0,
      @_,
   );

   return $self;
}

my $mapLinks = {
   'NULL'            => NF_DUMP_LAYER_NULL(),
   'ETH'             => NF_DUMP_LAYER_ETH(),
   'PPP'             => NF_DUMP_LAYER_PPP(),
   'RAW'             => NF_DUMP_LAYER_RAW(),
   '80211'           => NF_DUMP_LAYER_80211(),
   'SLL'             => NF_DUMP_LAYER_SLL(),
   '80211::Radiotap' => NF_DUMP_LAYER_80211_RADIOTAP(),
   'ERF'             => NF_DUMP_LAYER_ERF(),
};

sub _getPcapHeader {
   my $self = shift;

   my $dlt = $mapLinks->{$self->firstLayer} or do {
      warn("Can't get pcap header information for this layer type\n");
      return;
   };

   # http://wiki.wireshark.org/Development/LibpcapFileFormat
   return CORE::pack('VvvVVVV',
      0xa1b2c3d4, # magic number
      2,          # major version number
      4,          # minor version number
      0,          # GMT to local correction
      0,          # accuracy of timestamps
      1500,       # max length of captured packets, in octets
      $dlt,       # data link type
   );
}

sub _openFile {
   my $self = shift;

   my $file = $self->file;
   if (-f $self->file && $self->append) {
      open(my $fd, '>>', $file) or do {
         warn("@{[(caller(0))[3]]}: open[append]: $file: $!\n");
         return;
      };
      $self->_fd($fd);
   }
   elsif (!-f $self->file || $self->overwrite) {
      my $hdr = $self->_getPcapHeader;
      open(my $fd, '>', $file) or do {
         warn("@{[(caller(0))[3]]}: open[overwrite]: $file: $!\n");
         return;
      };
      my $r = syswrite($fd, $hdr, length($hdr));
      if (!defined($r)) {
         warn("@{[(caller(0))[3]]}: syswrite: $file: $!\n");
         return;
      }
      $self->_fd($fd);
   }

   return 1;
}

sub start {
   my $self = shift;

   $self->isRunning(1);

   if (-f $self->file && !$self->overwrite && !$self->append) {
      warn("We will not overwrite a file by default. Use `overwrite' ".
           "attribute to do it or use `append' mode\n");
      return;
   }

   $self->_openFile;

   return 1;
}

sub stop {
   my $self = shift;

   if (!$self->isRunning) {
      return;
   }

   if (defined($self->_fd)) {
      close($self->_fd);
      $self->_fd(undef);
   }

   $self->isRunning(0);

   return 1;
}

sub write {
   my $self = shift;
   my ($h) = @_;

   if (!defined($self->_fd)) {
      warn("@{[(caller(0))[3]]}: file @{[$self->file]} not open for ".
           "writing\n");
      return;
   }

   my $raw = $h->{raw};
   my $ts  = $h->{timestamp};
   my $len = length($raw);

   # Create record header
   my ($sec, $usec) = split('\.', $ts);
   my $recHdr = CORE::pack('VVVV',
      $sec,
      $usec,
      $len,
      $len,
   );
   my $r = syswrite($self->_fd, $recHdr.$raw, length($recHdr.$raw));
   if (!defined($r)) {
      warn("@{[(caller(0))[3]]}: syswrite: @{[$self->file]}: $!\n");
      return;
   }

   return $r;
}

1;

__END__