File Coverage

blib/lib/Convert/Cisco.pm

Criterion	Covered	Total	%
statement	24	99	24.2
branch	0	28	0.0
condition			n/a
subroutine	8	13	61.5
pod	2	2	100.0
total	34	142	23.9

#=============================================================

package Convert::Cisco;

use warnings;
use strict;

use FileHandle;
use File::Basename;
use Log::Log4perl qw(get_logger);
use YAML qw(Dump Load);
use DateTime;
use XML::Writer;

=head1 NAME

Convert::Cisco - Module for converting Cisco billing records

=head1 VERSION

Version 0.06

=cut

our $VERSION = '0.06';

=head1 SYNOPSIS

Convert Cisco billing record binary files. The format is available on the
Cisco Website:

 http://www.cisco.com/univercd/cc/td/doc/product/access/sc/rel9/billinf/r9chap1.htm

Module used to convert Cisco billing records into XML

 use Convert::Cisco;

 my $obj = Convert::Cisco->new(stylesheet=>"cisco.xsl");
 $obj->to_xml("test.bin", "test.xml");

=head1 FUNCTIONS

=cut

#-------------------------------------------------------------

=head2 new

Constructor method, has the following optional parameters:

=over

=item stylesheet

Adds a xml-stylesheet processing instruction to the top of all converted XML files



=item config

Billing record configuration data expressed in YAML format. This option is normally
only used by the tests because it over-rides the modules field configuration.

=back

=cut

sub new {
   my $class = shift;
   my (%args) = @_;
   my $self = bless {stylesheet=>undef, config=>undef, %args}, $class;

   ### Load record configuration
   if (defined $self->{config}) {
      $self->{_config} = Load($self->{config});
   }
   else {
      $self->{_config} = Load(join("\n", ));
   }

   ### Default configuration
   unless (exists $self->{_config}{"CDE Records"}{6003}) {
      $self->{_config}{"CDE Records"}{6003} = {name=>"record_count", spec=>"N"};
   }

   return $self;
}

#-------------------------------------------------------------

# _decodeCDB
#
# Returns the configured name for the CDB record
#

sub _decodeCDB {
   my ($self, $key) = @_;
   my $log = get_logger;

   if (exists $self->{_config}{"CDB Names"}{$key}) {
      return $self->{_config}{"CDB Names"}{$key};
   }
   else {
      $log->warn("CDB not configured: ", $key);
      return "UNKNOWN"
   }
}

#-------------------------------------------------------------

# _decodeCDE
#
# Unpacks the CDE record based on the configured specification
#

sub _decodeCDE {
   my ($self, $key, $value) = @_;
   my $log = get_logger;
   my $decodeValue;
   my $decodeName;
   my $decodeValueUnformatted;

   if (exists $self->{_config}{"CDE Records"}{$key}) {

      $decodeName = $self->{_config}{"CDE Records"}{$key}{name};
      my $spec    = $self->{_config}{"CDE Records"}{$key}{spec};
      my $format  = $self->{_config}{"CDE Records"}{$key}{format};

	  ### Handling for multi-part records
      if (ref($spec) eq "ARRAY")  {
         $decodeValue = join("-", unpack(join(" ", @{$spec}), $value));
      }
      else {
         $decodeValue = unpack($spec, $value);
      }

	  ### Optional output formatting
	  if (defined $format) {
         $decodeValueUnformatted = $decodeValue;

	     if ($format eq "epoch2datetime") {
            $decodeValue = DateTime->from_epoch(epoch => $decodeValueUnformatted)->datetime;
	     }
		 elsif ($format eq "compoundEpoch2datetime") {
			my @timeComponents = split("-", $decodeValueUnformatted);
            $decodeValue = DateTime->from_epoch(epoch => $timeComponents[0])->datetime.".".$timeComponents[1];
	     }
		 else {
			 $log->warn("Unsupported format configured for CDE: $key");
		 }
	  }
   }
   else {
      $log->warn("CDE not configured: ", $key);
	  $decodeName  = "UNKNOWN";
      $decodeValue = unpack("H*", $value);
   }

   return ($decodeValue, $decodeName, $decodeValueUnformatted);
}

