Created
June 26, 2017 10:29
-
-
Save mfontani/5b494afeaef0bd441977de26d362f479 to your computer and use it in GitHub Desktop.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
#!/usr/bin/env perl | |
use 5.020_000; | |
use warnings; | |
# Based on Damian Conway's bin/file_template | |
my %TEMPLATE_FOR = ( | |
'.sh' => \&gen_sh_file, | |
'.pm' => \&gen_pm_file, | |
'.pl' => \&gen_pl_file, | |
'.t' => \&gen_t_file, | |
q{} => \&gen_pl_file, | |
); | |
my %INFO = ( | |
FILE => $ARGV[0] || 'NAME', | |
FILENAME => $ARGV[0] || 'NAME', | |
MODULE_NAME => $ARGV[0] || 'MODULE::NAME', | |
); | |
my $SUFFIX = q{([.][^.]+)\Z}; | |
for ($INFO{'FILENAME'}) { | |
s{^.*/lib/}{}gxms; | |
s{^.*/bin/}{}gxms; | |
s{^lib/}{}gxms; | |
s{^bin/}{}gxms; | |
s{^upgrade/}{}gxms; | |
} | |
for ($INFO{MODULE_NAME}) { | |
s{$SUFFIX}{}gxms; | |
s{/}{::}gxms; | |
s{^.*::lib::}{}gxms; | |
s{^lib::}{}gxms; | |
} | |
my $type = get_suffix($INFO{FILENAME}); | |
my $text = $TEMPLATE_FOR{$type}(); | |
my $placeholder = join '|', map { "\Q$_\E" } reverse sort keys %INFO; | |
$text =~ s/<($placeholder)>/$INFO{$1}/gxms; | |
say $text; | |
exit 0; | |
sub get_suffix { | |
my ($filename) = @_; | |
if ($filename =~ /([.][^.]+)\z/xms) { | |
my $extension = $1; | |
return $extension | |
if $extension =~ /[.]p[ml]\z/xms; | |
exit; | |
} | |
return q{}; | |
} | |
sub gen_sh_file { <<'END' | |
#!/bin/bash | |
set -e | |
set -o nounset | |
set -o pipefail | |
END | |
} | |
sub gen_pl_file { <<'END' | |
#!/usr/bin/env perl | |
use FindBin; | |
use lib "$FindBin::Bin/../../lib"; | |
use ElReg::Sanity; | |
use ElReg::Getopt qw<getopt short_usage>; | |
use ElReg::Messages qw<configure_messages info shout>; | |
use Const::Fast; | |
use Carp qw<croak>; | |
my $USAGE = <<"EOF"; | |
Usage: <FILENAME> [OPTION]... | |
Describe what <FILENAME> does. | |
Options: | |
-d Update the database. Without this, we're in dry run. | |
-v Verbose | |
EOF | |
my %opt = getopt('d v', $USAGE); | |
configure_messages(verbose => 1) if $opt{v}; | |
exit 0; | |
END | |
} | |
sub gen_pm_file { <<'END' | |
package <MODULE_NAME>; | |
use ElReg::Sanity; | |
1; | |
END | |
} | |
sub gen_t_file { <<'END' | |
#!/usr/bin/env perl | |
use FindBin; | |
use lib "$FindBin::Bin/../lib"; | |
use ElReg::Sanity; | |
use Test::More; | |
use ElReg::Config qw<get_conf>; | |
use ElReg::Test::Apache qw<do_tests shared_data get_db set_debug_host>; | |
use DateTime; | |
use Carp qw<croak>; | |
set_debug_host(); | |
my $on_dev = get_conf('general.development'); | |
my $db = get_db(); | |
my %IN = shared_data($db); | |
$ENV{DISPATCH_NAMESPACE} = 'Web_App::Foo'; | |
do_tests('forums' => { | |
'theregister.co.uk' => [ | |
[ '/' => '>The Register Forums<' ], | |
], | |
}); | |
done_testing; | |
END | |
} |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment