#!/usr/bin/perl

use strict;
use warnings;
use feature 'say';
use Getopt::Long;
use Pod::Usage;
use Carp;

=head1 SYNOPSIS

Convert CSV file to JSON file as a filter.
eflconvert < input.csv > output.json
[ -h | --help | -? ] help
[ -v | -- version ] version
[ -s | --sample] <commands|server> print sample data
[ -d | --delimitier] '<delimiter regex>' defaults to ';;'
[ -a | --array_delimitier] '<delimiter regex>' defaults to ','
[ -b | --bundle] <bundle name> convert file for this EFL bundle
[ -o | --output] csv|json|yaml Convert to this format
[ -i | --input] csv|json|yaml Convert from this format

Use perldoc to see full documentation.

=head1 DESCRIPTION

Any commas found in a field and program will treat field as an array.

=head1 EXAMPLES

Read a csv file and output a JSON file:

  # context     ;; command                            ;; useshell       ;; module ;; ifelapsed ;; promisee
  am_policy_hub ;; ${sys.workdir}/modules/cf-manifest ;; noshell      ;; false  ;;         1 ;; efl_update for cfengine
  backup_host ;; /usr/local/bin/backup              ;; nohell         ;; false  ;;         1 ;; my backups

  eflconvert -b efl_command -i csv -o json < efl_command.txt > efl_command.json

  cat efl_command.json
  [
   {
      "context"   : "am_policy_hub",
      "command"   : "${sys.workdir}/modules/cf-manifest",
      "useshell"  : "noshell",
      "module"    : "false",
      "ifelapsed" : "1",
      "promisee"  : "efl_update for cfengine"
   },
   {
      "context"   : "backup_host",
      "command"   : "usr/local/bin/backup",
      "useshell"  : "noshell",
      "module"    : "false",
      "ifelapsed" : "1",
      "promisee"  : "my  backups"
   }
   ]

   Show bundles currently support. If yours is missing assume it's WIP.

   eflconvert -b all

=head2 Using sample data

Show sample data for efl_command bundle.
   eflconvert -s efl_command

=head1 VERSION

1.0

=head1 SEE ALSO

=head1 AUTHOR

Neil H. Watson, neil@watson-wilson.ca

=head1 COPYRIGHT and LICENSE

Copyright 2016 Neil H. Watson

This program is free software: you can redistribute it and/or modify it under
the terms of the GNU General Public License as published by the Free Software
Foundation, either version 3 of the License, or (at your option) any later
version.

This program is distributed in the hope that it will be useful, but WITHOUT ANY
WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
PARTICULAR PURPOSE.  See the GNU General Public License for more details
<http://www.gnu.org/licenses/>.

=cut

# Sample data
my %sample;
$sample{efl_command} = <<'END';
# For efl_command bundle, header must match new json bundle requirements
#  context     ;; command                            ;; useshell       ;; module ;; ifelapsed ;; promisee
  am_policy_hub ;; ${sys.workdir}/modules/cf-manifest ;; noshell      ;; false  ;;         1 ;; efl_update for cfengine
  backup_host ;; /usr/local/bin/backup              ;; nohell         ;; false  ;;         1 ;; my backups
END

