diff options
| author | Guilhem Moulin <guilhem@fripost.org> | 2015-07-24 18:02:21 +0200 | 
|---|---|---|
| committer | Guilhem Moulin <guilhem@fripost.org> | 2015-07-24 18:02:21 +0200 | 
| commit | f64d7df93fa4d21ec2ea8cfa08ed9f58af23df9b (patch) | |
| tree | 3f6ea3bee9457413c7d2b2be216ffda80a842a27 | |
| parent | 7da4bafd83dbd8c84cc529b132ece06497d6f49d (diff) | |
Pass messages by reference.
| -rwxr-xr-x | imapsync | 40 | ||||
| -rw-r--r-- | lib/Net/IMAP/Sync.pm | 29 | 
2 files changed, 36 insertions, 33 deletions
| @@ -579,19 +579,19 @@ sub fix_missing($$$@) {      my $target = $name eq 'local' ? $rIMAP : $lIMAP;      my $attrs = join ' ', qw/MODSEQ FLAGS INTERNALDATE ENVELOPE BODY.PEEK[]/; -    $source->fetch(compact_set(@set), "($attrs)", sub(%) { -        my %mail = @_; -        return unless exists $mail{RFC822}; # not for us +    $source->fetch(compact_set(@set), "($attrs)", sub($) { +        my $mail = shift; +        return unless exists $mail->{RFC822}; # not for us -        my $from = first { defined $_ and @$_ } @{$mail{ENVELOPE}}[2,3,4]; +        my $suid = $mail->{UID}; +        my $from = first { defined $_ and @$_ } @{$mail->{ENVELOPE}}[2,3,4];          $from = (defined $from and @$from) ? $from->[0]->[2].'@'.$from->[0]->[3] : ''; -        print STDERR "$name($mailbox): UID $mail{UID} from <$from> ($mail{INTERNALDATE})\n" unless $CONFIG{quiet}; +        print STDERR "$name($mailbox): UID $suid from <$from> ($mail->{INTERNALDATE})\n" unless $CONFIG{quiet};          # don't bother checking for MULTIAPPEND, @set is probably rather small -        my @mail = ($mail{RFC822}, [ grep {lc $_ ne '\recent'} @{$mail{FLAGS}} ], $mail{INTERNALDATE}); -        my ($uid) = $target->append($mailbox, @mail); +        my ($tuid) = $target->append($mailbox, $mail); -        my ($lUID, $rUID) = $name eq 'local' ? ($mail{UID}, $uid) : ($uid, $mail{UID}); +        my ($lUID, $rUID) = $name eq 'local' ? ($suid, $tuid) : ($tuid, $suid);          print STDERR "$name($mailbox): Adding mapping (lUID,rUID) = ($lUID,$rUID)\n";          $STH_INSERT_MAPPING->execute($idx, $lUID, $rUID);      }); @@ -821,29 +821,33 @@ sub sync_messages($$) {          # don't fetch again the messages we've just added          my @ignore = $source eq 'local' ? keys %mapping : values %mapping; -        ($source eq 'local' ? $lIMAP : $rIMAP)->pull_new_messages(sub(%) { -            my %mail = @_; -            return unless exists $mail{RFC822}; # not for us +        ($source eq 'local' ? $lIMAP : $rIMAP)->pull_new_messages(sub($) { +            my $mail = shift; +            return unless exists $mail->{RFC822}; # not for us -            my @mail = ($mail{RFC822}, [ grep {lc $_ ne '\recent'} @{$mail{FLAGS}} ], $mail{INTERNALDATE}); -            push @sUID, $mail{UID}; +            my $length = length $mail->{RFC822}; +            my $suid = $mail->{UID}; +            if ($length == 0) { +                warn "$source($mailbox): WARNING: Ignoring new 0-length message (UID $suid)\n"; +                return; +            }              # use MULTIAPPEND if possible (RFC 3502) to save round-trips              $multiappend //= !$target->incapable('MULTIAPPEND'); +            push @sUID, $suid;              if (!$multiappend) { -                my ($uid) = $target->append($mailbox, @mail); -                push @tUID, $uid; +                push @tUID, $target->append($mailbox, $mail);              }              else {                  # proceed by batch of 1MB to save roundtrips without blowing up the memory -                if (@newmails and $buffer + length($mail{RFC822}) > 1048576) { +                if (@newmails and $buffer + $length > 1048576) {                      push @tUID, $target->append($mailbox, @newmails);                      @newmails = ();                      $buffer = 0;                  } -                push @newmails, @mail; -                $buffer += length $mail{RFC822}; +                push @newmails, $mail; +                $buffer += $length;              }          }, @ignore);          push @tUID, $target->append($mailbox, @newmails) if @newmails; diff --git a/lib/Net/IMAP/Sync.pm b/lib/Net/IMAP/Sync.pm index fc1ab81..5945746 100644 --- a/lib/Net/IMAP/Sync.pm +++ b/lib/Net/IMAP/Sync.pm @@ -607,28 +607,27 @@ sub remove($@) {  } -# $self->append($mailbox, RFC822, [FLAGS, [INTERNALDATE, ...]]) +# $self->append($mailbox, $mail, [...])  #   Issue an APPEND command with the given mails.  Croak if the server  #   did not advertize "UIDPLUS" (RFC 4315) in its CAPABILITY list.  #   Providing multiple mails is only allowed for servers advertizing  #   "MULTIAPPEND" (RFC 3502) in their CAPABILITY list.  #   Return the list of UIDs allocated for the new messages. -sub append($$$@) { +sub append($$@) {      my $self = shift;      my $mailbox = shift; +    return unless @_;      $self->fail("Server is read-only.") if $self->{'read-only'};      $self->fail("Server did not advertize UIDPLUS (RFC 4315) capability.")          if $self->incapable('UIDPLUS');      my @appends; -    while (@_) { -        my $rfc822 = shift; -        my $flags = shift; -        my $internaldate = shift; +    foreach my $mail (@_) {          my $append = ''; -        $append .= '('.join(' ',@$flags).') ' if defined $flags; -        $append .= '"'.$internaldate.'" ' if defined $internaldate; -        $append .= "{".length($rfc822)."}\r\n".$rfc822; +        $append .= '('.join(' ', grep {lc $_ ne '\recent'} @{$mail->{FLAGS}}).') ' +            if defined $mail->{FLAGS}; +        $append .= '"'.$mail->{INTERNALDATE}.'" ' if defined $mail->{INTERNALDATE}; +        $append .= "{".length($mail->{RFC822})."}\r\n".$mail->{RFC822};          push @appends, $append;      }      $self->fail("Server did not advertize MULTIAPPEND (RFC 3502) capability.") @@ -942,10 +941,10 @@ sub pull_new_messages($$@) {          $range .= "$since:4294967295";          $UIDNEXT = $self->{_CACHE}->{$mailbox}->{UIDNEXT} // $self->panic(); # sanity check -        $self->_send("UID FETCH $range ($attrs)", sub(%) { -            my %mail = @_; -            $UIDNEXT = $mail{UID} + 1 if $UIDNEXT <= $mail{UID}; -            $callback->(%mail) if defined $callback; +        $self->_send("UID FETCH $range ($attrs)", sub($) { +            my $mail = shift; +            $UIDNEXT = $mail->{UID} + 1 if $UIDNEXT <= $mail->{UID}; +            $callback->($mail) if defined $callback;          }) if $first < $UIDNEXT;          # update the persistent cache for UIDNEXT (not for HIGHESTMODSEQ @@ -972,7 +971,7 @@ sub push_flag_updates($$@) {      my $command = "UID STORE ".compact_set(@set)." FLAGS.SILENT ($flags) (UNCHANGEDSINCE $modseq)";      my %listed; -    $self->_send($command, sub(%) { my %mail = @_; $listed{$mail{UID}}++; }); +    $self->_send($command, sub($){ $listed{shift->{UID}}++; });      my %failed;      if ($IMAP_text =~ /\A\Q$IMAP_cond\E \[MODIFIED ([0-9,:]+)\] $RE_TEXT_CHAR+\z/) { @@ -1499,7 +1498,7 @@ sub _resp($$;$$$) {                  my $flags = join ' ', sort(grep {lc $_ ne '\recent'} @{$mail{FLAGS}}) if defined $mail{FLAGS};                  $self->{_MODIFIED}->{$uid} = [ $mail{MODSEQ}, $flags ];              } -            $callback->(%mail) if defined $callback and ($cmd eq 'FETCH' or $cmd eq 'STORE') and in_set($uid, $set); +            $callback->(\%mail) if defined $callback and ($cmd eq 'FETCH' or $cmd eq 'STORE') and in_set($uid, $set);          }          elsif (/\AENABLED((?: $RE_ATOM_CHAR+)+)\z/) { # RFC 5161 ENABLE              $self->{_ENABLED} //= []; | 
