view release on metacpan or  search on metacpan

lib/Mail/DMARC/Report/Receive.pm  view on Meta::CPAN

    if (! scalar @mess) {
        # imap server might not support SORT extension *Gmail*
        @mess = $imap->search( 'UNSEEN' );
    }

    print "\tfound " . scalar @mess . " messages\n" if $self->verbose;

    foreach my $i (@mess) {
        print $imap->seen($i) ? '*' : ' ';
        printf "[%03d] ", $i;
        my $message = $imap->get($i) or do {
            carp "unable to get message $i\n";
            next;
        };
        my $type = $self->from_email_simple( Email::Simple->new("$message") );
        next if !$type;
        my $done_box
            = $type eq 'aggregate' ? $a_done
            : $type eq 'forensic'  ? $f_done
            :                        croak "unknown type!";

        $imap->add_flags( $i, '\Seen' );
        if ( $done_box ) {
            $imap->copy( $i, $done_box ) or do {
                carp $imap->errstr;
                next;
            };
            $imap->add_flags( $i, '\Deleted' );
        };
    }

    $imap->quit;
    return 1;
}

sub from_file {
    my ( $self, $file ) = @_;
    croak "missing message" if !$file;
    croak "No such file $file: $!" if !-f $file;

    my $contents = $self->slurp($file);

    # Detect gzip by magic bytes \x1f\x8b
    if ( substr($contents, 0, 2) eq "\x1f\x8b" ) {
        my $xml;
        IO::Uncompress::Gunzip::gunzip( \$contents, \$xml )
            or croak "gunzip failed: $IO::Uncompress::Gunzip::GunzipError";
        $self->_init_for_file($file);
        return $self->handle_body($xml) ? 'aggregate' : undef;
    }

    # Detect zip by magic bytes PK\x03\x04
    if ( substr($contents, 0, 4) eq "PK\x03\x04" ) {
        my $xml;
        IO::Uncompress::Unzip::unzip( \$contents, \$xml )
            or croak "unzip failed: $IO::Uncompress::Unzip::UnzipError";
        $self->_init_for_file($file);
        return $self->handle_body($xml) ? 'aggregate' : undef;
    }

    # Detect XML by content (starts with optional BOM/whitespace then '<')
    if ( $contents =~ /\A(?:\xef\xbb\xbf)?\s*</ ) {
        $self->_init_for_file($file);
        return $self->handle_body($contents) ? 'aggregate' : undef;
    }

    return $self->from_email_simple(Email::Simple->new($contents));
}

sub _init_for_file {
    my ( $self, $file ) = @_;
    $self->report->init();
    $self->{_envelope_to} = undef;
    $self->{_header_from} = undef;
    $self->get_submitter_from_filename( File::Basename::basename($file) );
    return;
}

sub from_mbox {
    my ( $self, $file_name ) = @_;
    croak "missing mbox file" if !$file_name;

    # TODO: replace this module
    # commented out due to build test failures
    #   load "Mail::Mbox::MessageParser";
    #   croak "is Mail::Mbox::MessageParser installed?" if $@;

    #   my $file_handle = FileHandle->new($file_name);

    my $folder_reader; #  = Mail::Mbox::MessageParser->new(
    #       {   'file_name'    => $file_name,
    #           'file_handle'  => $file_handle,
    #           'enable_cache' => 1,
    #           'enable_grep'  => 1,
    #       }
    #   );

    croak $folder_reader unless ref $folder_reader;

    my $prologue = $folder_reader->prologue;
    print $prologue;

    while ( !$folder_reader->end_of_file() ) {
        $self->from_email_simple(
            Email::Simple->new( $folder_reader->read_next_email() ) );
    }
    return 1;
}

sub from_email_simple {
    my ( $self, $email ) = @_;

    $self->report->init();
    $self->{_envelope_to} = undef;
    $self->{_header_from} = undef;
    $self->get_submitter_from_subject( $email->header('Subject') );

    my $unzipper = {
        gz  => \&IO::Uncompress::Gunzip::gunzip,    # 2013 draft
        zip => \&IO::Uncompress::Unzip::unzip,      # legacy format
    };