Dist-Man

 view release on metacpan or  search on metacpan

lib/Dist/Man/Simple.pm  view on Meta::CPAN

        $self->{distro} =~ s/::/-/g;
    }

    $self->{basedir} = $self->{dir} || $self->{distro};
    $self->create_basedir;

    my @files;
    push @files, $self->create_modules( @modules );

    push @files, $self->create_t( @modules );
    push @files, $self->create_ignores;
    my %build_results = $self->create_build();
    push(@files, @{ $build_results{files} } );

    push @files, $self->create_Changes;
    push @files, $self->create_README( $build_results{instructions} );
    push @files, 'MANIFEST';
    $self->create_MANIFEST( grep { $_ ne 't/boilerplate.t' } @files );

    return;
}

=head2 C<< new(%args) >>

This method is called to construct and initialize a new Dist::Man object.
It is never called by the end user, only internally by C<create_distro>, which
creates ephemeral Dist::Man objects.  It's documented only to call it to
the attention of subclass authors.

=cut

sub new {
    my $class = shift;
    return bless { @_ } => $class;
}

=head1 OBJECT METHODS

All the methods documented below are object methods, meant to be called
internally by the ephemperal objects created during the execution of the class
method C<create_distro> above.

=head2 create_basedir

Creates the base directory for the distribution.  If the directory already
exists, and I<$force> is true, then the existing directory will get erased.

If the directory can't be created, or re-created, it dies.

=cut

sub create_basedir {
    my $self = shift;

    # Make sure there's no directory
    if ( -e $self->{basedir} ) {
        die( "$self->{basedir} already exists.  ".
             "Use --force if you want to stomp on it.\n"
            ) unless $self->{force};

        local @ARGV = $self->{basedir};
        rm_rf();

        die "Couldn't delete existing $self->{basedir}: $!\n"
          if -e $self->{basedir};
    }

    CREATE_IT: {
        $self->progress( "Created $self->{basedir}" );

        local @ARGV = $self->{basedir};
        mkpath();

        die "Couldn't create $self->{basedir}: $!\n" unless -d $self->{basedir};
    }

    return;
}

=head2 create_modules( @modules )

This method will create a starter module file for each module named in
I<@modules>.

=cut

sub create_modules {
    my $self = shift;
    my @modules = @_;

    my @files;

    for my $module ( @modules ) {
        my $rtname = lc $module;
        $rtname =~ s/::/-/g;
        push @files, $self->_create_module( $module, $rtname );
    }

    return @files;
}

=head2 module_guts( $module, $rtname )

This method returns the text which should serve as the contents for the named
module.  I<$rtname> is the email suffix which rt.cpan.org will use for bug
reports.  (This should, and will, be moved out of the parameters for this
method eventually.)

=cut

sub _get_licenses_mapping {
    my $self = shift;

    return
    [
    {
        license => 'perl',
        blurb => <<'EOT',
This program is free software; you can redistribute it and/or modify it
under the terms of either: the GNU General Public License as published
by the Free Software Foundation; or the Artistic License.

See http://dev.perl.org/licenses/ for more information.
EOT
    },
    {
        license => 'mit',
        blurb => <<'EOT',
This program is distributed under the MIT (X11) License:
L<http://www.opensource.org/licenses/mit-license.php>

lib/Dist/Man/Simple.pm  view on Meta::CPAN

This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
Lesser General Public License for more details.

You should have received a copy of the GNU Lesser General Public
License along with this program; if not, write to the Free
Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
02111-1307 USA.
EOT
    },
    ];
}

sub _license_record {
    my $self = shift;

    foreach my $record (@{$self->_get_licenses_mapping()}) {
        if ($record->{license} eq $self->{license}) {
            return $record;
        }
    }

    return;
}

sub _license_blurb {
    my $self = shift;

    my $record = $self->_license_record();

    my $license_blurb;
    if (defined($record)) {
        $license_blurb = $record->{blurb};
    }
    else {
        $license_blurb = <<"EOT";
This program is released under the following license: $self->{license}
EOT
    }
    chomp $license_blurb;
    return $license_blurb;
}

# _create_module: used by create_modules to build each file and put data in it

sub _create_module {
    my $self = shift;
    my $module = shift;
    my $rtname = shift;

    my @parts = split( /::/, $module );
    my $filepart = (pop @parts) . '.pm';
    my @dirparts = ( $self->{basedir}, 'lib', @parts );
    my $SLASH = q{/};
    my $manifest_file = join( $SLASH, 'lib', @parts, $filepart );
    if ( @dirparts ) {
        my $dir = File::Spec->catdir( @dirparts );
        if ( not -d $dir ) {
            local @ARGV = $dir;
            mkpath @ARGV;
            $self->progress( "Created $dir" );
        }
    }

    my $module_file = File::Spec->catfile( @dirparts,  $filepart );

    $self->{module_file}{$module} = File::Spec->catfile('lib', @parts, $filepart);
    $self->create_file( $module_file, $self->module_guts( $module, $rtname ) );
    $self->progress( "Created $module_file" );

    return $manifest_file;
}

