logo标签列表

你有一个好的Perl模板脚本吗？

perltemplatesgetopt
5

我经常使用Perl进行编程，想知道是否有人有“默认”模板Perl脚本，并愿意分享。

我开始复制我的一个旧脚本，其中包含Getopt函数。我想其他人可能也做了类似的事情？

5个回答
7
在我的.vimrc文件中，我已经设置了
au BufNewFile *.pl s-^-#!/usr/bin/perl\r\ruse strict;\ruse warnings;\r\r-

这段代码写了

#!/usr/bin/perl

use strict;
use warnings;

对于任何新的Perl脚本，我也有

au BufNewFile *.pm s-^-package XXX;\r\ruse strict;\ruse warnings;\r\r1;-

对于模块，但我倾向于使用Module::Starter来创建。

也许这是一个无知的问题，但为什么要使用\r而不是\n？ - Telemachus
5
因为那是有效的方式吗？Vim有时可能会表现得很奇怪。 - Chas. Owens
这就是我没有测试的结果。关于 Vim 的又一个我以前不知道（注意到，遇到）的事情。对于其他访问者，请参见 https://dev59.com/iXVD5IYBdhLWcg3wJIEK 和 https://dev59.com/eHVD5IYBdhLWcg3wJIEK。 - Telemachus
在 Perl 5.11 中，当使用 5.11.0 时，默认情况下会使用 use strict;。 - kagali-san
@mhambra 嗯，由于Perl 5.11是一个开发版本，因此最好在Perl 5.12中说如果您使用use 5.012;，则默认打开了strict。不幸的是，我仍然为Perl 5.8编写了很多代码，因此我还没有更新我的模板。 - Chas. Owens
6

当我需要为许多类似脚本创建基本模板时，我只需将相似的部分转换为模块。然后，该脚本就会被简化为以下内容：

 use App::Foo;

 App::Foo->run( @ARGV );

App::Foo将继承模板模块并覆盖不同的内容：

 package App::Foo;
 use parent qw(App::Template);

 ...

在App::Template模块中，您可以放置任何所需内容：
 package App::Template;

 sub run {
    my( $class, @args ) = @_;

    my $self = $class->new( ... );
    $self->init;
    $self->process_command_line( ... );

    ...
    }


 sub process_command_line { ... }

 ...

在CPAN上有一些框架可以用于此类事情，但我认为自己做并且得到所需的内容而不必处理不需要的部分同样容易。

5
正文：
作为人们以前所说的，我在一个模块中拥有我的方法模板：use PMG::PMGBase;，对于初始脚本的搭建，作为Emacs用户，我有我的perl-insert-start和perl-add-getoption模板，但是像这样写东西：
(defun perl-insert-start ()
  "Places #!..perl at the start of the script"
  (interactive)
  (goto-char (point-min))
  (insert "#!/usr/bin/env perl\n\n")
  (insert "=head1 [progam_name]\n\n")
  (insert " description:\n\n")
  (insert "=cut\n\n")
  (insert "use feature ':5.10';\n")
  (insert "use strict;\n")
  (insert "#use warnings;\n")
  (insert "#use Data::Dumper;\n")
)

有点烦人。所以最后对我来说更容易的是使用Perl模板脚本（见下文），并在Emacs中选择空白缓冲区中的一个空格后，使用run-command-on-region调用它：C-u M-| :~/scripts/perl-start-template.pl。
#!/usr/bin/env perl

=head1 [progam_name]

 description:

=cut

use feature ':5.10';
use strict;
use Getopt::Long;

my $prog = $0;
my $usage = <<EOQ;
Usage for $0:

  >$prog [-test -help -verbose]

EOQ

my $help;
my $test;
my $debug;
my $verbose =1;


my $ok = GetOptions(
                    'test'      => \$test,
                    'debug:i'   => \$debug,
                    'verbose:i' => \$verbose,
                    'help'      => \$help,
                   );

