Re^2: Help with IO::Scalar and piping

Thanks. I figured I was piping it incorrectly. When you explained it I can see where I made my mistake. It is still either being interpreted incorrectly or I am really off somewhere as I cannnot get Mail::DKIM::Verifier to provide results as defined in the example. Here is my full code:

#!/usr/bin/perl

use strict;
use warnings;
use Data::Dumper;
use Email::Simple;
use Email::Simple::Creator;
use Email::Send;
use IO::Scalar;
use Mail::DKIM::Verifier;

use constant SENDER    =>    'test@circularbucket.com';
use constant SUBJECT    =>    'Email Message Report';


## Main 

# slurp the email from STDIN
my( $raw );
{ local $/ = undef; local *FILE; open FILE, "-"; $raw = <FILE>; close 
+FILE }

defined( $raw )
    or die( "Nothing read from STDIN!" );

# Create an IO::Handle for Mail::DKIM::Verifier to read message from
my( $raw_iohandle ) = new IO::Scalar( \$raw );

# Read from the IO::Handle
my( $mail ) = Mail::DKIM::Verifier->new();
$mail->load( $raw_iohandle );
$mail->CLOSE;

# Import message to Email::Simple
my( $incoming ) = Email::Simple->new( \$raw );





######################################################################
+##################################
# Message checks
######################################################################
+##################################

###############
# Are we spam?
my( $XSpamStatus ) = 0;
if ( $incoming->header( 'X-Spam-Status' ) =~ /^Yes.*score=([\S*])\s+/ 
+) {
    # we're spam, save the score
    $XSpamStatus = $1;
}

###############
# Check DKIM status
my( $result ) = $mail->result;

###############
# Gather who the message was from so we can send it back
my( $from_header ) = $incoming->header("From");

##############################
# Gather spam stats from the message
my $spam_stats1 = $incoming->header( 'X-Spam-Status' );

##############################
# Get SPF result from headers
my( $SPFStatus ) = 0;
if ( $incoming->header( 'Received-SPF' ) =~ /^pass.*/ ) {
    # we have a valid SPF record, so save the status
    $SPFStatus = 1;
}

##############################
# What MUA was used to send the message?
my $user_agent = $incoming->header( 'User-Agent' );






######################################################################
+####################################
# Generate the message to be sent back
######################################################################
+####################################
my( $body ) = <<BODY;

This is a test message. The test results will follow below.
-----------------------------------------------------------

BODY

if ( $XSpamStatus ) {
    $body .= "Message was scored as spam, with a score of $XSpamStatus
+\n";
}
else {
    $body .= "Message was not scored as spam.\n";
}



if ( $result ) {
    $body .= "Result1 was: $result\n";
}
else {
    $body .= "Result2 was: $result\n";
}


    $body .= "Return path was: $from_header\n";
    $body .= "Original test request was sent using: $user_agent\n";


if ( $SPFStatus ) {
    $body .= "\n\nSPF Record:     PASS\n";
}
else {
    $body .= "\n\nSPF Record:     FAIL\n";
}

foreach my $signature ($mail->signatures)
  {
      $body .= "signature identity: $signature->identity . \n";
      $body .= "verify result: $signature->result_detail . \n";
  }


my( $outgoing ) = Email::Simple->create(
    header =>    [
             From    =>    SENDER,
             To    =>    $from_header,
             Subject    => SUBJECT,
            ],
    body    => $body,
);
$outgoing->header_set( 'X-Processor' => 'email test script' );





######################################################################
+####################################
# Send the message back to the original sender
######################################################################
+####################################
my( $sender ) = Email::Send->new;
$sender->send( $outgoing );
[download]

Any nudges in the right direction are appreciated!

Comment on Re^2: Help with IO::Scalar and piping Download Code

Replies are listed 'Best First'.
Re^3: Help with IO::Scalar and piping by Corion (Patriarch) on Sep 27, 2009 at 12:01 UTC
As you don't tell where exactly you get the errors, it's kinda hard to guess what might be going wrong.	[reply]
Re^4: Help with IO::Scalar and piping by jakev383 (Initiate) on Sep 27, 2009 at 13:15 UTC
I am no longer getting an error, but the $result printed in the $body is always "none" regardless of whether the message is signed or not, and the foreach loop never adds anything to the $body at all, which leads me to believe that the data (message) is still not being loaded into the parser correctly. Thanks.	[reply]
Re^5: Help with IO::Scalar and piping by Corion (Patriarch) on Sep 27, 2009 at 15:13 UTC
Your code is littered with parts not relevant to the problem. Please reduce it by removing all parts of your program that do not relate to Mail::DKIM and getting a result from it. Also, I would assume that the result of the DKIM verifier depends on the input message, which you haven't supplied. Note that Mail::DKIM::Verifier seems to want SMTP-style line endings (`\r\n`), which your raw reading of a file might or might not produce.	[reply] [d/l]
A reply falls below the community's threshold of quality. You may see it by logging in.
Re^3: Help with IO::Scalar and piping by ikegami (Patriarch) on Sep 27, 2009 at 17:34 UTC
Standard input is already opened for your as `STDIN`, so `# slurp the email from STDIN my( $raw ); { local $/ = undef; local *FILE; open FILE, "-"; $raw = <FILE>; close +FILE }` [download] is an overly complex way of doing `# slurp the email from STDIN my $raw; { local $/; $raw = <STDIN>; }` [download] Why are you forcing a list assignment? `my( $raw_iohandle ) = new IO::Scalar( \$raw );` [download] should be `my $raw_iohandle = new IO::Scalar( \$raw );` [download] But then again, IO::Scalar is not nearly as robust as the native support for scalar handles added to 5.8 `open(my $raw_iohandle, '<', \$raw );` [download] Finally, if the module expects a system file handle (e.g. if it attempts a child process to read from it), it'll be disappointed by your attempts since none of the Perl file handles you are producing have a system file handle associated with it.	[reply] [d/l] [select]


Your skill will accomplish what the force of many cannot
	PerlMonks