perl AUTOLOAD

在调用之前,Perl不要求您声明每个函数。但是,它会因此而抛出异常。添加函数AUTOLOAD()可以防止这种情况发生。

autoload.pl
use Modern::Perl;
sub AUTOLOAD {say 'In AUTOLOAD()!'} # custom message to demonstrate its being called
bake_pie(filling => 'apple');

# The AUTOLOAD() function receives the arguments passsed to the undefined function in @_ 
# as well as the fully qualified name of the undefined function in the package global $AUTOLOAD(main::bake_pie)
sub AUTOLOAD {
  our AUTOLOAD;
  
  # pretty-print the arguments 
  local $" = ', ';
  say "In AUTOLOAD(@_) for $ AUTOLOAD!"
}
# Extract the method name with a regular expression
sub AUTOLOAD {
  my ($name) = our $AUTOLOAD =~ /::(\w+)$/;
  
  # pretty-print the arguments 
  local $" = ', ';
  say "In AUTOLOAD(@_) for $name!"
}
# Whatever AUTOLOAD() returns, the original call receives:
say secret_tangent(-1);
sub AUTOLOAD {return 'mu'}

perl 使用污点模式进行测试

这将影响程序中的所有代码以及所使用的所有模块。如果单个代码没有被污染干净,整个事情就会爆炸。但是,模块在污染模式下工作非常重要。

taint_mode.pl
# To have your tests run in taint mode, simply add a -T into the #! line:

#!/usr/bin/perl -Tw (paired with warnings here)
...test here as usual...

perl Todo测试

todo_tests.pl
\!h # Example:
# A test for using ical() to set the date in the Date::ICal test suite
use Test::More tests => 1;
use Date::ICal;

my $ical = Date::Ical->new;
$ical->ical('20201231Z');
is($ical->ical, '2020123Z', 'Setting via ical()');

# this produces:
1..1 
not ok 1 - Setting via ical()
# Failed test (- at line 6)
# got: '20010814T233649Z'
# expected: '20201231Z'
# Looks like you failed 1 tests of 1.

# Looks like it's unimplemented. Let's assume we don't have time to fix this. 
# Normally you would just comment out the test and put a note somewhere about it
# However, we'll wrap this test in TODO block, stating explicitly "this test will fail"
...
# That should have the same outcome but without the "Looks like you failed..." line
# That's because it now treats a failue as a successful test.

perl 跳过测试

skipping_tests.pl
use Test:More tests => 7;
use Data::ICal;

# Make sure epoch time is being handled sanely
my $t1 = Date::ICal->new( epoch => 0);
is($t1->epoch, 0,     "Epoch time of 0");

# Skip the tests in the curly brackets if MacOS, because the code won't work on that OS to begin with
SKIP: {
\!h skip('epoch to ICal not working on MacOS', 6) # 
\!h      if $^O eq 'MacOS';
  
  is($t1->ical, '19700101Z', " epoch to ical");
  ...
}

perl 测试的信息名称

informative_tests.pl
# Adding more detail about what we're testing and the ICal string itself
ok (defined $ical, "new(ical => '$ical_str')"); 

# so you'd get results like:
ok 25 new(ical => '19971024T120000')
ok 26 -  and it's the right class
ok 27 -  year()
...

perl 测试::更多

Test :: Simple是一个很好的起点。但是,它没有提供我们想要的那么多信息,特别是对于调试。对于升级,我们有Test :: More,它与Test :: Simple完全相同,甚至更多!

test_more.pl
# Firstly, instead of ok(), this module uses the is() function.
# This lets us declare that something is supposed to be the same as something else:

#!/usr/bin/perl -w

use Test::More tests => 8;

use Date::ICal;

$ical = Date::ICal->new(year => 1964, # create new object
                        month => 10,
                        day => 16, 
                        hour => 16,
                        min => 12,
                        sec => 47,
                        tz => '0530');

ok (defined $ical, 'new() returned something'); # check we have something
ok ($ical->isa('Date::ICal'), " and it's the right class"); # check it's the right class
is ($ical->sec, 47, ' sec()'); # check if the seconds are 47
is ($ical->min, 12 ' min()'); # if the minutes are 12
is ($ical->hour, 16, ' hour()'); # if the hour is 16
is ($ical->day, 17, ' day()'); # if the day is 17
is ($ical->month, 10, ' month()'); # if the month is 10
is ($ical->year, 1964, ' year()'); # if the year is 1964

# with is() in place, you get more information:
1..8 
ok 1 - new() returned something
ok 2 -  and it's the right class
ok 3 -  sec()
ok 4 -  min()
ok 5 -  hour()
not ok 6 -  day()
# Failed test (-at line 16)
# got: '16'
# expected: '17' 
ok 7 -  month()
ok 8 -  year()
# Looks like you failed 1 tests of 8

perl 给测试命名

通过大量测试,每个测试都可以给出一个描述性名称作为ok()的第二个参数。

test_names.pl
use Test::Simple tests => 2;

ok(defined $ical,            'new() returned something'); # checking we have something
ok($ical->isa('Date::ICal'), " and it's the right class" ); # checking its the right class

# the above prints:
1..2 
ok 1 - new() returned something
ok 2 -  and it's the right class

perl 使用Test :: Simple进行测试

解释了Perl中最基本的测试形式。

test_simple.pl
\!h # the setup:

#!/usr/bin/perl -w

print "1..1\n";

print 1 + 1 == 2 ? "ok 1\n" : "not ok 1\n";

# ... because 1 + 1 is 2, it prints:
1..1 # I'm going to run 1 test
ok 1 # The first test passed

\!h # Making things easier with Test::Simple:
#!/usr/bin/perl -w

use Test::Simple tests => 1;

ok(1 + 1 == 2); # the same as the first example
# if ok() gets a true value, the test passes. If false, it fails.

\!h # Multiple tests:

#!/usr/bin/perl -w 
use Test::Simple tests => 2;
ok(1 + 1 == 2);
ok(2 + 2 == 5);

# from that you get...
1..2 # I'm going to run two tests
ok 1 
not ok 2
# Failed test (test.pl at line 5)
# Looks like you failed 1 tests of 2

perl 属性

声明变量和函数后附加的其他元数据。属性是与某些类型的元编程一起使用的任意名称和值。

attributes.pl
\!h # the simplest form of this:
my $fortress      :hidden; # colon-preceded identifier attached to a declaration

# same thing with a function:
sub erupt_volcano :ScienceProject {...}

# Attributes can also contain a list of parameters, they are treated as lists of constant strings
# Good example with the Test::Class module:
sub setup_tests           :Test(setup)     {...}
sub test_monkey_creation  :Test(10)        {...}
sub shutdown_tests        :Tests(teardown) {...}  
# The 'Test' attribute identifies methods that include test assertions and optionally identifies the number of assertions the method intends to run

perl 关闭

使用外部作用域的词法变量的函数。

closures.pl
my $filename = shift @ARGV;
sub get_filename {return $filename}

# Return the next item in an iteration:

sub make_iterator {
  my @items = @_;
  my $count = 0;
  
  return sub {
    return if $count == @items;
    return $items[$count++];
  }
}

my $cousins = make_iterator (qw(Rick Alex Kaycee Eric Corey Mandy Christine Alex));
say $cousins->() for 1..6;