lib/MooseX/Getopt.pm

   1
   2 package MooseX::Getopt;
   3 use Moose::Role;
   4
   5 use Getopt::Long;
   6
   7 use MooseX::Getopt::OptionTypes;
   8 use MooseX::Getopt::Meta::Attribute;
   9
  10 sub new_with_options {
  11     my ($class, %params) = @_;
  12
  13     my (%options, %constructor_options);
  14     foreach my $attr ($class->meta->compute_all_applicable_attributes) {
  15         my $name = $attr->name;
  16
  17         if ($attr->isa('MooseX::Getopt::Meta::Attribute') && $attr->has_cmd_flag) {
  18             $name = $attr->cmd_flag;
  19         }
  20
  21         my $init_arg = $attr->init_arg;
  22
  23         # create a suitable default value
  24         $constructor_options{$init_arg} = '';
  25
  26         if ($attr->has_type_constraint) {
  27             my $type_name = $attr->type_constraint->name;
  28             if (MooseX::Getopt::OptionTypes->has_option_type($type_name)) {
  29                 $name .= MooseX::Getopt::OptionTypes->get_option_type($type_name);
  30             }
  31         }
  32
  33         $options{$name} = \($constructor_options{$init_arg});
  34     }
  35
  36     GetOptions(%options);
  37
  38     # filter out options which
  39     # were not passed at all
  40     %constructor_options = map {
  41         $constructor_options{$_} ne ''
  42             ? ($_ => $constructor_options{$_})
  43             : ()
  44     } keys %constructor_options;
  45
  46     $class->new(%params, %constructor_options);
  47 }
  48
  49 1;
  50
  51 __END__
  52
  53 =pod
  54
  55 =head1 NAME
  56
  57 MooseX::Getopt -
  58
  59 =head1 SYNOPSIS
  60
  61   ## In your class
  62   package My::App;
  63   use Moose;
  64
  65   with 'MooseX::Getopt';
  66
  67   has 'out' => (is => 'rw', isa => 'Str', required => 1);
  68   has 'in'  => (is => 'rw', isa => 'Str', required => 1);
  69
  70   # ... rest of the class here
  71
  72   ## in your script
  73   #!/usr/bin/perl
  74
  75   use My::App;
  76
  77   my $app = My::App->new_with_options();
  78   # ... rest of the script here
  79
  80   ## on the command line
  81   % perl my_app_script.pl -in file.input -out file.dump
  82
  83 =head1 DESCRIPTION
  84
  85 =head1 METHODS
  86
  87 =over 4
  88
  89 =item B<new_with_options (%params)>
  90
  91 =item B<meta>
  92
  93 =back
  94
  95 =head1 BUGS
  96
  97 All complex software has bugs lurking in it, and this module is no
  98 exception. If you find a bug please either email me, or add the bug
  99 to cpan-RT.
 100
 101 =head1 AUTHOR
 102
 103 Stevan Little E<lt>stevan@iinteractive.comE<gt>
 104
 105 =head1 COPYRIGHT AND LICENSE
 106
 107 Copyright 2007 by Infinity Interactive, Inc.
 108
 109 L<http://www.iinteractive.com>
 110
 111 This library is free software; you can redistribute it and/or modify
 112 it under the same terms as Perl itself.
 113
 114 =cut