view release on metacpan or  search on metacpan

plugins/demo/webmail  view on Meta::CPAN

#!/usr/bin/perl -w

use Digest::SHA1 qw(sha1_hex);
use AxKit2::Utils qw(xml_escape);
use Net::IMAP::Simple::NB;
use Matts::Message::Parser;
use Scalar::Util qw(weaken isweak);
use Data::Pageset;
use Time::Piece qw(gmtime);
use Text::Wrap qw(wrap);
use File::Temp qw(tempfile);

my %imap_cache;
my %password_cache;

sub conf_IMAP_Server;
sub conf_IMAP_Port;

sub register {
    my $self = shift;
    $self->register_hook('xmlresponse' => 'main_response');
    $self->register_hook('xmlresponse' => 'main_response_cont');
    $self->register_hook('xmlresponse' => 'auth_response');
    $self->register_hook('xmlresponse' => 'auth_response_cont');
}

sub main_response {
    my ($self, $input) = @_;
    
    my $client  = $self->client;
    my $headers = $client->headers_in;
    
    $client->notes('mail_response', DECLINED);
    
    my $cookie  = $headers->cookie('mail_session');
    
    # No cookie, skip to auth
    return DECLINED unless $cookie;
    
    # Cookie invalid/expired, skip to auth
    my $login = eval { decookie($cookie) };
    if ($@) {
        $self->log(LOGINFO, $@);
        $client->notes('cookie_failure', $@);
        return DECLINED;
    }
    
    my $server = shift @{ $imap_cache{$login} || [] };
    if ($server) {
        my $bref = $server->read(1);
        if (!defined $bref) {
            # connection went away, login again
            return $self->imap_login($input, $client, $headers, $login, $password_cache{$login}) if $password_cache{$login};
            return DECLINED; # if password isn't currently stored for some reason
        }
    }
    else {
        return $self->imap_login($input, $client, $headers, $login, $password_cache{$login}) if $password_cache{$login};
        return DECLINED; # if password isn't currently stored for some reason
    }
    
    push @{ $imap_cache{$login} }, $server;
    
    $self->display_page($input, $client, $headers, $login);
    
    # Everything IMAP happens as a continuation
    return CONTINUATION;

plugins/demo/webmail  view on Meta::CPAN

    my $relative = $full_uri;
    $relative =~ s/^\///;
    
    my $output = '<webmail><uri>' . xml_escape($relative) . '</uri>' .
                 '<base-uri>http://' . xml_escape($headers->header('Host') . $client->config->path) . '/</base-uri>' .
                 '<user>'. xml_escape($login) . '</user>';
    
    print "Full URI: $full_uri\n";
    if ($full_uri =~ /\/folder\/([^\/]+)(\/([^\/]*))?/) {
        my $folder = $1;
        my $msg = $3;
        print "URI parsed to: $folder, $msg\n";
        if ($msg) {
            return $self->display_email($input, $client, $headers, $login, $output, $folder, $msg);
        }
        else {
            return $self->display_folder_list($input, $client, $headers, $login, $output, $folder);
        }
    }
    elsif ($full_uri =~ /\/folders$/) {
        return $self->display_all_folders($input, $client, $headers, $login, $output);
    }
    else {
        return $self->display_main_page($input, $client, $headers, $login, \$output);
    }
}

sub display_main_page {
    my ($self, $input, $client, $headers, $login, $output) = @_;
    
    $$output .= '</webmail>';
    print "Output: $$output\n";
    
    $input->dom($$output);
    
    my $out = $input->transform(TAL($client->config->docroot . '/main.tal'));
    $out->output();
    $client->notes('mail_response', DONE);
    return $client->finish_continuation;
}

