#!/usr/local/bin/perl use strict; use Getopt::Std; use ExtUtils::ModuleMaker; use ExtUtils::ModuleMaker::Licenses::Standard; use ExtUtils::ModuleMaker::Licenses::Local; use Data::Dumper; use vars qw (%opts $VERSION %destinations %messages); $VERSION = 0.32; ########################################### main pod documentation begin ## =head1 NAME modulemaker - interactive interface to ExtUtils::ModuleMaker =head1 AUTHOR R. Geoffrey Avery CPAN ID: RGEOFFREY modulemaker@PlatypiVentures.com http://www.PlatypiVentures.com/perl/modules/ModuleMaker.shtml =cut ############################################# main pod documentation end ## ################################################ subroutine header begin ## ################################################## subroutine header end ## sub Main_Menu { my $MOD = shift; my $string = $messages{'Main Menu'}; $string =~ s|##name##|$MOD->{NAME}|; $string =~ s|##license##|$MOD->{LICENSE}|; $string =~ s|##build##|$MOD->{BUILD_SYSTEM}|; my $response = Question_User ($string, 'menu'); return ($destinations{'Main Menu'}{$response}) if (exists $destinations{'Main Menu'}{$response}); if ($response eq 'G') { $MOD->complete_build (); print "Module files generated\n"; } elsif ($response eq 'N') { my $value = Question_User ("Please enter a new value for Primary Module Name", 'data'); $MOD->{NAME} = $value; } elsif ($response eq 'V') { $MOD->verify_values (); print "Module verification done\n"; } return ('Main Menu'); } ################################################ subroutine header begin ## ################################################## subroutine header end ## my %Author_Menu = ( N => ['Name ', 'NAME'], C => ['CPAN ID ', 'CPANID'], O => ['Organization', 'ORGANIZATION'], W => ['Website ', 'WEBSITE'], E => ['Email ', 'EMAIL'], ); sub Author_Menu { my $MOD = shift; my $string = $messages{'Author Menu'}; my $stuff = join ("\n", map { "$_ - $Author_Menu{$_}[0] '" . $MOD->{AUTHOR}{$Author_Menu{$_}[1]} . "'" } qw (N C O W E)); $string =~ s|##Data Here##|$stuff|; my $response = Question_User ($string, 'menu'); return ($destinations{'Author Menu'}{$response}) if (exists $destinations{'Author Menu'}{$response}); return ('Author Menu') unless (exists ($Author_Menu{$response})); my $value = Question_User ("Please enter a new value for $Author_Menu{$response}[0]", 'data'); $MOD->{AUTHOR}{$Author_Menu{$response}[1]} = $value; return ('Author Menu'); } ################################################ subroutine header begin ## ################################################## subroutine header end ## my %Directives_Menu = ( C => ['Compact ', 'COMPACT'], P => ['Permissions ', 'PERMISSIONS'], V => ['Verbose ', 'VERBOSE'], D => ['Include POD ', 'NEED_POD'], N => ['Include new ', 'NEED_NEW_METHOD'], H => ['History in POD ', 'CHANGES_IN_POD'], ); my %Flagged = ((map { $_ => 0 } qw (0 N F)), (map { $_ => 1 } qw (1 Y T)), ); sub Directives_Menu { my $MOD = shift; my $string = $messages{Directives_Menu}; my $stuff = join ("\n", (map { "$_ - $Directives_Menu{$_}[0] '" . $MOD->{$Directives_Menu{$_}[1]} . "'" } qw (C V D N H)), "P - $Directives_Menu{P}[0] '" . sprintf ("%04o - %d", $MOD->{$Directives_Menu{P}[1]}, $MOD->{$Directives_Menu{P}[1]}) . "'", ); $string =~ s|##Data Here##|$stuff|; my $response = Question_User ($string, 'menu'); return ($destinations{Directives_Menu}{$response}) if (exists $destinations{Directives_Menu}{$response}); return ('Directives_Menu') unless (exists ($Directives_Menu{$response})); if ($response eq 'P') { my $value = Question_User ("Please enter a new value for $Directives_Menu{$response}[0]", 'data'); $value = oct ($value) if ($value =~ /^0/); $MOD->{$Directives_Menu{$response}[1]} = $value if ($value <= 0777); } else { my $value = Question_User ("Please enter a new value for $Directives_Menu{$response}[0]," . " (0,No,False || 1,Yes,True)", 'menu'); $value = $Flagged{$value}; $MOD->{$Directives_Menu{$response}[1]} = $Flagged{$value} if (exists $Flagged{$value}); } return ('Directives_Menu'); } ################################################ subroutine header begin ## ################################################## subroutine header end ## my $License_Standard = ExtUtils::ModuleMaker::Licenses::Standard->interact (); my $License_Local = ExtUtils::ModuleMaker::Licenses::Local->interact (); my @lic = ( (map { [$_, $License_Standard->{$_}] } sort { $License_Standard->{$a} cmp $License_Standard->{$b} } keys (%{$License_Standard})), (map { [$_, $License_Local->{$_}] } sort { $License_Standard->{$a} cmp $License_Standard->{$b} } keys (%{$License_Local})), ); sub License_Menu { my $MOD = shift; my $string = $messages{'License Menu'}; my $ct = 1; my $licenses = join ("\n", map { $ct++ . (($MOD->{LICENSE} eq $_->[0]) ? '***' : '') . "\t" . $_->[1]} @lic); $string =~ s|##Licenses Here##|$licenses|; my $response = Question_User ($string, 'license', scalar (@lic)); return ($destinations{'License Menu'}{$response}) if (exists $destinations{'License Menu'}{$response}); if ($lic[$response - 1]) { $MOD->{LICENSE} = $lic[$response - 1][0]; } $MOD->initialize_license (); return ('License Menu'); } ################################################ subroutine header begin ## ################################################## subroutine header end ## sub License_Display { my $MOD = shift; my $string = $messages{License_Display}; $string =~ s|##License Here##|$MOD->{LicenseParts}{LICENSETEXT}|; my $response = Question_User ($string, 'menu'); return ($destinations{'License Menu'}{$response}) if (exists $destinations{'License Menu'}{$response}); return ('License Menu'); } ################################################ subroutine header begin ## ################################################## subroutine header end ## my %Build_Menu = ( E => 'ExtUtils::MakeMaker', B => 'Module::Build', P => 'Module::Build and proxy Makefile.PL', ); sub Build_Menu { my $MOD = shift; my $string = $messages{Build_Menu}; $string =~ s|##Build Here##|$MOD->{BUILD_SYSTEM}|; my $response = Question_User ($string, 'menu'); return ($destinations{'Build Menu'}{$response}) if (exists $destinations{'Build Menu'}{$response}); $MOD->{BUILD_SYSTEM} = $Build_Menu{$response} if exists $Build_Menu{$response}; return ('Build Menu'); } ################################################ subroutine header begin ## ################################################## subroutine header end ## sub Copyright_Display { my $MOD = shift; my $string = $messages{Copyright_Display}; $string =~ s|##Copyright Here##|$MOD->{LicenseParts}{COPYRIGHT}|; my $response = Question_User ($string, 'menu'); return ($destinations{'License Menu'}{$response}) if (exists $destinations{'License Menu'}{$response}); return ('License Menu'); } ################################################ subroutine header begin ## ################################################## subroutine header end ## sub Question_User { my ($question, $flavor, $feature) = @_; print "\n------------------------\n\n", $question, "\n"; my $answer = <>; if ($flavor eq 'menu') { $answer =~ m/^(.)/; $answer = uc ($1); } elsif ($flavor eq 'data') { chomp ($answer); } elsif ($flavor eq 'license') { chomp ($answer); unless ($answer =~ m/^\d+/) { $answer =~ m/^(.)/; $answer = uc ($1); } elsif (( $answer < 1) || ( $feature < $answer )) { $answer = 'P'; } } print "You entered '$answer'\n"; return ($answer); } ################################################ subroutine header begin ## ################################################## subroutine header end ## sub crap_to_hold { my $MOD = ExtUtils::ModuleMaker->new ( NAME => $opts{n}, COMPACT => (($opts{c}) ? 1 : 0), VERBOSE => (($opts{V}) ? 1 : 0), (($opts{v}) ? (VERSION => $opts{v}) : ()), (($opts{l}) ? (LICENSE => $opts{l}) : ()), # POD => (($opts{P}) ? 'omit' : ''), # CHANGES => (($opts{C}) ? 'history' : ''), USAGE_MESSAGE => Usage (), ); $MOD->complete_build (); open (STUFF, ">stuff.txt") or die "could not dump $!"; print STUFF Dumper ($MOD); close STUFF; } ################################################ subroutine header begin ## ################################################## subroutine header end ## sub Usage { my $message = < { A => 'Author Menu', L => 'License Menu', D => 'Directives_Menu', B => 'Build Menu', Q => 'done', }, 'Author Menu' => { R => 'Main Menu', Q => 'done', }, Directives_Menu => { R => 'Main Menu', Q => 'done', }, 'License Menu' => { C => 'Copyright_Display', L => 'License_Display', R => 'Main Menu', Q => 'done', P => 'License Menu', }, 'Build Menu' => { R => 'Main Menu', Q => 'done', }, ); ########################################################################### ########################################################################### %messages = ( #--------------------------------------------------------------------- 'Main Menu' => < < < < < < <new ( NAME => $opts{n}, COMPACT => (($opts{c}) ? 1 : 0), VERBOSE => (($opts{V}) ? 1 : 0), CHANGES_IN_POD => (($opts{C}) ? 1 : 0), NEED_POD => (($opts{P}) ? 0 : 1), INTERACTIVE => (($opts{I}) ? 0 : 1), (($opts{b}) ? (BUILD_SYSTEM => $opts{b}) : ()), (($opts{v}) ? (VERSION => $opts{v}) : ()), (($opts{l}) ? (LICENSE => $opts{l}) : ()), USAGE_MESSAGE => Usage (), ); #print Dumper ($MOD); if ($MOD->{INTERACTIVE}) { while () { if ($where eq 'done') { last; } elsif ($where eq 'Module Name') { } elsif ($where eq 'Main Menu') { $where = Main_Menu ($MOD); } elsif ($where eq 'License Menu') { $where = License_Menu ($MOD); } elsif ($where eq 'Author Menu') { $where = Author_Menu ($MOD); } elsif ($where eq 'License_Display') { $where = License_Display ($MOD); } elsif ($where eq 'Copyright_Display') { $where = Copyright_Display ($MOD); } elsif ($where eq 'Directives_Menu') { $where = Directives_Menu ($MOD); } elsif ($where eq 'Build Menu') { $where = Build_Menu ($MOD); } else { $where = Main_Menu ($MOD); } } } else { $MOD->complete_build (); } print "\n------------------------\n\nGood bye.\n\n"; ########################################################################### ###########################################################################