my %headers = (
   'efl_main'              => [ qw/ class promiser bundle ifelapsed parameter promisee / ],
   'efl_command'           => [ qw/ class command useshell module ifelapsed promisee / ],
   'efl_server'            => [ qw/ class path admit promisee / ],
   'efl_class_returnszero' => [ qw/ class class_to_set command shell zero promisee / ],
   'efl_test_classes'      => [ qw/ class class_to_test test_type name / ],
   'efl_test_vars'         => [ qw/ class var_to_test test_case test_type name / ],
   'efl_global_slists'     => [ qw/ class name contents shuffle promisee / ],
   'efl_dump_strings'      => [ qw/ class name promisee / ],
   'efl_global_strings'    => [ qw/ class name value promisee / ],
   'efl_class_cmd_regcmp'  => [ qw/ class class_to_set expression command useshell regex promisee / ],
   'efl_class_expression'  => [ qw/ class_to_set expression promisee / ],
   'efl_class_classmatch'  => [ qw/ class_to_set regex promisee / ],
   'efl_class_iprange'     => [ qw/ class_to_set ip_range promisee / ],
   'efl_sysctl_live'       => [ qw/ class variable value promisee / ],
   'efl_sysctl_conf_file'  => [ qw/ class variable value promisee / ],
   'efl_link'              => [ qw/ class link_name target link_type promisee / ],
   'efl_delete_files'      => [ qw/ class file_promiser recurse_level leaf_regex negate_match file_age promisee / ],
   'efl_copy_files'        => [ qw/ class file_promiser leaf_regex file_source server encrypt mode owner group promisee / ],
   'efl_packages_via_cmd'  => [ qw/ class package_policy package_name package_version architecture promisee / ],
   'efl_packages_new'      => [ qw/ class package_policy package_name package_version architecture promisee / ],
   'efl_packages'          => [ qw/ class package_policy package_name package_version architecture promisee / ],
   'efl_start_service'     => [ qw/ class process_regex restart_cmd promisee / ],
   'efl_service_recurse'   => [ qw/ class process_regex config_dir config_dir_src server encrypt mode owner group restart_cmd promisee / ],
   'efl_service'           => [ qw/ class process_regex config_file config_file_src server template encrypt mode owner group restart_cmd promisee / ],
   'efl_edit_template'     => [ qw/ class promiser_file template server mode owner group promisee / ],
   'efl_enable_service'    => [ qw/ class service promisee / ],
   'efl_disable_service'   => [ qw/ class service promisee / ],
   'efl_file_perms'        => [ qw/ class file_promiser recurse_level leaf_regex negate mode owner group promisee / ],
   'efl_rcs_pull'          => [ qw/ class update_cmd checkout_cmd dest_dir mode owner group promisee / ],
);

my $opt;

=head2 SUBS

=head3 _get_cli_args
Read in command line args.
=cut
sub _get_cli_args
{
# Get command options and switches
   my %opt;
   $opt{delimiter} = ';;';
   $opt{array_delimiter} = ',';
   $opt{bundle} = 'efl_command';

   GetOptions (
      \%opt,
      'help|?',
      'version',
      'delimiter=s',
      'array_delimiter=s',
      'sample=s',
      'bundle=s',
      'input=s',
      'output=s'
      ) or croak "Error in GetOptions [$!]";

   return \%opt;
}

=head3 _validate_args
Validate command line args.
=cut
sub _validate_args
{
   if ( $opt->{bundle} && $opt->{bundle} eq 'all' )
   {
      print "$_\n" for keys %headers;
      exit;
   }

   for my $bundle ( qw/ enable disable / )
   {
      if ( exists $opt->{bundle} and $opt->{bundle} eq "efl_chkconfig_${bundle}_service" )
      {
         carp "Bundle $opt->{bundle} has been replaceed with efl_${bundle}_service";
      }
   }

   if ( $opt->{bundle}  && ! grep { m/^$opt->{bundle}$/ } keys %headers )
   {
      usage({ msg => "Wrong or missing bundle name: $opt->{bundle}", exit => 3 });
   }

   # Wrap delimiter in whitespace to remove it from the fields
   $opt->{delimiter}       = qr/\s*$opt->{delimiter}\s*/;
   $opt->{array_delimiter} = qr/\s*$opt->{array_delimiter}\s*/;
   
   if ( defined $opt->{input} and defined $opt->{output} )
   {
      my @input_output = qw/ yaml yml json csv /;
      for my $x ( qw/ input output / )
      {
         if ( !grep { m/\A $opt->{$x} \Z/x } @input_output )
         {
            usage({ msg => "Invalid $x string: [$opt->{$x}]", exit => 4});
         }
      }
   }
   else
   {
      usage({ msg => "Missing input/output options", exit => 5});
   }
   return 1;
}

=head3 usage
Prints usage and exits
=cut
sub usage {
   my ( $arg ) = shift;

   # defaults
   #          If option given      Then use       Or default
   my $msg  = defined $arg->{msg}  ? $arg->{msg}  : '';
   my $exit = defined $arg->{exit} ? $arg->{exit} : '';

   pod2usage(
      -verbose  => 99,
      -sections =>"SYNOPSIS",
      -msg      => $msg,
      -ext      => $exit,
   );
   return;
}

##########################
# Main matter here

$opt = _get_cli_args();

if ( $opt->{help} ) { usage(); exit; }

if ( $opt->{version} ) { pod2usage(-verbose=>99, -sections=>"VERSION" ) }

