问Perl -模式匹配中未初始化值$_的使用

EN

#!/usr/bin/perl

use warnings;
use strict;
use Test::More tests => 16;
use v5.10;
use Data::Dumper;

require_ok('Interview');

# Test URLs
my $test_urls = {
    'http://www.reddit.com'  => 1,
    'hurrdurrimasheep'       => 0
};

my $interview = new Interview;

# Test $interview to see if it's an instance of our 'Interview' class
isa_ok($interview, 'Interview');

# Test to see if $interview has the member functions 'a' and 'b'
can_ok($interview, qw/a b/);

eval { $interview->a; };

cmp_ok($@, '=~', /Oh boy, thats blown to bits/, 'Interview->a dies as expected when no url argument is given.');

eval { $interview->b; };

cmp_ok($@, '=~', /Rubbish/, "Interview->b dies as expected when there are no results in Interview->{'r'}");

# Test to see if the return value from $interview's 'a' member function 
# will either be '1' or '0'.
foreach my $url (keys $test_urls) {
    cmp_ok($interview->a($url), 'eq', $test_urls->{$url}, "Got expected result for Interview->a($url): [ $test_urls->{$url} ]");
}

open(STDOUT, ">/dev/null") || die "Can't redirect stdout";
my $interview_url_results = $interview->b;
close(STDOUT);

my $num_test_urls      = keys scalar $test_urls;
my $num_interview_urls = keys scalar $interview_url_results;

cmp_ok($num_test_urls, '==', $num_interview_urls, "Got expected number of urls returned from Interview->b(): [ $num_test_urls ]");

# The following test ensures that the Interview->b() member function
# is storing the codes returned from Interview->a() correctly.

foreach my $url (keys $interview_url_results) {
    my $expected_code = $test_urls->{$url};
    my $returned_code = $interview->{'r'}->{$url};

    cmp_ok($expected_code, '==', ($returned_code == 200 ? 1 : 0), "Got expected http code from Interview->b() for $url");
}

done_testing;

package Interview;

use strict;
use warnings;

sub new {
    my $c = shift;

    return bless {}, $c;
}

sub a {
    my ($self, $u) = @_;
    die 'Oh boy, thats blown to bits' if ! $u;

    my $c = "curl -sL -w '%{http_code} %{url_effective}' '$u' -o /dev/null";
    `$c` =~ /^(\d+)\s/;
    $self->{'r'}->{$u} = $1;

    return $self->{'r'}->{$u} == 200 ? 1 : 0;
}

sub b {
    my $self = shift;
    die 'Rubbish' if ! $self->{'r'};

    foreach my $u (keys %{$self->{'r'}}) {
       print "Results: $u -- $self->{'r'}->{$u}\n";
    }
    return $self->{'r'};
}

1;

[  ¯\_(ツ)_/¯ ~/Development/Interview ]: perl Interview.t
1..10
ok 1 - require Interview;
ok 2 - The object isa Interview
ok 3 - Interview->can(...)
Use of uninitialized value $_ in pattern match (m//) at Interview.t line 27.
ok 4 - Interview->a dies as expected when no url argument is given.
Use of uninitialized value $_ in pattern match (m//) at Interview.t line 31.
ok 5 - Interview->b dies as expected when there are no results in Interview->{'r'}
ok 6 - Got expected result for Interview->a(hurrdurrimasheep): [ 0 ]
ok 7 - Got expected result for Interview->a(http://www.reddit.com): [ 1 ]
ok 8 - Got expected number of urls returned from Interview->b(): [ 2 ]
ok 9 - Got expected http code from Interview->b() for hurrdurrimasheep
ok 10 - Got expected http code from Interview->b() for http://www.reddit.com