File Coverage

blib/lib/Splunklib/Intersplunk.pm

Criterion	Covered	Total	%
statement	18	100	18.0
branch	0	24	0.0
condition	0	9	0.0
subroutine	6	12	50.0
pod	4	4	100.0
total	28	149	18.7

#
# $Id: Intersplunk.pm,v e46bf13852d9 2015/10/03 10:12:28 gomor $
#
package Splunklib::Intersplunk;
use strict;
use warnings;

use base qw(Exporter);
our @EXPORT_OK = qw(readResults outputResults);

use Data::Dumper;
use Text::CSV_XS;
use URI::Escape;

#
# Intersplunk format
#
# Converted from /opt/splunk/lib/python2.7/site-packages/splunk/Intersplunk.py
# readResults() and outputResults() function.
#

sub _csv_reader {
   my $csvr = Text::CSV_XS->new({
      binary => 1,
      sep_char => ',',
      #allow_loose_escapes => 1,
   });
   if (! defined($csvr)) {
      # XXX: error handler
      return;
   }

   return $csvr;
}

sub _csv_writer {
   my ($ary, $stdout) = @_;

   my $results = $ary->[0];
   my $header = $ary->[1];
   my $lookup = $ary->[2];

   my $csv = Text::CSV_XS->new({
      binary => 1,
      sep_char => ',',
   }) or die "Cannot use CSV: ".Text::CSV->error_diag();

   # Header
   $csv->print($stdout, $header);
   print $stdout "\n";

   # Content
   for my $result (@$results) {
      $csv->print($stdout, $result);
      print $stdout "\n";
   }

   return 1;
}

sub getEncodedMV {
   my ($s) = @_;

   # XXX: TODO

   return 1;
}

sub decodeMV {
   my ($s, $vals) = @_;

   # XXX: TODO

   if (! length($s)) {
      return;
   }

   my $tok = '';
   my $inval = 0;

   # XXX: todo
   #my $i = 0;
   #while ($i < length($s)) {
      #if (! $inval) {
         #if (
      #}
   #}

   return 1;
}

sub readResults {
   my ($stdin, $settings, $has_header) = @_;

   $settings ||= {};   # No settings by default
   $has_header ||= 1;  # Header by default

   if ($has_header) {
      while (my $line = <$stdin>) {
         chomp($line);
         last if $line =~ /^\s*$/;
         $line = URI::Escape::uri_unescape($line);
         my ($k, $v) = split(/:/, $line);
         $settings->{$k} = $v;
      }
   }

   #print Dumper($settings)."\n";

   my $csvr = _csv_reader();

   my $results = [];
   my $header = [];
   my $first = 1;
   my @mv_fields = ();
   my $lookup = {};
   while (my $line = $csvr->getline($stdin)) {
      if ($first) {
         $header = $line;
         $first = 0;

         # Check which fields are multivalued (for a field 'foo', '__mv_foo' also exists)
         my %h_header = map { $_ => 1 } @$header;
         for my $field (@$header) {
            if (exists($h_header{"__mv_$field"})) {
               push @mv_fields, $field;
            }
         }

         next;
      }

      # need to maintain field order
      #tie(my %result, 'Tie::IxHash');
      #my %result, 'Tie::IxHash';
      #my $i = 0;
      #for my $val (@$line) {
         #$result{$header->[$i]} = $val;
         #$i++;
      #}
      my $pos = 0;
      for my $hdr (@$header) {
         $lookup->{$hdr} = $pos;
         $pos++;
      }
      my $result = $line;

      for my $key (@mv_fields) {
         my $mv_key = "__mv_$key";
         #if (exists($result{$key}) && exists($result{$mv_key})) {
         if (exists($result->[$lookup->{$key}]) && exists($result->[$lookup->{$mv_key}])) {
            # Expand the value of __mv_[key] to a list, store it in key, and delete __mv_[key]
            my $vals = [];
            #if (decodeMV($result{$mv_key}, $vals)) {
            if (decodeMV($result->[$lookup->{$mv_key}], $vals)) {
               #$result{$key} = $vals;
               #if (@{$result{$key}} == 1) {
                  #$result{$key} = $result{$key}->[0];
               #}
               #delete $result{$mv_key};
               # XXX: todo
            }
         }
      }

      #print Dumper($line)."\n";
      #print Dumper(\%result)."\n";

      #push @$results, \%result;
      push @$results, $result;
   }

   #print Dumper($header)."\n";
   #print Dumper($results)."\n";

   return [ $results, $header, $lookup ];
}

sub outputResults {
   my ($ary, $messages, $fields, $mvdelim, $stdout) = @_;

   $mvdelim ||= '\n';

   my $results = $ary->[0];
   my $header = $ary->[1];
   my $lookup = $ary->[2];

   if (defined($messages)) {
      # message header is everything before the first empty line, similar to the input
      # header format.  also key = value, with stripping of whitespace
      for my $level (keys %$messages) {
         printf("%s=%s\n", $level, $messages->{$level});
      }
      print "\n";
   }

   if (@$results == 0) {
      return;
   }

   my $s = {};
   my $l = [];
   # Check each entry to see if it is a list (multivalued).
   # If so, set the multivalued key to the proper encoding.
   # Replace the list with a newline separated string of the values.
   for my $result (@$results) {
      #for my $key (keys %$result) {
      for my $key (@$result) {
         # XXX: todo
         #if (ref($result->{$key}) eq 'ARRAY') {
            #$result->{"__mv_$key"} = getEncodedMV($result->{$key});
            #$result->{$key} = join($mvdelim, @{$result->{$key}});
         #}

         #if (! exists($s->{$key})) {
            #$s->{$key} = 1;
            #push @$l, $key;
         #}
      }
   }

   my $h;
   if (! $fields) {
      $h = $header;
   }
   else {
      $h = $fields;
   }

   #print Dumper($h)."\n";
   #print Dumper($results)."\n";

   _csv_writer($ary, $stdout);

   return 1;
}

1;

__END__