# build_parser.pl

use strict;
use warnings;

use Parse::RecDescent qw( );

my $grammar = <<'__END_OF_GRAMMAR__';
    {
        # Lexical pragmas and lexcial variables
        # here are in the same scope as the sub
        # created for each grammar rule.

        use strict;
        use warnings;

        my %KNOWN_COMMANDS = map { $_ => 1 } qw(
           hap hccmrg hup hspp hpp hpg hdp hdlp hcp
        );
    }

    parse   : cmdline /\Z/ { $item[1] }

    cmdline : pkgcmd opt(s?) { [ @item[1,2] ] }

    pkgcmd  : IDENT pkgcmd_[ $item[1] ] { $item[1] }
    pkgcmd_ : { $KNOWN_COMMANDS{$arg[0]} }
            | <error:Unknown command>

    opt     : FLAG opt_ { [ @item[1,2] ] }
    opt_    : IDENT
            | { 1 }

    FLAG    : /-\w+/
    IDENT   : /\w+/

__END_OF_GRAMMAR__

Parse::RecDescent->Precompile($grammar, 'Parser')
   or die("Bad Grammar\n");

##</code><code>##

# Deparse.pm

use strict;
use warnings;

package Deparser;

my $skip = ' ';

sub add_skip {
   if (length($_[0])) {
      return $skip . $_[0];
   } else {
      return '';
   }
}

sub loop(&@) {
   my $cb = shift(@_);
   return join $skip, map { $cb->() } @_;
}

sub deparse {
   &cmdline
}

sub cmdline {
   my ($node) = @_;
   my ($pkgcmd, $opts) = @$node;
   my $text = pkgcmd($pkgcmd);
   $text .= add_skip(loop { opt($_) } @$opts);
   return $text;
}

sub pkgcmd {
   my ($node) = @_;
   return IDENT($node);
}

sub opt {
   my ($node) = @_;
   my ($flag, $val) = @$node;
   my $text = FLAG($flag);
   $text .= add_skip(IDENT($val));
   return $text;
}

sub FLAG  { return $_[0] };
sub IDENT { return $_[0] };

1;

##</code><code>##

# test.pl

use strict;
use warnings;

use Data::Dumper qw( Dumper );

use Parser       qw( );
use Deparser     qw( );

{
   my $parser = Parser->new();

   while (<DATA>) {
      chomp;

      print("Unparsed: $_\n");

      my $tree = $parser->parse($_)
         or do {
               print("Bad data: $_\n");
               next;
            };

      my $dumper = Data::Dumper->new([ $tree ]);
      $dumper->Useqq(1);
      $dumper->Terse(1);
      $dumper->Indent(0);
      print("Parsed:   ", $dumper->Dump(), "\n");

      my $deparsed = Deparser::deparse($tree);

      print("Deparsed: $deparsed\n");
   } continue {
      print("\n");
   }
}

__DATA__
hap -b
hap -b sknxharvest01
hap -b sknxharvest01 -enc testfile.dfo
hap -b sknxharvest01 -usr cgowing -pass chaspass
hap -badflag
hap -prompt
hap -b sknxharvest01 -prompt
hap -prompt -b sknxharvest01

##</code><code>##

>perl build_parser.pl

>perl test.pl
Unparsed: hap -b
Parsed:   ["hap",[["-b",1]]]
Deparsed: hap -b 1

Unparsed: hap -b sknxharvest01
Parsed:   ["hap",[["-b","sknxharvest01"]]]
Deparsed: hap -b sknxharvest01

Unparsed: hap -b sknxharvest01 -enc testfile.dfo
Bad data: hap -b sknxharvest01 -enc testfile.dfo

Unparsed: hap -b sknxharvest01 -usr cgowing -pass chaspass
Parsed:   ["hap",[["-b","sknxharvest01"],["-usr","cgowing"],["-pass","chaspass"]]]
Deparsed: hap -b sknxharvest01 -usr cgowing -pass chaspass

Unparsed: hap -badflag
Parsed:   ["hap",[["-badflag",1]]]
Deparsed: hap -badflag 1

Unparsed: hap -prompt
Parsed:   ["hap",[["-prompt",1]]]
Deparsed: hap -prompt 1

Unparsed: hap -b sknxharvest01 -prompt
Parsed:   ["hap",[["-b","sknxharvest01"],["-prompt",1]]]
Deparsed: hap -b sknxharvest01 -prompt 1

Unparsed: hap -prompt -b sknxharvest01
Parsed:   ["hap",[["-prompt",1],["-b","sknxharvest01"]]]
Deparsed: hap -prompt 1 -b sknxharvest01