sub display_all_folders {
    my ($self, $input, $client, $headers, $login, $output) = @_;
    
    # get imap connection and delete it from the valid pool.
    my $imap = shift @{ $imap_cache{$login} || [] }
        || die "Should never get here without a valid IMAP connection";
    
    print "All Folders Using IMAP Server: $imap\n";
    
    # Get folders
    $imap->mailboxes(sub {
        my @boxes = @_;
        
        $output .= '<mailboxes>';
        
        my $start = "INBOX";
        
        my $sub;
        $sub = sub {
            weaken($sub) unless isweak($sub);
            
            my $num_msgs = shift;
            
            print "Got $start ($num_msgs)\n";
            
            $output .= '<mailbox><name>' . xml_escape($start) . '</name>' .
                                '<count>' . xml_escape($num_msgs) . '</count>' .
                       '</mailbox>';
            
            if (@boxes) {
                $start = shift @boxes;
                $imap->select($start, $sub);
            }
            else {
                $output .= '</mailboxes>';
                return $self->finish_output(\$output, $input, $client, 'folders.xsl');
            }
        };
        
        $imap->select($start, $sub);
    });
    
    return CONTINUATION;
}

sub display_folder_list {
    my ($self, $input, $client, $headers, $login, $output, $folder) = @_;
    
    # get imap connection and delete it from the valid pool.
    my $imap = shift @{ $imap_cache{$login} || [] }
        || die "Should never get here without a valid IMAP connection";
    
    print "Folder $folder list Using IMAP Server: $imap\n";
    
    $imap->select($folder, sub {
        my $num_in_selected = shift;
        
        if (!$num_in_selected) {
            # folder didn't exist probably
            $output .= '<error>' . xml_escape($Net::IMAP::Simple::errstr) . '</error>';
            return $self->finish_output(\$output, $input, $client);
        }
        
        my $pageset = Data::Pageset->new({
            total_entries => $num_in_selected,
            entries_per_page => 50,
            mode => 'slide',
            pages_per_set => 10,
        });
        
        $output .= pageset_xml($pageset, $headers);
        
        my $current = $pageset->first;
        my $last    = $pageset->last;
        
        $output .= '<contents folder="' . xml_escape($folder) . '">';
        
        my $sub;
        $sub = sub {
            weaken($sub) unless isweak($sub);
            my $headers = shift;
            
            if ($headers) {
                my ($from)  = grep {/^From:/i} @$headers;
                my ($subj)  = grep {/^Subject:/i} @$headers;
                my ($recvd) = grep {/^Received:/i} @$headers;
                my ($date)  = grep {/^Date:/i} @$headers;
                s/^.*?:\s*// for ($from, $subj, $recvd, $date);
                local $/="\r\n";
                chomp($from, $subj);
                
                my $parsed_recvd_time;
                my $time;
                if ($recvd =~ /(\d{1,2} [a-z]{3} \d{4} \d\d:\d\d:\d\d)/i) {
                    #print "parsing recieved header date: $1\n";
                    $time = Time::Piece->strptime($1, '%d %b %Y %H:%M:%S');
                }
                elsif ($date =~ /(\d{1,2} [a-z]{3} \d{4} \d\d:\d\d:\d\d)/i) {
                    #print "parsing Date header date: $1\n";
                    $time = Time::Piece->strptime($1, '%d %b %Y %H:%M:%S');
                }
                else {
                    $time = gmtime;
                }
                my $today = gmtime;
                my $today_midnight = $today - ($today->hour * 60 * 60 + $today->min * 60 + $today->sec);
                my $yesterday = $today_midnight - (60 * 60 * 24);
                my $output_date;
                if ($time >= $today_midnight) {
                    $output_date = "Today";
                }
                elsif ($time >= $yesterday) {
                    $output_date = "Yesterday";
                }
                else {
                    $output_date = join(' ', $time->day_of_month, $time->fullmonth, $time->year);
                }
                print "got mail: $subj ($output_date)\n";
                $output .= "<mail id='$current'>" . 
                             '<from>'    . xml_escape($from) . '</from>' .
                             '<subject>' . xml_escape($subj) . '</subject>' .
                             '<received_at><date>' . xml_escape($output_date) . '</date>' .
                                          '<time>' . xml_escape($time->hms) . '</time>' .
                             '</received_at>' .
                           '</mail>';
            }
            else {
                $self->log(LOGDEBUG, "Unable to get headers for $login/$folder::$current");
            }
            if ($current >= $last) {
                $output .= '</contents>';
                return $self->finish_output(\$output, $input, $client, 'contents.xsl');
            }
            else {
                $current++;
                $imap->top($current, $sub);
            }
        };
        $imap->top($current, $sub);
    });