Module::New::Context - Module::New::Context documentation

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

Index

Code Index:

NAME

Top

Module::New::Context

SYNOPSIS

Top

  my $context = Module::New->context;
  my $value = $context->config('foo');
  my $distribution = $context->distname;  # Some-Distribution-Name
  $context->module('Some::Module::Name');

DESCRIPTION

Top

This is used to hold various information on a distribution/module.

METHODS

Top

new

creates an object.

config

returns a ::Config object if there's no argument, and returns an appropriate config value with an argument. If you pass more arguments, you can update the configuration temporarily (if you want to keep the values permanently, use ->config->save(@_) instead).

license

takes a license name and returns a license text (perl license by default).

distname, dist_name

holds a distribution name you passed to the command.

distid, dist_id

holds a distribution id, which is the lowercased distribution name, replaced hyphens with underscores.

module

holds a main module name you passed to the command (or the one converted from a distribution name).

mainfile, main_file

holds a main module file path.

maindir, main_dir

holds a main module directory path.

moduleid, module_id

holds a main module id, which is the lowercased module name, replaced double colons with underscores.

modulepath, module_path

holds a main module directory path, without prepending "lib".

modulebase, module_base

holds a basename of the main module, without ".pm".

repository

holds a repository url.

AUTHOR

Top

Kenichi Ishigaki, <ishigaki@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::Context;

use strict;
use warnings;
use Carp;

use Module::New::Loader;
use Module::New::Log;
use Sub::Install 'reinstall_sub';

foreach my $accessor (qw( template date path loader files )) {
  reinstall_sub({
    as   => $accessor,
    code => sub { shift->{$accessor} },
  });
}

sub new {
  my $class = shift;

  my $loader = Module::New::Loader->new(@_);
  my $self = bless { loader => $loader }, $class;

  foreach my $name (qw( License Template )) {
    $self->{lc $name} = $loader->load_class($name);
  }

  foreach my $name (qw( Config Path Date Files )) {
    $self->{lc $name} = $loader->load($name);
  }

  $self;
}

sub config {
  my $self = shift;
  return $self->{config} unless @_;
  return $self->{config}->get(@_) if @_ == 1;
  $self->{config}->set(@_);
}

sub license {
  my ($self, $type, @args) = @_;
  $type ||= $self->config('license') || 'perl';
  $self->{license}->render( $type, @args );
}

sub distname {
  my $self = shift;

  if ( @_ ) {
    my $module = my $dist = shift;
    $dist   =~ s/::/\-/g;
    $module =~ s/\-/::/g;

    croak "$dist looks weird" if $dist =~ tr/A-Za-z0-9_\-//cd;

    my $distid = lc $dist;
       $distid =~ s/\-/_/g;

    $self->{distname} = $dist;
    $self->{distid}   = $distid;
    $self->module( $module );
  }

  $self->{distname};
}

sub module {
  my $self = shift;

  if ( @_ ) {
    $self->{module} = shift;
    my $path = $self->{module};
       $path =~ s|::|\/|g;
    my $id   = lc $path;
       $id   =~ s|/|_|g;
    $self->mainfile("lib/$path.pm");
    $self->modulepath($path);
    $self->moduleid($id);
  }
  $self->{module};
}

sub mainfile {
  my $self = shift;
  if ( @_ ) {
    $self->{mainfile} = shift;
  }
  $self->{mainfile};
}

sub maindir {
  my $self = shift;
  my $dir = $self->{mainfile};
     $dir =~ s/\.pm$//;
  return $dir;
}

sub modulepath {
  my $self = shift;
  if ( @_ ) {
    $self->{modulepath} = shift;
  }
  $self->{modulepath};
}

sub moduleid {
  my $self = shift;
  if ( @_ ) {
    $self->{moduleid} = shift;
  }
  $self->{moduleid};
}

sub modulebase {
  my $self = shift;
  my ($name) = $self->{module} =~ /(\w+)$/;
  return $name;
}

sub distid {
  my $self = shift;
  if ( @_ ) {
    $self->{distid} = shift;
  }
  $self->{distid};
}

sub repository {
  my $self = shift;
  if ( @_ ) {
    $self->{repository} = shift;
  }
  $self->{repository} || '';
}

*dist_name   = \&distname;
*dist_id     = \&distid;
*main_file   = \&mainfile;
*main_dir    = \&maindir;
*module_path = \&modulepath;
*module_id   = \&moduleid;
*module_base = \&modulebase;

1;

__END__