İyi bir Perl şablon scriptiniz var mı?

Question

Perl'de çok fazla programlama yapıyorum ve insanların kullandıkları ve paylaşmaya istekli bir "varsayılan" şablon Perl betiğine sahip olup olmadıklarını merak ettim.

Getopt işlevlerine sahip eski komut dosyalarından birini kopyalamaya başladım. İnsanların benzer bir şey yaptıklarını mı düşünüyorum?

Answer 1

Daha önce de söylediğim gibi, bir modülde benim yöntemler şablonum var: use PMG::PMGBase; ve emacs kullanıcısı olarak escafolding ilk komut dosyası için, perl-insert-start ve perl-add-getoption şablonlarına sahibim. : biraz yorucudur. Bana bir Perl şablon komut dosyası (aşağıya bakınız), ve onu aramak için bitiş kolaydır en Yani çalışma komut açma bölgesi:

#!/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 


} 

Answer 2

Benimki oldukça basit.

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

getopt gibi şeyler söz konusu, ben daha ayrıntılı şablonu yerken değer yapmak için yazma komut arasında yeterince ortak noktaları yoktur.

Answer 3

Birçok benzer komut dosyası için temel bir şablona ihtiyacım olduğunda, benzer parçaları yalnızca bir modüle dönüştürüyorum. farklıydı neyse App::Foo şablon modülünden devralan ve geçersiz olur

use App::Foo; 

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

: Daha sonra komut dosyası gibi bir şeye azaltır

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

... 

App::Template modülde, ne gerek koymak:

package App::Template; 

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

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

    ... 
    } 


sub process_command_line { ... } 

... 

Bu tür bir şey için CPAN'da bazı çerçeveler var, ancak bence bunu kendiniz yapmak ve tam olarak neyi almak kadar kolay. İhtiyacınız olmayan parçalarla uğraşmadan eed. Benim .vimrc dosyasında

Answer 4

Ben herhangi bir yeni Perl komut dosyasına

#!/usr/bin/perl 

use strict; 
use warnings; 

yazar

au BufNewFile *.pl s-^-#!/usr/bin/perl\r\ruse strict;\ruse warnings;\r\r- 

var. Ayrıca modülleri için

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

var, ama yine de olanlar için Module::Starter kullanma eğilimindedir.

Answer 5

: C-u M-| :~/scripts/perl-start-template.pl Emacs gelen boş bir tampon içerisinde bir boşluk seçtikten sonra İki taneye sahibim.

#!/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); 

Çabuk test için yukarıda kullanımı ancak daha sık kullanılmaktadır: sık sık yararlı bulmak daha fazla işlev ve örnekleri içeren bir Perl tek astara bir sargı ve ikinci bir biraz daha fazla olan bir eski bir Aşağıdakileri (tam bir modülü kesmediğimde.) Size POD yukarıdaki sonra __SON__ bana daha mantıklı "olduğunu Done" taşırsanız kodu sonra POD olacak eğer __SON__ genellikle sadece kullanılır

#!/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__ 

.

Bu ikisini istediğin kadar kesmekten çekinme. Burada iyi bir üslup ya da pratiğe karşı hiçbir iddiada bulunmam, (ve bazen kısa olanla başlıyorum ve trololler için iki kod stili ile bitene kadar daha uzun bir bloktan yapıştırıyorum.)