Edit D:\app\Administrator\product\11.2.0\dbhome_1\sysman\admin\scripts\Net\IMAP\SimpleConn.pm

#############################################################################
# NOTE: Simple.pm in this directory is the original perl module file.
# The original perl module file has been modified slightly in this file.
# The following are the changes between the original perl module
# file and this file:
#
# 1. Line 1 of method "new"
#    The original file has:
#            my ( $class, $server, %options ) = @_;
#    The modified file(this file) has:
#            my ( $class, $server, $port,$timeout, %options ) = @_;
#
# 2. Line 10 of method "new"
#    The original file has:
#            $self->{sock} = new IO::Socket::INET( "$server:143" )
#    The modified file(this file) has:
#            $self->{sock} = new IO::Socket::INET( PeerAddr => $server,
#                                                  PeerPort => $port,
#                                                  Timeout  => $timeout )
#
# Summary of the changes: The original perl module file hardcodes
# the port in the method "new". The changed file(this file) makes the port
# a parameter to the method "new".
#
#############################################################################
package Net::IMAP::SimpleConn;

use strict;
use vars qw($VERSION);

$VERSION = '0.93';

use IO::Socket;
use IO::File;

#############################################################################
#
#
#
#############################################################################

sub new {
    my ( $class, $server, $port,$timeout, %options ) = @_;
    
    if (! defined $timeout || $timeout==0 )
    {
       $timeout = 240;
    }
    my ( $self );

if ( ref( $class ) ) {
        $class = ref( $class );
    }

$self = { %options };
    $self->{count} = 0;
    $self->{sock} = new IO::Socket::INET( PeerAddr => $server,
                                          PeerPort => $port,
                                          Timeout  => $timeout )
        or return;
    $self->{sock}->getline();

bless $self, $class;
    return $self;
}

#############################################################################
#
#
#
#############################################################################

sub _nextid {
    my ( $self ) = @_;

return $self->{count}++;
}

#############################################################################
#
#
#
#############################################################################

sub _escape {
    my ( $str ) = @_;

$str =~ s/\\/\\\\/g;
    $str =~ s/\"/\\\"/g;
    $str = "\"$str\"";

return $str;

}

#############################################################################
#
#
#
#############################################################################

sub _unescape {
    my ( $str ) = @_;

$str =~ s/^"//g;
    $str =~ s/"$//g;
    $str =~ s/\\\"/\"/g;
    $str =~ s/\\\\/\\/g;

return $str;

}

#############################################################################
#
#
#
#############################################################################

sub login {
    my ( $self, $user, $pass ) = @_;
    my ( $sh, $id, $resp );

$sh = $self->{sock};
    $id = $self->_nextid();
    
    print $sh "$id LOGIN $user $pass\r\n";
    $resp = $sh->getline();

if ( $resp =~ /^$id\s+OK/i ) {
        return $self->select( 'INBOX' );
    }

return;

}

#############################################################################
#
#
#
#############################################################################

sub select {
    my ( $self, $mbox ) = @_;
    my ( $sh, $id, $resp, $nmsg );

$sh = $self->{sock};
    $id = $self->_nextid();

$mbox = _escape( $mbox );
    
    print $sh "$id SELECT $mbox\r\n";
    while ( $resp = $sh->getline() ) {
        if ( $resp =~ /^\*\s+(\d+)\s+EXISTS/i ) {
            $nmsg = $1;
        } elsif ( $resp =~ /^$id\s+(OK|NO|BAD)/i ) {
            last;
        }
    }

if ( defined $nmsg && $resp =~ /$id\s+OK/i ) {
        $self->{last} = $nmsg;
        return $nmsg;
    }

return;
}

#############################################################################
#
#
#
#############################################################################

sub top {
    my ( $self, $msgn ) = @_;
    my ( $sh, $id, $resp, $lines );

$sh = $self->{sock};
    $id = $self->_nextid();
    
    print $sh "$id FETCH $msgn rfc822.header\r\n";

while ( $resp = $sh->getline() ) {
        if ( $resp =~ /^\*/ ) {
            next;
        }
        if ( $resp =~ /^$id\s+(OK|NO|BAD)/i ) {
            last;
        }
        push @$lines, $resp;
    }

if ( $resp =~ /$id\s+OK/i ) {
        pop @$lines;
        return $lines;
    }

return;

}

#############################################################################
#
#
#
#############################################################################

