BEGIN {
our $VERSION = "0.63";
}
my %Build_Menu = (
E => 'ExtUtils::MakeMaker',
B => 'Module::Build',
P => 'Module::Build and proxy Makefile.PL',
);
my %destinations = (
'Main Menu' => {
A => 'Author Menu',
L => 'License Menu',
D => 'Directives_Menu',
B => 'Build Menu',
X => 'exit',
},
'Author Menu' => {
R => 'Main Menu',
X => 'exit',
},
Directives_Menu => {
R => 'Main Menu',
X => 'exit',
},
'License Menu' => {
C => 'Copyright_Display',
L => 'License_Display',
P => 'License Menu',
R => 'Main Menu',
X => 'exit',
},
'Build Menu' => {
R => 'Main Menu',
X => 'exit',
},
);
my %Flagged = (
( map { $_ => 0 } qw (0 N F) ),
( map { $_ => 1 } qw (1 Y T) ),
);
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_Local->{$a} cmp $License_Local->{$b} }
keys( %{$License_Local} )
),
);
my %messages = (
'Main Menu' => <<EOF,
modulemaker: Main Menu
Feature Current Value
N - Name of module '##name##'
S - Abstract '##abstract##'
A - Author information
L - License '##license##'
D - Directives
B - Build system '##build##'
G - Generate module
H - Generate module;
save selections as defaults
X - Exit immediately
Please choose which feature you would like to edit:
EOF
'Author Menu' => <<EOF,
modulemaker: Author Menu
Feature Current Value
##Data Here##
R - Return to main menu
X - Exit immediately
Please choose which feature you would like to edit:
EOF
Directives_Menu => <<EOF,
modulemaker: Directives Menu
Feature Current Value
##Data Here##
R - Return to main menu
X - Exit immediately
Please choose which feature you would like to edit:
EOF
'License Menu' => <<EOF,
modulemaker: License Menu
ModuleMaker provides many licenes to choose from, many of them approved by opensource.org.
License Name
##Licenses Here##
# - Enter the number of the license you want to use
C - Display the Copyright
L - Display the License
R - Return to main menu
X - Exit immediately
Please choose which license you would like to use:
EOF
License_Display => <<EOF,
Here is the current license:
##License Here##
C - Display the Copyright
L - Display the License
P - Pick a different license
R - Return to main menu
X - Exit immediately
Please choose which license you would like to use:
EOF
Copyright_Display => <<EOF,
Here is the current copyright:
##Copyright Here##
C - Display the Copyright
L - Display the License
P - Pick a different license
R - Return to main menu
X - Exit immediately
Please choose which license you would like to use:
EOF
Build_Menu => <<EOF,
Here is the current build system:
##Build Here##
E - ExtUtils::MakeMaker
B - Module::Build
P - Module::Build and proxy Makefile.PL
R - Return to main menu
X - Exit immediately
Please choose which build system you would like to use:
EOF
);
sub run_interactive {
my $MOD = shift;
my $where = 'Main Menu';
while () {
if ( $where eq 'exit' ) {
print "Exiting immediately!\n\n";
exit 0;
} elsif ( $where eq 'done' ) {
last;
} elsif ( $where eq 'Module Name' ) {
} elsif ( $where eq 'Abstract' ) {
} 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);
}
}
return $MOD;
}
sub closing_message {
my $MOD = shift;
print "\n-------------------\n\nModule files generated. Good bye.\n\n";
}
sub _prepare_author_defaults {
my $self = shift;
my $defaults_ref = $self->default_values();
my %author_defaults = (
AUTHOR => {
default => $defaults_ref->{AUTHOR},
string => 'Author ',
opt => 'u',
select => 'N',
},
CPANID => {
default => $defaults_ref->{CPANID},
string => 'CPAN ID ',
opt => 'p',
select => 'C',
},
ORGANIZATION => {
default => $defaults_ref->{ORGANIZATION},
string => 'Organization',
opt => 'o',
select => 'O',
},
WEBSITE => {
default => $defaults_ref->{WEBSITE},
string => 'Website ',
opt => 'w',
select => 'W',
},
EMAIL => {
default => $defaults_ref->{EMAIL},
string => 'Email ',
opt => 'e',
select => 'E',
},
);
return { %author_defaults };
}
sub _prepare_directives_defaults {
my $self = shift;
my $defaults_ref = $self->default_values();
my %directives_defaults = (
COMPACT => {
default => $defaults_ref->{COMPACT},
string => 'Compact ',
opt => 'c',
select => 'C',
},
VERBOSE => {
default => $defaults_ref->{VERBOSE},
string => 'Verbose ',
opt => 'V',
select => 'V',
},
NEED_POD => {
default => $defaults_ref->{NEED_POD},
string => 'Include POD ',
opt => 'P',
select => 'D',
},
NEED_NEW_METHOD => {
default => $defaults_ref->{NEED_NEW_METHOD},
string => 'Include new ',
opt => 'q',
select => 'N',
},
CHANGES_IN_POD => {
default => $defaults_ref->{CHANGES_IN_POD},
string => 'History in POD ',
opt => 'C',
select => 'H',
},
PERMISSIONS => {
default => $defaults_ref->{PERMISSIONS},
string => 'Permissions ',
opt => 'r',
select => 'P',
},
);
return { %directives_defaults };
}
sub Main_Menu {
my $MOD = shift;
MAIN_LOOP: {
my $string = $messages{'Main Menu'};
defined $MOD->{NAME}
? $string =~ s|
: $string =~ s|
$string =~ s|
$string =~ s|
$MOD->{BUILD_SYSTEM} = 'Module::Build' if $MOD->{USE_MODULE_BUILD};
$string =~ s|
my $response = Question_User( $string, 'menu' );
return ( $destinations{'Main Menu'}{$response} )
if ( exists $destinations{'Main Menu'}{$response} );
if ( $response eq 'N' ) {
my $value =
Question_User( "Please enter a new value for Primary Module Name",
'data' );
$MOD->{NAME} = $value;
}
elsif ( $response eq 'S' ) {
my $value =
Question_User( "Please enter Abstract (suggest: 44-char max)",
'data' );
$MOD->{ABSTRACT} = $value;
}
elsif ( $response eq 'G' or $response eq 'H' ) {
$MOD->set_author_composite();
if (! $MOD->{NAME}) {
print "ERROR: Must enter module name!\n";
next MAIN_LOOP;
} elsif ($MOD->validate_values()) {
$MOD->set_file_composite();
if ( $response eq 'G' ) {
print "Module files are being generated.\n";
} else {
$MOD->make_selections_defaults();
print "Module files are being generated;\n";
print " selections are being saved as defaults.\n";
}
return ('done');
} else {
next MAIN_LOOP;
}
}
}
return ('Main Menu');
}
sub Author_Menu {
my $MOD = shift;
my $author_defaults_ref = $MOD->_prepare_author_defaults();
my %author_defaults = %{$author_defaults_ref};
my %Author_Menu = map {
$author_defaults{$_}{select} =>
[ $author_defaults{$_}{string}, $_ ]
} keys %author_defaults;
my $string = $messages{'Author Menu'};
my $stuff = join( "\n", map {
qq{$_ - $Author_Menu{$_}[0] '} #'
. $MOD->{ $Author_Menu{$_}[1] } . q{'}
} qw (N C O W E)
);
$string =~ s|
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_Menu{$response}[1] } = $value;
return ('Author Menu');
}
sub Directives_Menu {
my $MOD = shift;
my $directives_defaults_ref = $MOD->_prepare_directives_defaults();
my %directives_defaults = %{$directives_defaults_ref};
my %Directives_Menu = map {
$directives_defaults{$_}{select} =>
[ $directives_defaults{$_}{string}, $_ ]
} keys %directives_defaults;
my $string = $messages{Directives_Menu};
my $stuff = join( "\n",
(
map {
qq{$_ - $Directives_Menu{$_}[0] '} #'
. $MOD->{ $Directives_Menu{$_}[1] } . q{'}
} qw (C V D N H)
),
qq{P - $Directives_Menu{P}[0] '}
. sprintf(
"%04o - %d",
$MOD->{ $Directives_Menu{P}[1] },
$MOD->{ $Directives_Menu{P}[1] }
)
. q{'},
);
$string =~ s|
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');
}
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|
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');
}
sub License_Display {
my $MOD = shift;
my $string = $messages{License_Display};
$string =~ s|
my $response = Question_User( $string, 'menu' );
return ( $destinations{'License Menu'}{$response} )
if ( exists $destinations{'License Menu'}{$response} );
return ('License Menu');
}
sub Build_Menu {
my $MOD = shift;
my $string = $messages{Build_Menu};
$string =~ s|
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');
}
sub Copyright_Display {
my $MOD = shift;
my $string = $messages{Copyright_Display};
$string =~ s|
my $response = Question_User( $string, 'menu' );
return ( $destinations{'License Menu'}{$response} )
if ( exists $destinations{'License Menu'}{$response} );
return ('License Menu');
}
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);
}
1;