if ($help || !$ok ) {
    print $usage;
    exit;
}


print template();


sub template {
    ##
    ### Here start the template code
    ##
    return <<'EOT';
#!/usr/bin/env perl

=head1 [progam_name]

 description: This script prints a template for new perl scripts

=cut

use feature ':5.10';
use strict;
#use warnings;
#use Data::Dumper;
use Getopt::Long;
# use Template;
# use PMG::PMGBase;  
# use File::Temp qw/ tempfile tempdir /;
# use File::Slurp;
# use File::Copy;
# use File::Path;
# use File::Spec;
# use File::Basename qw(basename dirname);
# use List::Util qw(reduce max min);
# use List::MoreUtils qw(uniq indexes each_arrayref natatime);

# my $PMGbase = PMG::PMGBase->new();
my $prog = $0;
my $usage = <<EOQ;
Usage for $0:

  >$prog [-test -help -verbose]

EOQ

my $date = get_date();

my $help;
my $test;
my $debug;
my $verbose =1;

my $bsub;
my $log;
my $stdout;
my $stdin;
my $run;
my $dry_run;

my $ok = GetOptions(
                    'test'      => \$test,
                    'debug:i'   => \$debug,
                    'verbose:i' => \$verbose,
                    'help'      => \$help,
                    'log'       => \$log,
                    'bsub'      => \$bsub,
                    'stdout'    => \$stdout,
                    'stdin'     => \$stdin,

                    'run'       => \$run,
                    'dry_run'   => \$dry_run,

                   );

if ($help || !$ok ) {
    print $usage;
    exit;
}

sub get_date {

    my ($day, $mon, $year) = (localtime)[3..5] ;

    return my $date= sprintf "%04d-%02d-%02d", $year+1900, $mon+1, $day;
}

sub parse_csv_args {

    my $csv_str =shift;
    return [split ',', $csv_str];
}

EOT


}
1

我的很简单。

#!/usr/bin/perl
use Modern::Perl

说到像 getopt 这样的东西，我编写的脚本之间没有足够的共性，使得拥有更详细的模板不值得。

1
嗯，好的建议，但是 Modern::Perl 还不够... - Evan Carroll
你可能想把它改成 #!/usr/bin/perl 或者甚至是 #!/usr/bin/env perl。 - Chas. Owens
1
@Chas - 不，对于我主要针对的系统来说不是这样。 - Quentin
@David Dorward，我不这么认为...请阅读错误报告。这些模块没有被启用，不是因为它们不能使Perl更加现代化，而是因为它们没有随Perl一起发布。或者，像utf8这样的情况，原因未知。或者，可能是因为5个月前发布的稳定版Perl版本太过现代化了，所以unicode_strings也没有被启用。Modern::Perl好吗？是的。足够好吗...可能还不足以成为Perl的全部模板。 - Evan Carroll
3
没有所谓“全能的Perl模板”，只有适用于特定目的的模板。 - Quentin
0

我有两个。一个是旧的，几乎只是一个perl one-liner的包装器，另一个则有更多的功能和示例，我经常发现它们很有用：

#!/usr/bin/perl
# name_of_script ver 0.01 YYYYMMDD authors@email.address
use strict;
no strict "refs";


sub footer
{
    my $this_year=`date +%Y`; chop($this_year);
    print "Copyright 2003-$this_year You or Company\n";
    # This isn't how copyright works -  the dates cove the time when the code
    #  was created.
}

sub help
{
    print "Usage: $0\n";
    &footer;
exit(0);
}

if( ($ARGV[0] =~ /^-+h/i) || (!$ARGV[0]) )
{
    &help;
}
##### code


##### end of code
print "Done that\n";

exit(0);

我通常用上述方法进行快速测试，但更多时候我会使用以下方法（当我不在攻击整个模块时）。

#!/usr/bin/perl
# name_of_script ver 0.01 YYYYMMDD authors@email.address
use strict;
{
no strict "refs"; # this helps bypass frustration when I'm doing it wrong.
}

