#!/usr/bin/perl use warnings; use strict; use English; use Mail::IMAPClient; use Socket; $ARGV[3] or die "usage: $0 host user password folder\n"; my $host = $ARGV[0]; my $user = $ARGV[1]; my $password = $ARGV[2]; my $folder = $ARGV[3]; my $imap = Mail::IMAPClient->new(); $imap->Debug(0); $imap->Server($host); $imap->connect() or die; $imap->User($user); $imap->Password($password); $imap->login() or die; $imap->Uid(1); $imap->Peek(1); $imap->Clear(1); #print map {"$_\n"} $imap->folders(); $imap->select($folder) or die; my @msgs = $imap->messages or die "Could not messages: $@\n"; print "@msgs\n"; print memory_consumption_ratio(), "\n"; my $size_max = 0; foreach my $msg (@msgs) { my $size = $imap->size($msg); $size_max = ($size_max > $size) ? $size_max : $size; print "message size of $msg = $size bytes\n"; my $string_raw = $imap->message_string_raw($msg); print "ms raw: ", memory_consumption_ratio($size_max), "\n"; my $string = $imap->message_string($msg); print "ms nor: ", memory_consumption_ratio($size_max), "\n"; print "NOT EQUAL\n" if ($string_raw ne $string); #print substr($string_raw, 0, 80), "]\n"; #print substr($string_raw, -80, 80), "]\n"; $imap->append('INBOX.Trash', $string_raw); $imap->append('INBOX.Trash', $string); } $imap->close(); print "ap nor: ", memory_consumption_ratio($size_max), "\n"; sub memory_consumption_of_pid { my @PID = (@_) ? @_ : ($PROCESS_ID); my $val; my @ps = qx{ ps o vsz @PID }; shift @ps; chomp @ps; my @val = map { $_ * 1024 } @ps; return(@val); } sub memory_consumption_ratio { my ($base) = @_; $base ||= 1; my ($consu) = memory_consumption_of_pid(); return($consu / $base); } package Mail::IMAPClient; sub message_string_raw { my $self = shift; my ($msg) = @_; my $sock = $self->{Socket}; print "Socket:[$sock]\n"; my $count = $self->Count($self->Count+1); print $sock "$count UID FETCH 1 BODY.PEEK[]\r\n"; my $buf; my $line; CORE::select( undef, undef, undef, 0.025 ); my $expected_size; local $/ = "\r\n"; $line = <$sock>; print $line; if ( $line =~ m/.*{(\d+)\}\r\n/o ) { $expected_size = $1; print "\nEXPECT $expected_size\n"; } #local $/; while ($buf .= <$sock> and (length $buf <= $expected_size)){ #print length $buf, "\n"; #CORE::select( undef, undef, undef, 0.025 ); } $line = <$sock>; print $line; if ( $line =~ m/$count OK FETCH.*\r\n/o ) { return(substr($buf, 0, $expected_size)) }else{ return(undef); } }