--- /dev/null
+package FrBr::Common::MooseX::Role::CommonOpts;
+
+# $Id$
+# $URL$
+
+=head1 NAME
+
+FrBr::Common::MooseX::Role::CommonOpts
+
+=head1 DESCRIPTION
+
+Rolle, um der Basis-Applikation alle Attribute von MooseX::Getopt sowie die
+Standard-Kommandozeilenschalter zu verleihen.
+
+=cut
+
+#---------------------------------------------------------------------------
+
+use Moose::Role;
+
+use MooseX::Getopt::Meta::Attribute;
+use MooseX::Getopt::Meta::Attribute::NoGetopt;
+use MooseX::Types::Path::Class;
+use Path::Class;
+use File::Basename;
+use FindBin;
+use Encode qw( decode_utf8 encode_utf8 );
+
+use utf8;
+
+use Carp ();
+
+with 'MooseX::Getopt';
+with 'FrBr::Common::MooseX::Role::Types';
+
+#---------------------------------------------------------------------------
+
+# Versionitis
+
+my $Revis = <<'ENDE';
+ $Revision$
+ENDE
+$Revis =~ s/^.*:\s*(\S+)\s*\$.*/$1/s;
+
+use version; our $VERSION = qv("0.1"); $VERSION .= " r" . $Revis;
+
+
+############################################################################
+
+=head1 Attribute
+
+=cut
+
+#---------------------------------------------------------------------------
+
+has 'show_usage' => (
+ is => 'rw',
+ isa => 'Bool',
+ lazy => 1,
+ traits => [ 'Getopt' ],
+ builder => '_build_show_usage',
+ documentation => 'BOOL: Anzeige der Verwendung der Anwendung',
+ cmd_flag => 'help',
+ cmd_aliases => [ '?', 'usage' ],
+);
+
+sub _build_show_usage {
+ return 0;
+}
+
+#---------------------------------------------------------------------------
+
+has 'version' => (
+ is => 'ro',
+ isa => 'Str',
+ traits => [ 'NoGetopt' ],
+ builder => '_build_version',
+ documentation => 'Versionsstring der Anwendung',
+);
+
+sub _build_version {
+ return $VERSION;
+}
+
+#---------------------------------------------------------------------------
+
+has 'show_version' => (
+ is => 'rw',
+ isa => 'Bool',
+ lazy => 1,
+ traits => [ 'Getopt' ],
+ builder => '_build_show_version',
+ documentation => 'BOOL: Anzeige der Verwendung der Anwendung',
+ cmd_flag => 'version',
+ cmd_aliases => [ 'V' ],
+);
+
+sub _build_show_version {
+ return 0;
+}
+
+#-----------------------------------------
+
+has 'verbose' => (
+ is => 'rw',
+ isa => 'UnsignedInt',
+ traits => [ 'Getopt' ],
+ lazy => 1,
+ builder => '_build_verbose',
+ documentation => 'INT: Ausführlichkeits-Level der Applikation',
+ cmd_aliases => [ 'D' ],
+);
+
+has 'verbose_bool' => (
+ is => 'rw',
+ isa => 'Bool',
+ traits => [ 'Getopt' ],
+ cmd_flag => 'v',
+ documentation => 'BOOL: Ausführlichkeits-Level der Applikation',
+);
+
+#------
+
+sub _build_verbose {
+ return 0;
+}
+
+#-------------------------
+
+has 'approot' => (
+ is => 'ro',
+ isa => 'Path::Class::Dir',
+ traits => [ 'NoGetopt' ],
+ coerce => 1,
+ builder => '_build_approot',
+ documentation => 'Stammverzeichnis der Anwendung',
+);
+
+#------
+
+sub _build_approot {
+ return dir->new( $FindBin::Bin )->parent->absolute;
+}
+
+#-------------------------
+
+has 'cmd_params' => (
+ is => 'ro',
+ isa => 'Maybe[ArrayRef[Str]]',
+ traits => [ 'NoGetopt' ],
+ lazy => 0,
+ builder => '_build_cmd_params',
+ documentation => 'Mögliche Kommandozeilenparameter (nicht für GetOpt)',
+);
+
+#------
+
+sub _build_cmd_params {
+ return undef;
+}
+
+#-------------------------
+
+has 'common_opts_evaluated' => (
+ is => 'ro',
+ isa => 'Bool',
+ traits => [ 'NoGetopt' ],
+ builder => '_build_common_opts_evaluated',
+ writer => '_set_common_opts_evaluated',
+ documentation => 'Wurden die allgemeinen Kommandozeilen-Optionen bereits ausgewertet',
+);
+
+#------
+
+sub _build_common_opts_evaluated {
+ return 0;
+}
+
+sub _set_common_opts_evaluated {
+ return $_[1];
+}
+
+############################################################################
+
+=head1 Benötigte Funktionen
+
+=cut
+
+requires 'debug';
+
+############################################################################
+
+=head1 Methoden und Methoden-Modifizerer
+
+Methoden und Methoden-Modifizerer dieser Rolle
+
+=head around BUILDARGS
+
+=cut
+
+around BUILDARGS => sub {
+
+ my $orig = shift;
+ my $class = shift;
+
+ my %Args = @_;
+
+ #warn "Bin in '" . __PACKAGE__ . "'\n";
+
+ # verbose auf verbose_bool setzen
+ $Args{'verbose'} = 1 if $Args{'verbose_bool'} and not exists $Args{'verbose'};
+ delete $Args{'verbose_bool'} if exists $Args{'verbose_bool'};
+
+ return $class->$orig(%Args);
+
+};
+
+#---------------------------------------------------------------------------
+
+=head 2 after BUILD
+
+wird nach dem BUILD-Prozess des Anwendungsprozesses aufgerufen
+
+=cut
+
+after 'BUILD' => sub {
+ my $self = shift;
+ $self->evaluate_common_options();
+};
+
+#---------------------------------------------------------------------------
+
+sub evaluate_common_options {
+
+ my $self = shift;
+
+ return if $self->common_opts_evaluated;
+ $self->debug( "Werte allgemeine Optionen aus." );
+
+ if ( $self->show_usage ) {
+ $self->do_show_usage();
+ exit 0;
+ }
+ if ( $self->show_version ) {
+ $self->do_show_version();
+ exit 0;
+ }
+ $self->_set_common_opts_evaluated(1);
+
+ return 1;
+
+}
+
+#---------------------------------------------------------------------------
+
+sub do_show_version {
+
+ my $self = shift;
+
+ print "Version: " . $self->version . "\n";
+
+}
+
+#---------------------------------------------------------------------------
+
+sub do_show_usage {
+
+ my $self = shift;
+
+ my @getopt_attrs = grep {
+ $_->does("MooseX::Getopt::Meta::Attribute::Trait")
+ or
+ $_->name !~ /^_/
+ } grep {
+ !$_->does('MooseX::Getopt::Meta::Attribute::Trait::NoGetopt')
+ } $self->meta->get_all_attributes;
+
+ my @Attribute = ();
+ my @Short_Opts = ();
+ my $max_length = 1;
+
+ foreach my $attr ( @getopt_attrs ) {
+
+ my $Attr = {};
+ my $lengt = 1;
+ $self->debug( "Attribut-Objekt: ", $attr ) if $self->verbose >= 4;
+
+ $Attr->{'name'} = $attr->name;
+ $Attr->{'flag'} = $attr->name;
+ $Attr->{'aliases'} = [];
+ if ( $attr->does('MooseX::Getopt::Meta::Attribute::Trait') ) {
+ $Attr->{'flag'} = $attr->cmd_flag if $attr->has_cmd_flag;
+ my @aliases = ();
+ @aliases = @{ $attr->cmd_aliases } if $attr->has_cmd_aliases;
+ $Attr->{'aliases'} = \@aliases;
+ }
+
+ $Attr->{'doc'} = $attr->has_documentation ? $attr->documentation : '';
+
+ push @Short_Opts, $Attr->{'flag'} if length($Attr->{'flag'}) <= 1;
+ for my $alias ( @{ $Attr->{'aliases'} } ) {
+ push @Short_Opts, $alias if length($alias) <= 1;
+ }
+ $Attr->{'show'} = '';
+ for my $opt ( @{ $Attr->{'aliases'} }, $Attr->{'flag'} ) {
+ $opt = ( length($opt) <= 1 ? '-' : '--' ) . $opt;
+ $Attr->{'show'} .= ' ' if $Attr->{'show'} ne '';
+ $Attr->{'show'} .= $opt;
+ }
+ $max_length = length($Attr->{'show'}) if length($Attr->{'show'}) > $max_length;
+
+ $self->debug( "Attribut: ", $Attr ) if $self->verbose >= 3;
+ push @Attribute, $Attr;
+
+ }
+
+ printf "Verwendung: %s %s[long options]", basename($0), ( @Short_Opts ? ( '[-' . join( '', @Short_Opts ) . '] ' ) : '' );
+ print " [" . join( '|', @{ $self->cmd_params } ) . "]" if $self->cmd_params;
+ print "\n";
+
+ for my $Attr ( sort { lc($a->{'name'}) cmp lc($b->{'name'}) } @Attribute ) {
+ printf " %-*s %s\n", $max_length, $Attr->{'show'}, encode_utf8( $Attr->{'doc'} );
+ }
+
+}
+
+
+#---------------------------------------------------------------------------
+
+no Moose::Role;
+1;
+
+__END__
+
+# vim: noai: filetype=perl ts=4 sw=4 : expandtab
--- /dev/null
+package OPS::MooseX::Role::Config;
+
+# $Id$
+# $URL$
+
+=head1 NAME
+
+OPS::MooseX::Role::Config
+
+=head1 DESCRIPTION
+
+Rolle, um eine wie auch immer geartete Konfiguration zu integrieren
+
+=cut
+
+#---------------------------------------------------------------------------
+
+use Moose::Role;
+
+use MooseX::Getopt::Meta::Attribute::Trait;
+use MooseX::Getopt::Meta::Attribute::Trait::NoGetopt;
+use Moose::Util::TypeConstraints;
+use MooseX::Types::Path::Class;
+use File::Basename;
+use FindBin;
+use Path::Class;
+use Clone qw(clone);
+use Config::Any;
+
+use utf8;
+
+use Carp ();
+
+#with 'MooseX::Getopt';
+with 'OPS::MooseX::Role::Types';
+
+use version; our $VERSION = qv("0.0.1");
+
+############################################################################
+
+=head1 Attribute
+
+Eigene Attribute
+
+=cut
+
+#-------------------------
+
+=head2 cfg_stem
+
+Basisname der Konfigurationsdatei (ohne Endung) im Konfigurationsverzeichnis
+
+=cut
+
+has 'cfg_stem' => (
+ is => 'ro',
+ isa => 'Str',
+ traits => [ 'Getopt' ],
+ lazy => 1,
+ builder => '_build_cfg_stem',
+ documentation => 'Basisname der Konfigurationsdatei (ohne Endung) im Konfigurationsverzeichnis',
+ cmd_flag => 'config',
+ cmd_aliases => 'cfg-stem',
+);
+
+#------
+
+sub _build_cfg_stem {
+ return "config";
+}
+
+#-------------------------
+
+=head2 cfg_dir
+
+Verzeichnis der Konfigurationsdateien
+
+=cut
+
+has 'cfg_dir' => (
+ is => 'rw',
+ isa => 'Path::Class::Dir',
+ traits => [ 'NoGetopt' ],
+ lazy => 1,
+ builder => '_build_cfg_dir',
+ documentation => 'Verzeichnis der Konfigurationsdateien',
+ writer => '_set_cfg_dir',
+ coerce => 1,
+ cmd_flag => 'cfg-dir',
+ cmd_aliases => 'cfgdir',
+);
+
+#------
+
+sub _build_cfg_dir {
+ return dir->new( dir->new( $FindBin::Bin )->parent->absolute, 'etc' );
+}
+
+#-
+
+sub _set_cfg_dir {
+ return dir->new( $_[0] )->absolute;
+}
+
+#---------------------------------
+
+=head2 config
+
+Konfiguration als Hash-Ref nach dem Lesen
+
+=cut
+
+has 'config' => (
+ is => 'rw',
+ isa => 'HashRef',
+ traits => [ 'NoGetopt' ],
+ lazy => 1,
+ builder => '_build_config',
+ documentation => 'Konfiguration als Hash-Ref',
+);
+
+#------
+
+sub _build_config {
+ return {};
+}
+
+#---------------------------------
+
+=head2 default_config
+
+Vorgabe-Konfiguration als Hash-Ref
+
+=cut
+
+has 'default_config' => (
+ is => 'ro',
+ isa => 'HashRef',
+ traits => [ 'NoGetopt' ],
+ lazy => 1,
+ builder => '_build_default_config',
+ documentation => 'Vorgabe-Konfiguration als Hash-Ref',
+);
+
+#------
+
+sub _build_default_config {
+ return {};
+}
+
+#---------------------------------
+
+=head2 used_cmd_params
+
+Die tatsächlich mit der Kommandozeile übergebenen Parameter
+(besser: ihr dazugehöriger Attributname) als Key, Value immer 1
+
+=cut
+
+has 'used_cmd_params' => (
+ is => 'rw',
+ isa => 'HashRef',
+ traits => [ 'NoGetopt' ],
+ lazy => 1,
+ builder => '_build_used_cmd_params',
+ documentation => 'Die tatsächlich mit der Kommandozeile übergebenen Parameter (besser: ihr dazugehöriger Attributname) als Key, Value immer 1',
+);
+
+#------
+
+sub _build_used_cmd_params {
+ return {};
+}
+
+#-------------------------
+
+=head2 configuration_evaluated
+
+Wurde die Konfiguration bereits ausgewertet?
+
+=cut
+
+has 'configuration_evaluated' => (
+ is => 'ro',
+ isa => 'Bool',
+ traits => [ 'NoGetopt' ],
+ builder => '_build_configuration_evaluated',
+ writer => '_set_configuration_evaluated',
+ documentation => 'Wurde die Konfiguration bereits ausgewertet',
+);
+
+#------
+
+sub _build_configuration_evaluated {
+ return 0;
+}
+
+sub _set_configuration_evaluated {
+ return $_[1];
+}
+
+#-------------------------
+
+=head2 configuration_read
+
+Wurde die Konfiguration bereits gelesen?
+
+=cut
+
+has 'configuration_read' => (
+ is => 'ro',
+ isa => 'Bool',
+ traits => [ 'NoGetopt' ],
+ builder => '_build_configuration_read',
+ writer => '_set_configuration_read',
+ documentation => 'Wurde die Konfiguration bereits gelesen',
+);
+
+#------
+
+sub _build_configuration_read {
+ return 0;
+}
+
+sub _set_configuration_read {
+ return $_[1];
+}
+
+############################################################################
+
+=head1 Benötigte Funktionen
+
+=cut
+
+#requires 'debug';
+
+#---------------------------------------------------------------------------
+
+# Ändern der Eigenschaften einiger geerbter Attribute
+
+############################################################################
+
+=head1 Methoden und Methoden-Modifizerer
+
+Methoden und Methoden-Modifizerer dieser Rolle
+
+=cut
+
+#---------------------------------------------------------------------------
+
+=head 2 after BUILD
+
+wird nach dem BUILD-Prozess des Anwendungsprozesses aufgerufen
+
+=cut
+
+#after 'BUILD' => sub {
+# my $self = shift;
+# $self->read_config_file();
+# $self->evaluate_config();
+#};
+
+sub BUILD {
+ my $self = shift;
+ $self->read_config_file();
+ $self->evaluate_config();
+}
+
+#---------------------------------------------------------------------------
+
+=head2 read_config_file( [$force] )
+
+Liest die Konfiguration aus den Konfigurations-Dateien ein.
+
+Der boolsche Parameter $force besagt, wenn mit einem wahren Wert übergeben,
+dass die Konfiguration eingelesen werden soll, auch wenn sie bereits
+gelesen wurde.
+
+=cut
+
+sub read_config_file {
+
+ my $self = shift;
+ my $force = shift;
+
+ unless ( $force ) {
+ return if $self->configuration_read;
+ }
+
+ $self->debug( "Lese Konfiguration ..." );
+
+ my $config = clone($self->default_config());
+
+ my $stems = [ file( $self->cfg_dir, $self->cfg_stem )->stringify ];
+
+ $self->debug( "Versuche Config-STEMS zu lesen: ", $stems ) if $self->verbose > 3;
+ my $cfg = Config::Any->load_stems( { stems => $stems, flatten_to_hash => 0, use_ext => 1 } );
+ $self->debug( "Gelesene Konfiguration: ", $cfg ) if $self->verbose > 3;
+
+ for my $file ( keys %$cfg ) {
+ if ( keys %{ $cfg->{$file} } ) {
+ $config = merge_hashes( $config, $cfg->{$file} );
+ }
+ }
+
+ $stems = [ file( $self->cfg_dir, ( $self->cfg_stem . "_local" ) )->stringify ];
+ $self->debug( "Versuche lokale Config-STEMS zu lesen: ", $stems ) if $self->verbose > 3;
+ $cfg = Config::Any->load_stems( { stems => $stems, flatten_to_hash => 0, use_ext => 1 } );
+ $self->debug( "Gelesene lokale Konfiguration: ", $cfg ) if $self->verbose > 3;
+
+ for my $file ( keys %$cfg ) {
+ if ( keys %{ $cfg->{$file} } ) {
+ $config = merge_hashes( $config, $cfg->{$file} );
+ }
+ }
+
+ $self->debug( "Zusammengemixte Konfiguration: ", $config ) if $self->verbose > 2;
+
+ $self->config($config);
+
+ $self->_set_configuration_read(1);
+ $self->_set_configuration_evaluated(0);
+
+}
+
+#---------------------------------
+
+=head2 evaluate_config( )
+
+Wertet die gelesene Konfiguration aus.
+
+=cut
+
+sub evaluate_config {
+
+ my $self = shift;
+
+ return if $self->configuration_evaluated;
+
+ if ( $self->config and keys %{ $self->config } ) {
+ $self->config->{'log'}{'dir'} = dir->new( $self->basedir, 'log' )->stringify unless $self->config->{'log'}{'dir'};
+ $self->config->{'log'}{'stderror'} = 'error.log' unless exists $self->config->{'log'}{'stderror'};
+ }
+
+ $self->used_cmd_params( {} );
+ my $used_cmd_params = $self->used_cmd_params;
+
+ my @getopt_attrs = grep {
+ $_->does("MooseX::Getopt::Meta::Attribute::Trait")
+ or
+ $_->name !~ /^_/
+ } grep {
+ !$_->does('MooseX::Getopt::Meta::Attribute::Trait::NoGetopt')
+ } $self->meta->get_all_attributes;
+
+ my %Attribute = ();
+
+ foreach my $attr ( @getopt_attrs ) {
+
+ my $Attr = {};
+
+ my $name = $attr->name;
+ my $flag = $attr->name;
+ my $aliases = [];
+
+ if ( $attr->does('MooseX::Getopt::Meta::Attribute::Trait') ) {
+ $flag = $attr->cmd_flag if $attr->has_cmd_flag;
+ @$aliases = @{ $attr->cmd_aliases } if $attr->has_cmd_aliases;
+ }
+
+ for my $opt ( @$aliases, $flag ) {
+ my $n_opt = ( length($opt) <= 1 ? '-' : '--' ) . $opt;
+ $Attribute{$n_opt} = $name;
+ if ( $attr->{'isa'} eq 'Bool' ) {
+ $n_opt = '--no' . $opt;
+ $Attribute{$n_opt} = $name;
+ }
+ }
+
+ }
+
+ for my $param ( @{ $self->ARGV } ) {
+ if ( $Attribute{$param} ) {
+ my $name = $Attribute{$param};
+ $used_cmd_params->{$name} = 1;
+ }
+ }
+
+ unless ( $self->used_cmd_params->{'production_state'} ) {
+ my $state = $self->config->{'production_state'} || $self->config->{'production-state'} || undef;
+ $self->production_state( $state ) if $state;
+ }
+
+
+
+ $self->_set_configuration_evaluated(1);
+
+ 1;
+}
+
+#---------------------------------
+
+=head2 merge_hashes($hashref, $hashref)
+
+Base code to recursively merge two hashes together with right-hand precedence.
+
+=cut
+
+sub merge_hashes {
+
+ my ( $lefthash, $righthash ) = @_;
+
+ return $lefthash unless defined $righthash;
+
+ my %merged = %$lefthash;
+ for my $key ( keys %$righthash ) {
+ my $right_ref = ( ref $righthash->{ $key } || '' ) eq 'HASH';
+ my $left_ref = ( ( exists $lefthash->{ $key } && ref $lefthash->{ $key } ) || '' ) eq 'HASH';
+ if( $right_ref and $left_ref ) {
+ $merged{ $key } = merge_hashes(
+ $lefthash->{ $key }, $righthash->{ $key }
+ );
+ }
+ else {
+ $merged{ $key } = $righthash->{ $key };
+ }
+ }
+
+ return \%merged;
+
+}
+
+#---------------------------------------------------------------------------
+
+no Moose::Role;
+1;
+
+__END__
+
+# vim: noai: filetype=perl ts=4 sw=4 : expandtab
projects / my-stuff / perl.git / commitdiff