Sonovapeer.pl

Legacy: This article describes a concept that has been superseded in the course of ongoing development on the Organic Design wiki. Please do not develop this any further or base work on this concept, this is only useful for a historic record of work done. You may find a link to the currently used concept or function in this article, if not you can contact the author to find out what has taken the place of this legacy item.

<perl>

1. !/usr/bin/perl

use strict; use POSIX qw(strftime); use Net::POP3; use HTTP::Request; use LWP::UserAgent; use Sys::Hostname;

1. Globals

our $client = LWP::UserAgent->new( cookie_jar => {} ); our %pops = ( 'pop.mail.yahoo.com.au' => ['punk1729','peer.pl'], 'mail.div0.com' => ['talkpage+div0.com','42'] ); our %wikis = ( 'organicdesign.co.nz' => ['OrganicDesign','http://www.organicdesign.co.nz/wiki/index.php','Sonovapeer','peer.pl'], 'div0.com' => ['Div0','http://www.organicdesign.co.nz/wiki/index.php','Sonovapeer','peer.pl'] ); our %queue = (); # hash of list of list (domain/messages/fields) our $peer = hostname; # Peer represents the host, so takes hostname.langext/role/instance/child... $peer .= '.pl';

1. TODO
2. get pop3-tasks and wiki-sync aspects running quanta-stylez from snipits
3. that way they migrate to the nodal model much easier

1. Set up output logging

sub logAdd { my $entry = shift; if ( open LOG, '>>', "$peer.log" ) { print LOG localtime()." : $entry\n"; print localtime()." : $entry\n"; close LOG; } }

1. Read in and execute a snipit

sub declare { my $snipit = shift; if ( open FH, '<', $snipit ) { binmode FH; sysread FH, my $code, 1000000; close FH; eval $code; logAdd $@ if $@; } else { logAdd "Couldn't declare $snipit!" } }

1. Import wiki integration functions

declare 'wiki.pl';

1. -------------------------------------------------------------------------------------------------------------#
2. INPUT PHASE

1. should be some kind of class loop here

1. Loop through all POP boxes (all items in this class)

while ( my($server, $info) = each %pops ) {

# Login in to this POP box logAdd "$peer is retrieving messages from $server"; my $pop = Net::POP3->new( $server ); logAdd "Could not log in to $server!" unless $pop->login( @$info );

# Loop through all messages my $list = $pop->list(); for my $id (keys %$list) {

# Get relevent message headers and content my $msg = $pop->top($id, 1000);

# From (my $from) = grep /^from:/i, @$msg; $from =~ s/^.+?<(.+)>.*/$1/s;

# To (my $to) = grep /^to:/i, @$msg; $to =~ m/^.+?<(.+)@(.+)>.*/s; $to = $1.'@'.$2;

# Page my ($page, $domain) = ($1,$2); $page =~ s/&&/&/g; $page =~ s/&(..)/pack("c", hex($1))/eg; $page =~ s/([^\w\-\.\@])/$1 eq "\n" ? "\n" : sprintf( "%%%2.2x", ord($1) )/eg;

# Subject (my $subject) = grep /^subject:/i, @$msg; $subject =~ s/^.+?:\s*(.*)(\r?\n)*/$1/;

# Delete message and queue by domain logAdd "Message removed and task queued for $domain"; #$pop->delete($id); $msg = join , @$msg; $msg =~ s/^.+\r?\n\r?\n//sm; $msg =~ s/\s+$//sm; push @{$queue{$domain}}, [$from, $to, $subject, $page, $msg]; }

# Logout of this POP $pop->quit(); }

1. -------------------------------------------------------------------------------------------------------------#
2. OUTPUT PHASE

while ( my ($domain, $tasks) = each %queue ) {

if ( exists $wikis{$domain} ) {

# Log in to associated wiki my ($name, $wiki, $user, $pass) = @{$wikis{$domain}}; wikiLogin( $wiki, $user, $pass );

# Loop through all the tasks queued for this wiki for my $task ( @$tasks ) {

my ($from, $to, $subject, $page, $msg) = @$task;

# Get the current content of the page my $content = wikiRawPage( $wiki, $page ); $content = if $content eq '(There is currently no text in this page)'; $content = "----\n$content";

# Prepend the new message and sign $subject = "(Email edit by $from) $subject"; my $ts = strftime "%H:%M, %e %b %Y (NZDT)", localtime; $content = "$msg\n:$from $ts\n$content";

# Write the new content back to the wiki wikiPageEdit( $wiki, $page, $content, $subject ); }

# Log out of wiki wikiLogout( $wiki ); }

else { logAdd "No rules for $domain" } } </perl>