File: Foo.pm

package info (click to toggle)
libgetopt-ex-hashed-perl 1.0601-2
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid, trixie
  • size: 312 kB
  • sloc: perl: 408; makefile: 2
file content (135 lines) | stat: -rw-r--r-- 3,178 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
package App::Foo;

use v5.14;
use warnings;
use Data::Dumper;

use Getopt::EX::Hashed;

# DEFAULT: is => 'ro' / 'rw'
if (our $ACCESSOR_DEFAULT_RO) {
    Getopt::EX::Hashed->configure(DEFAULT => [ is => 'ro' ]);
}
if (our $ACCESSOR_DEFAULT_RW) {
    Getopt::EX::Hashed->configure(DEFAULT => [ is => 'rw' ]);
}
if (our $ACCESSOR_DEFAULT_ERROR1) {
    Getopt::EX::Hashed->configure(DEFAULT => 'rw' );
}
if (our $ACCESSOR_DEFAULT_ERROR2) {
    Getopt::EX::Hashed->configure(DEFAULT => [ 'rw' ]);
}

if (defined our $REPLACE_UNDERSCORE) {
    Getopt::EX::Hashed->configure(REPLACE_UNDERSCORE => $REPLACE_UNDERSCORE);
}
if (defined our $REMOVE_UNDERSCORE) {
    Getopt::EX::Hashed->configure(REMOVE_UNDERSCORE => $REMOVE_UNDERSCORE);
}

our $DEFAULT = 99;
our $ind_1;
our $ind_2;

has string   => ( spec => '=s' );
has say      => ( spec => '=s', default => "Hello" );
has number   => ( spec => '=i' );
has implicit => ( spec => ':42' );
has start    => ( spec => '=i s begin' );
has finish   => ( spec => '=i f end' );
has tricia   => ( spec => 'trillian=s' );
has zaphord  => ( spec => '', alias => 'beeblebrox' );
has so_long  => ( spec => '' );
has list     => ( spec => '=s@' );
has hash     => ( spec => '=s%' );
has lazy     => ( spec => ''), default => sub { $DEFAULT };
has default  => ( spec => ''), default => $DEFAULT;
has ind_1 => ( spec => '=i'), default => \$ind_1;
has ind_2 => ( spec => '=i'), default => \$ind_2;

# imcremental coderef
has [ qw( left right both ) ] => ( spec => '=i' );
has '+both' => action => sub {
    $_->{left} = $_->{right} = $_[1];
};

# action
has android => ;
has paranoid => spec => '=s',
		action => sub { $_->{android} = $_[1] };

# is => 'ro'
if (our $ACCESSOR_RO) {
    has [ qw(
	+string +say +number +implicit +start +finish +tricia +zaphord +so_long +list +hash 
	+left +right +both
	+android +paranoid
    ) ] => is => 'ro' ;
}

# erroneous incremental usage: live or die?
if (our $WRONG_INCREMENTAL) {
    has '+no_no_no' => default => 1;
}

# default/action co-exist
if (our $DEFAULT_AND_ACTION) {
    has [ 'restaurant', 'shop' ] =>
	spec => '=s',
	default => "Pizza Hat",
	action  => sub {
	    my($name, $s) = @_;
	    $_->{$name} = "$s at the end of universe.";
       	};
}

if (our $TAKE_IT_ALL) {
    has ARGV => default => [];
    has '<>' => action => sub {
	push @{$_->{ARGV}}, $_[0];
    };
}

no Getopt::EX::Hashed;

sub run {
    my $app = shift;
    local @ARGV = @_;
    use Getopt::Long;
    $app->getopt or die;
    return @ARGV;
}

1;

package App::Bar;

use v5.14;
use warnings;
use Data::Dumper;

use Getopt::EX::Hashed;

has string   => ( spec => '=s' );
has say      => ( spec => '=s', default => "Hello" );
has number   => ( spec => '=i' );
has implicit => ( spec => ':42' );
has start    => ( spec => '=i s begin' );
has finish   => ( spec => '=i f end' );
has tricia   => ( spec => 'trillian=s' );
has zaphord  => ( spec => '', alias => 'beeblebrox' );
has so_long  => ( spec => '' );
has list     => ( spec => '=s@' );
has hash     => ( spec => '=s%' );

no Getopt::EX::Hashed;

sub run {
    my $app = shift;
    local @ARGV = @_;
    use Getopt::Long;
    $app->getopt or die;
    return @ARGV;
}

1;