libs/Getopt/Easy.pm

## ------------------------------------------------------------------------
##  $Id: Simple.pm,v 1.4 2002/12/28 07:55:26 joko Exp $
## ------------------------------------------------------------------------
##  $Log: Simple.pm,v $
## ------------------------------------------------------------------------


package Getopt::Easy;

use strict;
use warnings;

use base qw( DesignPattern::Object );


use Data::Dumper;
#use Getopt::Long;
use Hash::Merge qw( merge );

# TODO: remember last used behaviour and restore to it after usage
Hash::Merge::set_behavior( 'RIGHT_PRECEDENT' );


sub merge_defaults {
  my $self = shift;
  my $defaults = shift;
  my $prefs = {};
  $self->{_meta} = merge($prefs, $defaults);
}

sub merge_cli_arguments {
  my $self = shift;
  #my $prefs = $self->{_meta};
  #print Dumper($self->{_meta});
  # read arguments from cli
  #my $settings = {};
  my $settings_tmp = {};
  #my $args = [];
  my $args;
  while (my $arg = shift @ARGV) {
    next if !$arg;
    if ($arg =~ m/^--(\w+)(=.+?)??$/) {
      my $val = $2;
      if ($val) {
        $val =~ s/^=//;
      } else {
        $val = 1;
      }
      $settings_tmp->{options}->{$1} = $val;
      next;
    }
    #push @{$settings_tmp->{args}}, $arg;
    push @{$args}, $arg;
  }
  #print Dumper($settings_tmp);
  my $new = merge($self->{_meta}, $settings_tmp);
  $new->{args} = $args if $args;
  #print Dumper($new);
  #return $new;
  $self->{_meta} = $new;
}

sub getOptions {
  my $self = shift;
  return $self->{_meta};
}

1;
1	joko	1.1	## ------------------------------------------------------------------------
2			## $Id: Simple.pm,v 1.4 2002/12/28 07:55:26 joko Exp $
3			## ------------------------------------------------------------------------
4			## $Log: Simple.pm,v $
5			## ------------------------------------------------------------------------
6
7
8			package Getopt::Easy;
9
10			use strict;
11			use warnings;
12
13			use base qw( DesignPattern::Object );
14
15
16			use Data::Dumper;
17			#use Getopt::Long;
18			use Hash::Merge qw( merge );
19
20			# TODO: remember last used behaviour and restore to it after usage
21			Hash::Merge::set_behavior( 'RIGHT_PRECEDENT' );
22
23
24			sub merge_defaults {
25			my $self = shift;
26			my $defaults = shift;
27			my $prefs = {};
28			$self->{_meta} = merge($prefs, $defaults);
29			}
30
31			sub merge_cli_arguments {
32			my $self = shift;
33			#my $prefs = $self->{_meta};
34			#print Dumper($self->{_meta});
35			# read arguments from cli
36			#my $settings = {};
37			my $settings_tmp = {};
38			#my $args = [];
39			my $args;
40			while (my $arg = shift @ARGV) {
41			next if !$arg;
42			if ($arg =~ m/^--(\w+)(=.+?)??$/) {
43			my $val = $2;
44			if ($val) {
45			$val =~ s/^=//;
46			} else {
47			$val = 1;
48			}
49			$settings_tmp->{options}->{$1} = $val;
50			next;
51			}
52			#push @{$settings_tmp->{args}}, $arg;
53			push @{$args}, $arg;
54			}
55			#print Dumper($settings_tmp);
56			my $new = merge($self->{_meta}, $settings_tmp);
57			$new->{args} = $args if $args;
58			#print Dumper($new);
59			#return $new;
60			$self->{_meta} = $new;
61			}
62
63			sub getOptions {
64			my $self = shift;
65			return $self->{_meta};
66			}
67
68			1;
MailToCvsAdmin">MailToCvsAdmin	ViewVC Help
Powered by ViewVC 1.1.26