sub _thisyear {
    return (localtime())[5] + 1900;
}

sub _module_to_pm_file {
    my $self = shift;
    my $module = shift;

    my @parts = split( /::/, $module );
    my $pm = pop @parts;
    my $pm_file = File::Spec->catfile( 'lib', @parts, "${pm}.pm" );
    $pm_file =~ s{\\}{/}g; # even on Win32, use forward slash

    return $pm_file;
}

sub _reference_links {
  return (
      { nickname => 'RT',
        title    => 'CPAN\'s request tracker',
        link     => 'http://rt.cpan.org/NoAuth/Bugs.html?Dist=%s',
      },
      { title    => 'CPAN Ratings',
        link     => 'http://cpanratings.perl.org/d/%s',
      },
      { title    => 'Search CPAN',
        link     => 'http://search.cpan.org/dist/%s/',
      },
    );
}

=head2 create_Makefile_PL( $main_module )

This will create the Makefile.PL for the distribution, and will use the module
named in I<$main_module> as the main module of the distribution.

=cut

sub create_Makefile_PL {
    my $self         = shift;
    my $main_module  = shift;
    my $builder_name = 'ExtUtils::MakeMaker';
    my $output_file  =
    Dist::Man::BuilderSet->new()->file_for_builder($builder_name);
    my $fname        = File::Spec->catfile( $self->{basedir}, $output_file );

lib/Dist/Man/Simple.pm  view on Meta::CPAN

    my (\$filename, \%regex) = \@_;
    open( my \$fh, '<', \$filename )
        or die "couldn't open \$filename for reading: \$!";

    my \%violated;

    while (my \$line = <\$fh>) {
        while (my (\$desc, \$regex) = each \%regex) {
            if (\$line =~ \$regex) {
                push \@{\$violated{\$desc}||=[]}, \$.;
            }
        }
    }

    if (\%violated) {
        fail("\$filename contains boilerplate text");
        diag "\$_ appears on lines \@{\$violated{\$_}}" for keys \%violated;
    } else {
        pass("\$filename contains no boilerplate text");
    }
}

sub module_boilerplate_ok {
    my (\$module) = \@_;
    not_in_file_ok(\$module =>
        'the great new \$MODULENAME'   => qr/ - The great new /,
        'boilerplate description'     => qr/Quick summary of what the module/,
        'stub function definition'    => qr/function[12]/,
    );
}

TODO: {
  local \$TODO = "Need to replace the boilerplate text";

  not_in_file_ok(README =>
    "The README is used..."       => qr/The README is used/,
    "'version information here'"  => qr/to provide version information/,
  );

  not_in_file_ok(Changes =>
    "placeholder date/time"       => qr(Date/time)
  );

$module_boilerplate_tests

}

HERE

    return %t_files;
}

sub _create_t {
    my $self = shift;
    my $filename = shift;
    my $content = shift;

    my @dirparts = ( $self->{basedir}, 't' );
    my $tdir = File::Spec->catdir( @dirparts );
    if ( not -d $tdir ) {
        local @ARGV = $tdir;
        mkpath();
        $self->progress( "Created $tdir" );
    }

    my $fname = File::Spec->catfile( @dirparts, $filename );
    $self->create_file( $fname, $content );
    $self->progress( "Created $fname" );

    return "t/$filename";
}

=head2 create_MANIFEST( @files )

This method creates the distribution's MANIFEST file.  It must be run last,
because all the other create_* functions have been returning the functions they
create.

=cut

sub create_MANIFEST {
    my $self = shift;
    my @files = @_;

    my $fname = File::Spec->catfile( $self->{basedir}, 'MANIFEST' );
    $self->create_file( $fname, $self->MANIFEST_guts(@files) );
    $self->progress( "Created $fname" );

    return 'MANIFEST';
}

=head2 MANIFEST_guts( @files )

This method is called by C<create_MANIFEST>, and returns content for the
MANIFEST file.

=cut

sub MANIFEST_guts {
    my $self = shift;
    my @files = sort @_;

    return join( "\n", @files, '' );
}

=head2 create_build( )

This method creates the build file(s) and puts together some build
instructions.  The builders currently supported are:

ExtUtils::MakeMaker
Module::Build
Module::Install

=cut

sub create_build {
    my $self = shift;

    # pass one: pull the builders out of $self->{builder}
    my @tmp =