The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package App::Unliner::Language;

use common::sense;

use Carp;
use Digest::SHA1;
use Getopt::Long;

use App::Unliner::Util;
use App::Unliner::Grammar;
use App::Unliner::Grammar::PostProc;



our $registry = {
  sh => 'App::Unliner::Language::Shell',
  exec => 'App::Unliner::Language::Exec',
  perl => 'App::Unliner::Language::Perl',
  python => 'App::Unliner::Language::Python',
};




sub render_as_pipeline {
  my ($class, %args) = @_;

  my $self = \%args;
  bless $self, $class;

  $self->parse_args();
  $self->process_tt();
  $self->process();

  return $self->construct_pipeline();
}


sub construct_pipeline {
  my ($self) = @_;

  my $body_digest = Digest::SHA1::sha1_hex($self->{def_body});

  my $dir = App::Unliner::Util::get_temp_dir();

  my $filename = "$dir/$body_digest";
  open(my $fh, '>', $filename) || die "couldn't write temp file: $!";
  print $fh $self->{def_body};
  close($fh);

  my $command_to_run = $self->command_to_run();

  if (!ref $command_to_run) {
    $command_to_run = [ $command_to_run ];
  }

  return [{
           shell_arg => [
             @{ $command_to_run },
             $filename,
             @{ $self->{argv} },
           ],
           env => $self->{def_modifiers}->{args}->{env} ? $self->{context} : {},
         }];
}



sub parse_args {
  my ($self) = @_;


  $self->{context} = {};

  foreach my $prototype_elem (@{ $self->{def_prototype}->{prototype_elem} }) {
    if (exists $prototype_elem->{shell_arg}) {
      my $arg_name = $prototype_elem->{get_opt_arg};
      $arg_name = $1 if $arg_name =~ /^([\w-]+)/;

      my $default_value = App::Unliner::Grammar::PostProc::arg($prototype_elem->{shell_arg});

      $self->{context}->{$arg_name} = $default_value;
    }
  }


  if ($self->{def_modifiers}->{args}->{'pass-through'} || $self->{def_modifiers}->{args}->{pass_through}) {
    $self->getopt_config('pass_through');
  } else {
    $self->getopt_config();
  }

  my @get_opt_args;

  foreach my $prototype_elem (@{ $self->{def_prototype}->{prototype_elem} }) {
    push @get_opt_args, $prototype_elem->{get_opt_arg};
  }

  $self->getopt_from_array($self->{argv}, $self->{context}, @get_opt_args);
}


sub process_tt {
  my ($self) = @_;

  return unless $self->{def_modifiers}->{args}->{template};

  require Template;

  my $template = Template->new;

  my $context = {};

  foreach my $k (keys %{ $self->{context} }) {
    my $transformed_k = $k;
    $transformed_k =~ s/-/_/g;
    $context->{$transformed_k} = $self->{context}->{$k};
  }

  my $output;

  $template->process(\$self->{def_body}, $context, \$output)
    || die $template->error();

  $self->{def_body} = $output;
}



sub command_to_run {
  die "override me";
}

sub process {
}




## Too bad we can't use GetOpt long's OO interface because it doesn't expose getoptionsfromarray

sub getopt_config {
  my ($self, @more_config) = @_;

  ## This is unix-style setup

  Getopt::Long::Configure('default', 'bundling', 'no_ignore_case', 'no_auto_abbrev', @more_config);
}


sub getopt_from_array {
  my ($self, $argv, $context, @get_opt_args) = @_;

  Getopt::Long::GetOptionsFromArray($argv, $context, @get_opt_args)
    || croak "arg parsing failed for def " . $self->{def_name};
}


sub get_argv {
  my ($self) = @_;

  my @argv = @{ $self->{def_modifiers}->{args}->{$self->command_to_run()} };

  return \@argv;
}



1;