sub seen {
    my ( $self, $msgn ) = @_;
    my ( $sh, $id, $resp, $lines );

$sh = $self->{sock};
    $id = $self->_nextid();
    
    print $sh "$id FETCH $msgn (FLAGS)\r\n";

while ( $resp = $sh->getline() ) {
        if ( $resp =~ /^$id\s+(OK|NO|BAD)/i ) {
            last;
        }
        $lines .= $resp;
    }

if ( $resp =~ /$id\s+OK/i ) {
        return $lines =~ /\\Seen/i;
    }

return;

}

#############################################################################
#
#
#
#############################################################################

sub list {
    my ( $self, $msgn ) = @_;
    my ( $sh, $id, $resp, $hash );

$sh = $self->{sock};
    $id = $self->_nextid();

if ( defined $msgn ) {
        print $sh "$id FETCH $msgn RFC822.SIZE\r\n";
    } else {
        print $sh "$id FETCH 1:$self->{last} RFC822.SIZE\r\n";
    }

while ( $resp = $sh->getline() ) {
        if ( $resp =~ /^\*\s+(\d+).*RFC822.SIZE\s+(\d+)/i ) {
            $hash->{$1} = $2;
            next;
        }
        if ( $resp =~ /^$id\s+(OK|NO|BAD)/i ) {
            last;
        }
    }
    
    if ( $resp =~ /$id\s+OK/i ) {
        if ( defined $msgn ) {
            return $hash->{$msgn};
        } else {
            return $hash;
        }
    }

return;
}

#############################################################################
#
#
#
#############################################################################

sub get {
    my ( $self, $msgn ) = @_;
    my ( $sh, $id, $resp, $lines );

$sh = $self->{sock};
    $id = $self->_nextid();
    
    print $sh "$id FETCH $msgn rfc822\r\n";

if ( $resp =~ /$id\s+OK/i ) {
        pop @$lines;
        return $lines;
    }

return;

}

#############################################################################
#
#
#
#############################################################################

sub getfh {
    my ( $self, $msgn ) = @_;
    my ( $sh, $id, $resp, $buffer, $fh );

$fh = IO::File->new_tmpfile()
        or return;

$sh = $self->{sock};
    $id = $self->_nextid();
    
    print $sh "$id FETCH $msgn rfc822\r\n";

while ( $resp = $sh->getline() ) {

if ( $resp =~ /^\*/ ) {
            next;
        }
        if ( $resp =~ /^$id\s+(OK|NO|BAD)/i ) {
            last;
        }

print $fh $buffer if ( defined $buffer );
        $buffer = $resp;
    }

if ( $resp =~ /$id\s+OK/i ) {
        seek $fh, 0, 0;
        return $fh;
    }

$fh->close();
    return;

}

#############################################################################
#
#
#
#############################################################################

sub quit {
    my ( $self ) = @_;
    my ( $sh, $id );

$sh = $self->{sock};
    $id = $self->_nextid();
    print $sh "$id EXPUNGE\r\n";

$id = $self->_nextid();
    print $sh "$id LOGOUT\r\n";
    <$sh>;
    close $sh;

return 1;
}

#############################################################################
#
#
#
#############################################################################

sub last {
    my ( $self ) = @_;

return $self->{last};

}

#############################################################################
#
#
#
#############################################################################

sub delete {
    my ( $self, $msgn ) = @_;
    my ( $sh, $id, $resp );

$sh = $self->{sock};
    $id = $self->_nextid();

print $sh "$id STORE $msgn +FLAGS (\\Deleted)\r\n";
    while ( ( $resp = $sh->getline() ) && $resp !~ /^$id\s+(OK|NO|BAD)/i ) {
        next;
    }
    if ( $resp =~ /^$id\s+OK/i ) {
        return 1;
    }
        
    return;

}

#############################################################################
#
#
#
#############################################################################

