view release on metacpan or  search on metacpan

lib/Test/Reporter.pm  view on Meta::CPAN

          undef $domain if $^O eq 'darwin' && $domain =~ /\.local$/;

          return $domain if (defined $domain && $domain !~ /\$/);
      }

      if (open(my $cf, "<", "/usr/lib/smail/config")) {
          while (<$cf>) {
              if (/\A\s*hostnames?\s*=\s*(\S+)/) {
                  $domain = (split(/:/,$1))[0];
                  undef $domain if $^O eq 'darwin' && $domain =~ /\.local$/;
                  last if defined $domain and $domain;
              }
          }
          close($cf) || die $!;

          return $domain if defined $domain;
      }

      if (eval {require Net::SMTP}) {
          for my $host (qw(mailhost smtp localhost)) {

            # default timeout is 120, which is Very Very Long, so lower
            # it to 5 seconds. Total slowdown will not be more than
            # 15 seconds ( 5 x @hosts ) --kane
            my $smtp = eval {Net::SMTP->new($host, Timeout => 5)};

            if (defined $smtp) {
                $domain = $smtp->domain;
                $smtp->quit;
                undef $domain if $^O eq 'darwin' && $domain =~ /\.local$/;
                last if defined $domain and $domain;
            }
          }
      }

      unless (defined $domain) {
          if ($self->_have_net_domain()) {
              ###################################################################
              # The below statement might possibly exhibit intermittent blocking
              # behavior. Be advised!
              ###################################################################
              $domain = Net::Domain::domainname();
              undef $domain if $^O eq 'darwin' && $domain =~ /\.local$/;
          }
      }

      $domain = "localhost" unless defined $domain;

      return $domain;
  }
}

# From Mail::Util 1.74 (c) 1995-2001 Graham Barr (c) 2002-2005 Mark Overmeer
sub _mailaddress {
    my $self = shift;
    warn __PACKAGE__, ": _mailaddress\n" if $self->debug();

    my $mailaddress = $ENV{MAILADDRESS};
    $mailaddress ||= $ENV{USER}    ||
                     $ENV{LOGNAME} ||
                     eval {getpwuid($>)} ||
                     "postmaster";
    $mailaddress .= '@' . $self->_maildomain() unless $mailaddress =~ /\@/;
    $mailaddress =~ s/(^.*<|>.*$)//g;

    my $realname = $self->_realname();
    if ($realname) {
        $mailaddress = "$mailaddress ($realname)";
    }

    return $mailaddress;
}

sub _realname {
    my $self = shift;
    warn __PACKAGE__, ": _realname\n" if $self->debug();

    my $realname = '';

    $realname =
        eval {(split /,/, (getpwuid($>))[6])[0]} ||
        $ENV{QMAILNAME}                          ||
        $ENV{REALNAME}                           ||
        $ENV{USER};

    return $realname;
}

sub _is_a_perl_release {
    my $self = shift;
    warn __PACKAGE__, ": _is_a_perl_release\n" if $self->debug();

    my $perl = shift;

    return $perl =~ /^perl-?\d\.\d/;
}

1;

# ABSTRACT: sends test results to cpan-testers@perl.org

=pod

=encoding UTF-8

=head1 NAME

Test::Reporter - sends test results to cpan-testers@perl.org

=head1 VERSION

version 1.62

=head1 SYNOPSIS

  use Test::Reporter;

  my $reporter = Test::Reporter->new(
      transport => 'File',
      transport_args => [ '/tmp' ],
  );

  $reporter->grade('pass');
  $reporter->distribution('Mail-Freshmeat-1.20');
  $reporter->send() || die $reporter->errstr();

  # or

  my $reporter = Test::Reporter->new(
      transport => 'File',
      transport_args => [ '/tmp' ],
  );

  $reporter->grade('fail');
  $reporter->distribution('Mail-Freshmeat-1.20');
  $reporter->comments('output of a failed make test goes here...');
  $reporter->edit_comments(); # if you want to edit comments in an editor
  $reporter->send() || die $reporter->errstr();

  # or