Module::New::Config - Module::New::Config documentation

Module-New documentation Contained in the Module-New distribution.

Index

Code Index:

NAME

Top

Module::New::Config

SYNOPSIS

Top

  my $config = Module::New::Config->new( file => 'config.yaml' );

  my $value  = $config->get('some_key');
  $config->set('some_key' => 'value');

  $config->load;
  $config->save;

DESCRIPTION

Top

Used internally to get/set the config value.

METHODS

Top

new

takes an optional hash, creates an object, and loads a configuration file if any (or creates one if none is found).

get

If you pass a key, returns a value for the key. Without a key, returns the whole configuration hash reference.

set

takes pairs of key/value and update the config (temporarily). If you want to keep the configuration, use save instead.

load

loads a configuration file written in YAML. The file is looked for in the current and home directory by default.

save

may take a hash to update, and saves the current configuration to a file.

file

returns the current config file.

get_options

takes Getopt::Long's specifications, parses @ARGV, and updates the current configuration.

AUTHOR

Top

Kenichi Ishigaki, <ishigaki at cpan.org>

COPYRIGHT AND LICENSE

Top

Copyright (C) 2007-2009 by Kenichi Ishigaki.

This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.

Module-New documentation Contained in the Module-New distribution. 
package Module::New::Config;

use strict;
use warnings;
use Carp;
use File::HomeDir;
use Getopt::Long ();
use Path::Extended::Dir;
use YAML;

sub new {
  my ($class, %options) = @_;

  my $parser = Getopt::Long::Parser->new(
    config => [qw( bundling ignore_case pass_through )]
  );

  my $self = bless { parser => $parser, %options }, $class;

  $self->load;
  $self;
}

sub file { shift->{file} }

sub get {
  my ($self, $key) = @_;
  return $self->{option}->{$key} if exists $self->{option}->{$key};
  return $self->{config}->{$key} if exists $self->{config}->{$key};
  return;
}

sub set {
  my $self = shift;

  if ( @_ and @_ % 2 == 0 ) {
    $self->{config} = { %{ $self->{config} || {} }, @_ };
  }
}

sub save {
  my $self = shift;

  $self->set(@_) if @_;

  $self->{file} ||= $self->_default_file;

  YAML::DumpFile( $self->{file}, $self->{config} );
}

sub load {
  my $self = shift;

  if ( $self->{file} ) {
    return if $self->_load_and_merge( $self->{file} );
  }
  else {
    foreach my $file ( $self->_search ) {
      return if $self->_load_and_merge( $file );
    }
  }
  $self->_first_time;
}

sub _load_and_merge {
  my ($self, $file) = @_;

  return unless $file && -f $file;

  my $config;
  eval { $config = YAML::LoadFile( $file ) };
  return if $@;

  foreach my $key ( keys %{ $config } ) {
    $self->{config}->{$key} = $config->{$key};
  }
  $self->{file} = $file;
  return 1;
}

sub get_options {
  my ($self, @specs) = @_;
  my $config = {};
  $self->{parser}->getoptions($config, @specs);
  $self->{option} = { %{ $self->{option} || {} }, %{ $config } };
}

sub _first_time {
  my $self = shift;
  my $author = $self->{author} || $self->_prompt('Enter Author: ');
  my $email  = $self->{email}  || $self->_prompt('Enter Email: ');

  $self->{file} ||= $self->_default_file;
  $self->{config} = {
    author => $author,
    email  => $email,
  };

  $self->save;
}

sub _search {
  my $self = shift;

  grep { $_->exists }
  map  {( $_->file('.new_perl_module.yml'),
          $_->file('.new_perl_module.yaml') )}
  ( Path::Extended::Dir->new('.'), $self->_home );
}

sub _home { Path::Extended::Dir->new( File::HomeDir->my_home ) }

sub _default_file { shift->_home->file('.new_perl_module.yml') }

sub _prompt {
  my ($self, $prompt) = @_;
  return if $self->{no_prompt}; # for test

  print $prompt;
  my $ret = <STDIN>; chomp $ret;
  return $ret;
}

1;

__END__