sub mailboxes {
    my ( $self ) = @_;
    my ( $sh, $id, $resp, @list );

$sh = $self->{sock};
    $id = $self->_nextid();

print $sh "$id LIST \"\" *\r\n";
    while ( $resp = $sh->getline() ) {
        if ( $resp =~ /^\*\s+LIST.*\s+\{\d+\}\s*$/i ) {
            $resp = $sh->getline();
            chomp( $resp );
            $resp =~ s/\r$//;
            push @list, _escape( $resp );
        } elsif ( $resp =~ /^\*\s+LIST.*\s+(\".*?\")\s*$/i ) {
            push @list, $1;
        } elsif ( $resp =~ /^\*\s+LIST.*\s+(\S+)\s*$/i ) {
            push @list, $1;
        } elsif ( $resp =~ /^$id\s+(OK|NO|BAD)/i ) {
            last;
        }
    }

if ( $resp =~ /^$id\s+OK/i ) {
        map { $_ = _unescape( $_ ) } @list;

#        map { s/\\\"/\"/g } @list;
#        map { s/^\"// } @list;
#        map { s/\"$// } @list;
        return @list;
    }

return;
}

#############################################################################
#
#
#
#############################################################################

sub create_mailbox {
    my ( $self, $mbox_name ) = @_;
    my ( $sh, $id, $resp, @list );

$sh = $self->{sock};
    $id = $self->_nextid();

$mbox_name = _escape( $mbox_name );

print $sh "$id CREATE $mbox_name\r\n";
    $resp = $sh->getline();

if ( $resp =~ /^$id\s+OK/i ) {
        return 1;
    }

return;
}

#############################################################################
#
#
#
#############################################################################

sub delete_mailbox {
    my ( $self, $mbox_name ) = @_;
    my ( $sh, $id, $resp, @list );

$sh = $self->{sock};
    $id = $self->_nextid();

$mbox_name = _escape( $mbox_name );

print $sh "$id DELETE $mbox_name\r\n";
    $resp = $sh->getline();

if ( $resp =~ /^$id\s+OK/i ) {
        return 1;
    }

return;
}

#############################################################################
#
#
#
#############################################################################

sub rename_mailbox {
    my ( $self, $mbox_name, $new_name ) = @_;
    my ( $sh, $id, $resp, @list );

$sh = $self->{sock};
    $id = $self->_nextid();

$mbox_name = _escape( $mbox_name );
    $new_name = _escape( $new_name );

print $sh "$id RENAME $mbox_name $new_name\r\n";
    $resp = $sh->getline();

if ( $resp =~ /^$id\s+OK/i ) {
        return 1;
    }

return;
}

#############################################################################
#
#
#
#############################################################################

sub copy {
    my ( $self, $msgn, $mbox_name ) = @_;
    my ( $sh, $id, $resp, @list );

$sh = $self->{sock};
    $id = $self->_nextid();

$mbox_name = _escape( $mbox_name );

print $sh "$id COPY $msgn $mbox_name\r\n";
    $resp = $sh->getline();

if ( $resp =~ /^$id\s+OK/i ) {
        return 1;
    }

return;
}

1;
__END__

=head1 NAME

Net::IMAP::Simple - Perl extension for simple IMAP account handling, mostly 
compatible with Net::POP3.

=head1 SYNOPSIS

use Net::IMAP::Simple;

# open a connection to the IMAP server
    $server = new Net::IMAP::Simple( 'someserver' );

# login
    $server->login( 'someuser', 'somepassword' );
    
    # select the desired folder
    $number_of_messages = $server->select( 'somefolder' );

# go through all the messages in the selected folder
    foreach $msg ( 1..$number_of_messages ) {

if ( $server->seen( $msg ) {
            print "This message has been read before...\n"
        }

# get the message, returned as a reference to an array of lines
        $lines = $server->get( $msg );

# print it
        print @$lines;

# get the message, returned as a temporary file handle
        $fh = $server->getfh( $msg );
        print <$fh>;
        close $fh;

}

# the list of all folders
    @folders = $server->mailboxes();

# create a folder
    $server->create_mailbox( 'newfolder' );

# rename a folder
    $server->rename_mailbox( 'newfolder', 'renamedfolder' );

# delete a folder
    $server->delete_mailbox( 'renamedfolder' );

# copy a message to another folder
    $server->copy( $self, $msg, 'renamedfolder' );

# close the connection
    $server->quit();

=head1 DESCRIPTION

This module is a simple way to access IMAP accounts. The API is mostly
equivalent to the Net::POP3 one, with some aditional methods for mailbox
handling.

=head1 BUGS

I don't know how the module reacts to nested mailboxes.

This module was only tested under the following servers:

=over 4

=item *

Netscape IMAP4rev1 Service 3.6

=item *

MS Exchange 5.5.1960.6 IMAPrev1 (Thanks to Edward Chao)

=item *

Cyrus IMAP Server v1.5.19 (Thanks to Edward Chao)

=back

Expect some problems with servers from other vendors (then again, if
all of them are implementing the IMAP protocol, it should work - but
we all know how it goes).

=head1 AUTHOR

Joao Fonseca, joao_g_fonseca@yahoo.com

=head1 SEE ALSO

Net::IMAP(1), Net::POP3(1).

=head1 COPYRIGHT

=cut

Ms-Dos/Windows Unix Write backup

jsp File Browser version 1.2 by www.vonloesch.de