#-------------------------------------------------------------

# _stylesheetDecl
#
# Write XSL stylesheet declaration
#

sub _stylesheetDecl {
   my ($self, $writer) = @_;

   if (defined $self->{stylesheet}) {
      $writer->pi('xml-stylesheet', sprintf('href="%s" type="%s"', $self->{stylesheet}, "text/xsl"));
   }
}

#-------------------------------------------------------------

=head2 to_xml

Converts a file into XML format. The current record format is:



  ..
  ..

    0a
    8090a3
    02
	..
	..

  ..
  ..

B

The XML format is subject to change and needs an associated XML DTD or Schema.

=cut

sub to_xml {
   my ($self, $filename, $filename_output) = @_;
   my $log = get_logger;

   ### Print the name of the file processed
   $log->debug("Processing: ", $filename);

   ### Input file
   my $infile = new FileHandle($filename, "r") or $log->logcroak("Cannot open $filename - $!");
   binmode $infile;

   ### Output file
   my $file = new FileHandle($filename_output, "w") or $log->logcroak("Cannot open $filename_output - $!");

   ### XML Writer object
   my $writer = XML::Writer->new(OUTPUT => $file, DATA_MODE=>1, DATA_INDENT=>2);

   ### Write the start of the file
   $writer->xmlDecl("UTF-8");
   $self->_stylesheetDecl($writer);
   $writer->startTag("cdrs");

   ### Convert the file into CSV format
   my $bin;
   my $i = 0;
   my $recordCount = 0;

   while ($infile->read($bin, 4)) {
      $i++;

      ### Read the Call Data Block
      my ($cdbTag, $length) = unpack("n2", $bin);
      $infile->read($bin, $length);

      ### Decode the Call Data Elements
      # TLV format : Tag, Length, Value
      my %cde  = unpack("(n n/a*)*", $bin);

      ### Dump the CDB record
      $log->debug("CDB Record:\n", { filter => \&Dump, value  => [$cdbTag, \%cde] });

      ### Start the "cdb" block
      $writer->startTag("cdb", tag => $cdbTag, name => $self->_decodeCDB($cdbTag));

      foreach my $cdeTag ( sort keys %cde ) {
         my ($value, $name, $raw) = $self->_decodeCDE($cdeTag, $cde{$cdeTag});

		 if (defined $raw) {
            $writer->dataElement("cde", $value, tag=>$cdeTag, name=>$name, raw=>$raw);
		 }
		 else {
            $writer->dataElement("cde", $value, tag=>$cdeTag, name=>$name);
		 }
      }

      ### End "cdb" block
      $writer->endTag("cdb");

      ### Read number of records from Footer record
      if ($cdbTag == 1100) {
         ($recordCount) = $self->_decodeCDE(6003, $cde{6003});
      }
   }

   ### Audit check
   if ($i != $recordCount) {
      $log->logcroak("Footer does not match number of records");
   }

   ### Cleanup
   $infile->close;
   $writer->endTag("cdrs");
   $file->print("\n");
   $file->close;
}

#-------------------------------------------------------------

=head1 AUTHOR

Mark O'Connor, C<<  >>

=head1 BUGS

Please report any bugs or feature requests to
C, or through the web interface at
L.
I will be notified, and then you'll automatically be notified of progress on
your bug as I make changes.

=head1 SUPPORT

You can find documentation for this module with the perldoc command.

    perldoc Convert::Cisco

You can also look for information at:

=over 4

=item * AnnoCPAN: Annotated CPAN documentation

L

=item * CPAN Ratings

L

=item * RT: CPAN's request tracker

L

=item * Search CPAN

L

=back

=head1 ACKNOWLEDGEMENTS

=head1 COPYRIGHT & LICENSE

Copyright 2007 Mark O'Connor, all rights reserved.

This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.

=cut

1; # End of Convert::Cisco

__DATA__