package ExtUtils::ModuleMaker::Interactive; use strict; use warnings; BEGIN { use base qw( ExtUtils::ModuleMaker ); our $VERSION = "0.63"; } use Carp; use Data::Dumper; ########## CONSTRUCTOR ########## # # Inherited from EU::MM # ########## BEGIN DECLARATIONS ########## ###### Index of Variables (08/18/2005): # %Build_Menu # %destinations # %Directives_Menu # %Flagged # $License_Standard # $License_Local # @lic # %messages 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' => < < < < < < <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|##name##|$MOD->{NAME}| : $string =~ s|##name##||; $string =~ s|##abstract##|$MOD->{ABSTRACT}|; $string =~ s|##license##|$MOD->{LICENSE}|; $MOD->{BUILD_SYSTEM} = 'Module::Build' if $MOD->{USE_MODULE_BUILD}; $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 '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; } } } # END 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|##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_Menu{$response}[1] } = $value; return ('Author Menu'); } sub Directives_Menu { my $MOD = shift; # warn "at start of Directives_Menu: $MOD->{COMPACT}\n"; 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{'} # . $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|##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'); } 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'); } 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'); } 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'); } 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'); } 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); } ########## END PRIVATE METHODS ########## 1; ################### DOCUMENTATION ################### =head1 NAME ExtUtils::ModuleMaker::Interactive - Hold methods used in F =head1 SYNOPSIS use ExtUtils::ModuleMaker::Interactive; $mod = ExtUtils::ModuleMaker::Interactive->new(%standard_options); $mod->run_interactive() if $mod->{INTERACTIVE}; ... # ExtUtils::ModuleMaker::complete_build() called here $mod->closing_message(); =head1 DESCRIPTION This package exists solely to hold declarations of variables and methods used in F, the command-line utility which is the easiest way of accessing the functionality of Perl extension ExtUtils::ModuleMaker. =head1 METHODS =head2 C This method drives the menus which make up F's interactive mode. Once it has been run, F calls C to build the directories and files requested. =head2 C Prints a closing message after C is run. Can be commented out without problem. Could be subclassed, and -- in a future version -- probably will be with an optional printout of files created. =head1 AUTHOR James E Keenan. CPANID: JKEENAN. =head1 COPYRIGHT Copyright (c) 2005, 2018 James E. Keenan. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. The full text of the license can be found in the LICENSE file included with this module. =head1 SEE ALSO F, F. =cut