t/006_metaclass_traits.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More tests => 173;
   7 use Test::Moose;
   8
   9 BEGIN {
  10     use_ok('MooseX::Getopt');
  11 }
  12
  13 {
  14     package App;
  15     use Moose;
  16
  17     with 'MooseX::Getopt';
  18
  19     has 'data' => (
  20         traits    => [ 'MooseX::Getopt::Meta::Attribute::Trait' ],
  21         is        => 'ro',
  22         isa       => 'Str',
  23         default   => 'file.dat',
  24         cmd_flag  => 'f',
  25     );
  26
  27     has 'cow' => (
  28         traits      => [ 'Getopt' ],
  29         is          => 'ro',
  30         isa         => 'Str',
  31         default     => 'moo',
  32         cmd_aliases => [qw/ moocow m c /],
  33     );
  34
  35     has 'horse' => (
  36         traits      => [ 'Getopt' ],
  37         is          => 'ro',
  38         isa         => 'Str',
  39         default     => 'bray',
  40         cmd_flag    => 'horsey',
  41         cmd_aliases => 'x',
  42     );
  43
  44     has 'length' => (
  45         is      => 'ro',
  46         isa     => 'Int',
  47         default => 24
  48     );
  49
  50     has 'verbose' => (
  51         is     => 'ro',
  52         isa    => 'Bool',
  53     );
  54
  55     has 'libs' => (
  56         is      => 'ro',
  57         isa     => 'ArrayRef',
  58         default => sub { [] },
  59     );
  60
  61     has 'details' => (
  62         is      => 'ro',
  63         isa     => 'HashRef',
  64         default => sub { {} },
  65     );
  66
  67     has '_private_stuff' => (
  68         is      => 'ro',
  69         isa     => 'Int',
  70         default => 713
  71     );
  72
  73     has '_private_stuff_cmdline' => (
  74         traits    => [ 'Getopt' ],
  75         is        => 'ro',
  76         isa       => 'Int',
  77         default   => 832,
  78         cmd_flag  => 'p',
  79     );
  80
  81 }
  82
  83 foreach my $attr_name (qw(data cow horse _private_stuff_cmdline)) {
  84     my $attr = App->meta->get_attribute($attr_name);
  85     isa_ok($attr, 'Moose::Meta::Attribute');
  86     does_ok($attr, 'MooseX::Getopt::Meta::Attribute::Trait');
  87
  88     can_ok($attr, 'cmd_flag');
  89     can_ok($attr, 'cmd_aliases');
  90 }
  91
  92 foreach my $parser_name (qw(MooseX::Getopt::Parser::Long MooseX::Getopt::Parser::Descriptive)) {
  93     SKIP: {
  94         if ($parser_name eq 'MooseX::Getopt::Parser::Descriptive') {
  95             eval { require Getopt::Long::Descriptive };
  96             skip "Getopt::Long::Descriptive not installed", 78 if $@;
  97         }
  98
  99         {
 100             local @ARGV = ();
 101
 102             my $parser = $parser_name->new;
 103             isa_ok($parser, $parser_name);
 104
 105             my $getopt = MooseX::Getopt::Session->new( parser => $parser );
 106             isa_ok($getopt, 'MooseX::Getopt::Session');
 107
 108             my $app = App->new_with_options( getopt => $getopt );
 109             isa_ok($app, 'App');
 110
 111             ok(!$app->verbose, '... verbosity is off as expected');
 112             is($app->length, 24, '... length is 24 as expected');
 113             is($app->data, 'file.dat', '... data is file.dat as expected');
 114             is_deeply($app->libs, [], '... libs is [] as expected');
 115             is_deeply($app->details, {}, '... details is {} as expected');
 116         }
 117
 118         {
 119             local @ARGV = ('--verbose', '--length', 50);
 120
 121             my $parser = $parser_name->new;
 122             isa_ok($parser, $parser_name);
 123
 124             my $getopt = MooseX::Getopt::Session->new( parser => $parser );
 125             isa_ok($getopt, 'MooseX::Getopt::Session');
 126
 127             my $app = App->new_with_options( getopt => $getopt );
 128             isa_ok($app, 'App');
 129
 130             ok($app->verbose, '... verbosity is turned on as expected');
 131             is($app->length, 50, '... length is 50 as expected');
 132             is($app->data, 'file.dat', '... data is file.dat as expected');
 133             is_deeply($app->libs, [], '... libs is [] as expected');
 134             is_deeply($app->details, {}, '... details is {} as expected');
 135         }
 136
 137         {
 138             local @ARGV = ('--verbose', '-f', 'foo.txt');
 139
 140             my $parser = $parser_name->new;
 141             isa_ok($parser, $parser_name);
 142
 143             my $getopt = MooseX::Getopt::Session->new( parser => $parser );
 144             isa_ok($getopt, 'MooseX::Getopt::Session');
 145
 146             my $app = App->new_with_options( getopt => $getopt );
 147             isa_ok($app, 'App');
 148
 149             ok($app->verbose, '... verbosity is turned on as expected');
 150             is($app->length, 24, '... length is 24 as expected');
 151             is($app->data, 'foo.txt', '... data is foo.txt as expected');
 152             is_deeply($app->libs, [], '... libs is [] as expected');
 153             is_deeply($app->details, {}, '... details is {} as expected');
 154         }
 155
 156         {
 157             local @ARGV = ('--verbose', '--libs', 'libs/', '--libs', 'includes/lib');
 158
 159             my $parser = $parser_name->new;
 160             isa_ok($parser, $parser_name);
 161
 162             my $getopt = MooseX::Getopt::Session->new( parser => $parser );
 163             isa_ok($getopt, 'MooseX::Getopt::Session');
 164
 165             my $app = App->new_with_options( getopt => $getopt );
 166             isa_ok($app, 'App');
 167
 168             ok($app->verbose, '... verbosity is turned on as expected');
 169             is($app->length, 24, '... length is 24 as expected');
 170             is($app->data, 'file.dat', '... data is foo.txt as expected');
 171             is_deeply($app->libs,
 172             ['libs/', 'includes/lib'],
 173             '... libs is [libs/, includes/lib] as expected');
 174             is_deeply($app->details, {}, '... details is {} as expected');
 175         }
 176
 177         {
 178             local @ARGV = ('--details', 'os=mac', '--details', 'name=foo');
 179
 180             my $parser = $parser_name->new;
 181             isa_ok($parser, $parser_name);
 182
 183             my $getopt = MooseX::Getopt::Session->new( parser => $parser );
 184             isa_ok($getopt, 'MooseX::Getopt::Session');
 185
 186             my $app = App->new_with_options( getopt => $getopt );
 187             isa_ok($app, 'App');
 188
 189             ok(!$app->verbose, '... verbosity is turned on as expected');
 190             is($app->length, 24, '... length is 24 as expected');
 191             is($app->data, 'file.dat', '... data is foo.txt as expected');
 192             is_deeply($app->libs, [], '... libs is [] as expected');
 193             is_deeply($app->details,
 194             { os => 'mac', name => 'foo' },
 195             '... details is { os => mac, name => foo } as expected');
 196         }
 197
 198         {
 199             # Test negation on booleans too ...
 200             local @ARGV = ('--noverbose');
 201
 202             my $parser = $parser_name->new;
 203             isa_ok($parser, $parser_name);
 204
 205             my $getopt = MooseX::Getopt::Session->new( parser => $parser );
 206             isa_ok($getopt, 'MooseX::Getopt::Session');
 207
 208             my $app = App->new_with_options( getopt => $getopt );
 209             isa_ok($app, 'App');
 210
 211             ok(!$app->verbose, '... verbosity is turned off as expected');
 212             is($app->length, 24, '... length is 24 as expected');
 213             is($app->data, 'file.dat', '... file is file.dat as expected');
 214             is_deeply($app->libs, [], '... libs is [] as expected');
 215             is_deeply($app->details, {}, '... details is {} as expected');
 216         }
 217
 218         # Test cmd_alias without cmd_flag
 219         {
 220             local @ARGV = ('--cow', '42');
 221
 222             my $parser = $parser_name->new;
 223             isa_ok($parser, $parser_name);
 224
 225             my $getopt = MooseX::Getopt::Session->new( parser => $parser );
 226             isa_ok($getopt, 'MooseX::Getopt::Session');
 227
 228             my $app = App->new_with_options( getopt => $getopt );
 229             isa_ok($app, 'App');
 230             is($app->cow, 42, 'cmd_alias, but not using it');
 231         }
 232         {
 233             local @ARGV = ('--moocow', '88');
 234
 235             my $parser = $parser_name->new;
 236             isa_ok($parser, $parser_name);
 237
 238             my $getopt = MooseX::Getopt::Session->new( parser => $parser );
 239             isa_ok($getopt, 'MooseX::Getopt::Session');
 240
 241             my $app = App->new_with_options( getopt => $getopt );
 242             isa_ok($app, 'App');
 243             is($app->cow, 88, 'cmd_alias, using long one');
 244         }
 245         {
 246             local @ARGV = ('-c', '99');
 247
 248             my $parser = $parser_name->new;
 249             isa_ok($parser, $parser_name);
 250
 251             my $getopt = MooseX::Getopt::Session->new( parser => $parser );
 252             isa_ok($getopt, 'MooseX::Getopt::Session');
 253
 254             my $app = App->new_with_options( getopt => $getopt );
 255             isa_ok($app, 'App');
 256             is($app->cow, 99, 'cmd_alias, using short one');
 257         }
 258
 259         # Test cmd_alias + cmd_flag
 260         {
 261             local @ARGV = ('--horsey', '123');
 262
 263             my $parser = $parser_name->new;
 264             isa_ok($parser, $parser_name);
 265
 266             my $getopt = MooseX::Getopt::Session->new( parser => $parser );
 267             isa_ok($getopt, 'MooseX::Getopt::Session');
 268
 269             my $app = App->new_with_options( getopt => $getopt );
 270             isa_ok($app, 'App');
 271             is($app->horse, 123, 'cmd_alias+cmd_flag, using flag');
 272         }
 273         {
 274             local @ARGV = ('-x', '321');
 275
 276             my $parser = $parser_name->new;
 277             isa_ok($parser, $parser_name);
 278
 279             my $getopt = MooseX::Getopt::Session->new( parser => $parser );
 280             isa_ok($getopt, 'MooseX::Getopt::Session');
 281
 282             my $app = App->new_with_options( getopt => $getopt );
 283             isa_ok($app, 'App');
 284             is($app->horse, 321, 'cmd_alias+cmd_flag, using alias');
 285         }
 286
 287         # Test _foo + cmd_flag
 288         {
 289             local @ARGV = ('-p', '666');
 290
 291             my $parser = $parser_name->new;
 292             isa_ok($parser, $parser_name);
 293
 294             my $getopt = MooseX::Getopt::Session->new( parser => $parser );
 295             isa_ok($getopt, 'MooseX::Getopt::Session');
 296
 297             my $app = App->new_with_options( getopt => $getopt );
 298             isa_ok($app, 'App');
 299             is($app->_private_stuff_cmdline, 666, '_foo + cmd_flag');
 300         }
 301
 302         # Test ARGV support
 303         {
 304             my @args = ('-p', 12345, '-c', 99, '-');
 305             local @ARGV = @args;
 306
 307             my $parser = $parser_name->new;
 308             isa_ok($parser, $parser_name);
 309
 310             my $getopt = MooseX::Getopt::Session->new( parser => $parser );
 311             isa_ok($getopt, 'MooseX::Getopt::Session');
 312
 313             my $app = App->new_with_options( getopt => $getopt );
 314             isa_ok($app, 'App');
 315             is_deeply($app->ARGV, \@args, 'ARGV accessor');
 316             is_deeply(\@ARGV, \@args, '@ARGV unmangled');
 317             is_deeply($app->extra_argv, ['-'], 'extra_argv accessor');
 318         }
 319
 320     }
 321 }