=head1 NAME

name_of_script

=head1 VERSION

0.01

=cut

our $VERSION = 0.01;

=head1 ABSTRACT

A synopsis of the new script

=head1 DESCRIPTION

Provide an overview of functionality and purpose of
this script

=head1 OPTIONS

%opt stores the global variables
%ignore overrides %opt

=cut

my (%opt,%ignore);

=head2 ARGS

=over 8

=item B<-h> send for help (just spits out this POD by default, but we can chose something else if we like 

=back

=head3 other arguments and flags that are valid

For when GetOpt is too heavy

-d -v -i[!] (value) 

=cut

for(my $args=0;$args<=(@ARGV -1);$args++){
    if ($ARGV[$args]=~m/^-+h/i){ &help; }
    elsif ($ARGV[$args] eq '-d'){ $opt{D}++; }
    elsif ($ARGV[$args] eq '-v'){ $opt{verbose}++;  print "Verbose output not implemented yet - try debug\n";}
    elsif ($ARGV[$args]=~m/-+i!(.+)/){ delete($ignore{$1}); }
    elsif ($ARGV[$args]=~m/-+record(.+)/){ $opt{record_data}++; }
    elsif ($ARGV[$args]=~m/-+w(ipe_home_dirs)?/){ $opt{wipe_home_dirs}++; }
    elsif ($ARGV[$args]=~m/-+i(.+)/){ $ignore{$1}=1; }
    elsif ($ARGV[$args]=~m/-+path(.+)/){ $opt{BASE_PATH} = $1; }
    elsif ($ARGV[$args]=~m/-+path/){ $args++; $opt{BASE_PATH} = $ARGV[$args]; }
    elsif ($ARGV[$args]=~m/-+dir(.+)/){ $opt{BASE_PATH} = $1; }
    elsif ($ARGV[$args] eq '-no-xml'||$ARGV[$args] eq '-no_xml'){ delete $opt{xml}; }
    elsif ($ARGV[$args] eq '-no-mkdir'||$ARGV[$args] eq '-no_mkdir'){ delete $opt{mkdir}; }
    elsif ($ARGV[$args] !~m/^-/ && -d "$ARGV[$args]"){ push @{ $opt{paths} }, $ARGV[$args] }
    else{ print "what is this $ARGV[$args] you talk of?\n"; &help; }
}


=head1 METHODS

=head3 footer

Adds the Copyright line to any output that needs it

=cut

sub footer { print "perldoc $0 \nCopyright 2011 You or Company\n"; }

=head3 help

Just the help output

=cut

sub help {
    print `perldoc $0`;
    #print "Usage: $0\n";
    #&footer;
    exit(0);
}

##### code


##### end of code

=head1 BUGS AND LIMITATIONS

There are no known problems with this script.
Please report any bugs or feature requests

=head1 SEE ALSO

#L<My::Modules>

=head1 MAINTAINER

is the AUTHOR

=head1 AUTHOR

Some Person, C<<some.person at example.com>>

=head1 LICENSE AND COPYRIGHT

Copyright 2011 Alexx Roche, all rights reserved.

This program is free software; you can redistribute it and/or modify it
under the terms of either: Eclipse Public License, Version 1.0 ; 
 the GNU Lesser General Public License as published 
by the Free Software Foundation; or the Artistic License.

See http://www.opensource.org/licenses/ for more information.

=cut

print "Done that\n" if $opt{verbose}>=1;
exit(0);
__END__

如果代码后面有POD，通常只使用__END__。 如果您将“Done that”移到POD上方，则__END__对我来说更有意义。

请随意修改这两个文件。我在这里没有好的风格或做法（有时我从短文件开始，然后根据需要粘贴长文件中的块，最终得到两种trolols的代码样式）。

网页内容由stack overflow 提供, 点击上面的
可以查看英文原文，
原文链接