if ( $opt->{sample} ) {

   if ( $sample{$opt->{sample}} )
   {
      print $sample{$opt->{sample}}; exit; 
   }
   else
   {
      usage("Wrong sample arg: $opt->{sample}" );
      exit 2;
   }
}

_validate_args();

# TODO needs a test suite?
#
my $d = EFL::Convert->new({
      input => $opt->{input},
      headers => $headers{ $opt->{bundle} }
   });

my $data;
$data = $d->to_json if $opt->{output} eq 'json';
$data = $d->to_yaml if $opt->{output} eq 'yaml';
$data = $d->to_csv  if $opt->{output} eq 'csv';

say $data;

package EFL::Convert;

=head1 PACKAGE EFL::Convert

=head2 SYNOPSIS

This package is overs an OO approach to converting EFL data files. Normal users
do not need to know how this works.

=cut

use strict;
use warnings;
use JSON qw/ decode_json encode_json /;
use YAML;
use Carp;
use Data::Dumper;

sub new
{
   my ( $class, $arg ) = @_;

   my $type    = $arg->{input};
   my $headers = $arg->{headers};

   croak "Wrong input type" unless $type =~ m/ csv | json | yaml | yml /ix;

   $type = lc( $type );
   $type = 'yaml' if $type eq 'yml';

   my %types = (
      yaml => \&_read_yaml,
      csv  => \&_read_csv,
      json => \&_read_json,
   );

   $arg->{data} = $types{$type}->( $headers );

   my $self = bless $arg, $class;
   return $self;
}

=head2 METHODS

=head3 to_json
Converts data to json
=cut
sub to_json
{
   my $self = shift;
   my $j = JSON->new->pretty;
   return $j->encode( $self->{data} );
}

=head3 to_yaml
Converts data to yaml.
=cut
sub to_yaml
{
   my $self = shift;
   return Dump $self->{data};
}

=head3 to_csv
Converts data to csv. Not supported because why bother when YAML is nicer?
=cut
sub to_csv
{
   my $self = shift;
   return "Converting to csv currently not supported. Use yaml instead.";
}

=head2 SUBS

Subs that this packages uses, but are not called as methods

=head3 _read_json
Reads json from stdin and converts to a Perl data structure.
=cut
sub _read_json
{
   my $json_string = join "\n", @{ _read_stdin() };
   return decode_json( $json_string );
}

=head3 _read_yaml
Reads yaml from stdin and converts to a Perl data structure.
=cut
sub _read_yaml
{
   my $yml_string = join "\n", @{ _read_stdin() };
   return Load $yml_string;
}

=head3 _read_csv
Reads csv from stdin and converts to a Perl data structure.
=cut
sub _read_csv
{
   my $headers = shift;
   my ( $lines ) = _read_stdin();
   my @data;

   # This will produce an array of hashes, possibly witn another array if hash
   # contains an array e.g. myslist ;; value1, value2, value3, valuen+1
   
   for my $l ( @{ $lines } )
   {
      # Stip leading whitespace
      $l =~ s/\A\s*//g;

      my $hash = {};

      my $i = 0;
      my @fields = split m/$opt->{delimiter}/, $l;
      for my $f ( @fields )
      {
         # If field is an array e.g. one, two, three.
         if ( $f =~ m/$opt->{array_delimiter}/
               and $opt->{bundle} eq 'efl_global_slists'
               and $headers->[$i] ne 'promisee' )
         {
            my @array = split m/$opt->{array_delimiter}/, $f;
            push @{ $hash->{ $headers->[$i] } }, @array;
         }
         else
         {
            $hash->{ $headers->[$i] } = $f;
         }
         $i++;
      }
      push @data, $hash;
   }
   return \@data;
}

=head3 _read_stdin
Read data, csv, json, or yaml from STDIN.
=cut
sub _read_stdin
{
   my @input_data;
   while ( my $line = <>)
   {
     chomp $line;

     # Remove in line comments.
     $line =~ s/\s#.*?$//g;

     # Remove new line, carrage returns in case it is a windows file, or any
     # trailing white space
     $line =~ s/[\n\r\s]$//;

     # Skip comment lines.
     next if $line =~ m/^#/;

     # Skip whitespace lines.
     next if $line =~ m/\A\s*\Z/;

     push @input_data, $line
   }
   return \@input_data;
}
1;
