From: Chris Prather Date: Tue, 31 Jul 2007 18:20:51 +0000 (+0000) Subject: add a NoGetopt metaclass X-Git-Tag: 0_06~2 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=gitmo%2FMooseX-Getopt.git;a=commitdiff_plain;h=a01f08fb1f7451412f578e905179324dfd2ec590;hp=26be7f7ed5cd799ab80bf512505ca3474626236e add a NoGetopt metaclass --- diff --git a/lib/MooseX/Getopt.pm b/lib/MooseX/Getopt.pm index 1417d08..1333e7f 100644 --- a/lib/MooseX/Getopt.pm +++ b/lib/MooseX/Getopt.pm @@ -80,6 +80,7 @@ sub _attrs_to_options { } else { next if $name =~ /^_/; + next if $attr->isa('MooseX::Getopt::Meta::NoGetopt'); } my $opt_string = $aliases diff --git a/lib/MooseX/Getopt/Meta/NoGetopt.pm b/lib/MooseX/Getopt/Meta/NoGetopt.pm new file mode 100644 index 0000000..c7c1d99 --- /dev/null +++ b/lib/MooseX/Getopt/Meta/NoGetopt.pm @@ -0,0 +1,17 @@ + +package MooseX::Getopt::Meta::NoGetopt; +use Moose; +use Moose::Util::TypeConstraints; + +our $VERSION = '0.01'; +our $AUTHORITY = 'cpan:STEVAN'; + +extends 'Moose::Meta::Attribute'; # << Moose extending Moose :) + +no Moose; + +# register this as a metaclass alias ... +package Moose::Meta::Attribute::Custom::NoGetopt; +sub register_implementation { 'MooseX::Getopt::Meta::NoGetopt' } + +1; \ No newline at end of file diff --git a/t/004_nogetop.t b/t/004_nogetop.t new file mode 100644 index 0000000..03b09db --- /dev/null +++ b/t/004_nogetop.t @@ -0,0 +1,96 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More tests => 8; + +BEGIN { + use_ok('MooseX::Getopt'); +} + +{ + + package App; + use Moose; + + with 'MooseX::Getopt'; + + has 'data' => ( + metaclass => 'MooseX::Getopt::Meta::Attribute', + is => 'ro', + isa => 'Str', + default => 'file.dat', + cmd_flag => 'f', + ); + + has 'cow' => ( + metaclass => 'Getopt', + is => 'ro', + isa => 'Str', + default => 'moo', + cmd_aliases => [qw/ moocow m c /], + ); + + has 'horse' => ( + metaclass => 'MooseX::Getopt::Meta::Attribute', + is => 'ro', + isa => 'Str', + default => 'bray', + cmd_flag => 'horsey', + cmd_aliases => 'x', + ); + + has 'length' => ( + is => 'ro', + isa => 'Int', + default => 24 + ); + + has 'verbose' => ( + is => 'ro', + isa => 'Bool', + ); + + has 'libs' => ( + is => 'ro', + isa => 'ArrayRef', + default => sub { [] }, + ); + + has 'details' => ( + is => 'ro', + isa => 'HashRef', + default => sub { {} }, + ); + + has 'private_stuff' => ( + metaclass => 'MooseX::Getopt::Meta::NoGetopt', + is => 'ro', + isa => 'Int', + default => 713 + ); + + has '_private_stuff_cmdline' => ( + metaclass => 'MooseX::Getopt::Meta::Attribute', + is => 'ro', + isa => 'Int', + default => 832, + cmd_flag => 'p', + ); + +} + +{ + local @ARGV = (); + + my $app = App->new_with_options; + isa_ok( $app, 'App' ); + + ok( !$app->verbose, '... verbosity is off as expected' ); + is( $app->length, 24, '... length is 24 as expected' ); + is( $app->data, 'file.dat', '... data is file.dat as expected' ); + is_deeply( $app->libs, [], '... libs is [] as expected' ); + is_deeply( $app->details, {}, '... details is {} as expected' ); + is($app->private_stuff, 713, '... private stuff is 713 as expected'); +}