#!/usr/bin/perl

# mono-integration 0.1
# 
# Copyright (c) 2007 Thomas Thurman
#
# Permission is hereby granted, free of charge, to any person obtaining a copy
# of this software and associated documentation files (the "Software"), to deal
# in the Software without restriction, including without limitation the rights
# to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
# copies of the Software, and to permit persons to whom the Software is
# furnished to do so, subject to the following conditions:
#
# The above copyright notice and this permission notice shall be included in
# all copies or substantial portions of the Software.
#
# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
# AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
# OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
# THE SOFTWARE.

use strict;
use warnings;
use Data::Dumper;
use BBS::Monochrome;
use CGI;
use Storable;

my $datastore = '../accounts/';

my $query = new CGI;

my %vars = $query->Vars();
my $path_info = $query->path_info();
my %user_details;

print "Content-Type: application/xml\n\n";

if (!defined $vars{fb_sig_user}) {
	not_logged_in();
} elsif (!$vars{fb_sig_in_canvas}) {
	needs_to_be_a_canvas();
} elsif ($path_info eq "/login") {
	login_page();
} else {
	%user_details = fetch_user_details();

	if (!%user_details) {
		dont_know_you();
	} elsif ($path_info =~ /\/diary/) {
		diary_page();
	} elsif ($path_info =~ /\/status/) {
		status_page();
	} elsif ($path_info =~ /\/signout/) {
		signout_page();
	} else {
		main_page();
	}
}

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

sub main_page {
	write_dashboard();

	print "<p>Hello, <b>$user_details{login}</b>, and welcome to the unofficial Monochrome\n";
	print "Facebook application. Please choose from among the options in\n";
	print "the dashboard above.</p>";
}

sub not_logged_in {
	print "<fb:header>You need to add the Facebook application for this to work.</fb:header>\n";
}

sub needs_to_be_a_canvas {
	print "<fb:header>Internal problem</fb:header>\n";
	print "You're attempting to view this as a non-canvas page. Be sensible.";
}

sub dont_know_you {
	print "<fb:header>I don't feel as if I know you...</fb:header>\n";

	print "<p>Great! You've added the Monochrome Facebook application, but I\n";
	print "don't know your Monochrome login name. Care to enlighten me?</p>\n\n";

	print "<form method=\"POST\" action=\"http://apps.facebook.com/monochrome/login\">\n";
	print "Login: <input type=\"text\" name=\"login\"/><br>";
	print "Password: <input type=\"password\" name=\"password\"/><br>";
	print "<input type=\"submit\" value=\"OK\"/><br>";
	print "</form>";

	print "<p>If you don't have an account yet, try going to <a href=\"http://www.mono.org\">the\n";
	print "Mono website</a>.</p>";
}

sub login_page {

	my $login = $vars{login};
	my $password = $vars{password};

	if (!$login || !$password) {
		dont_know_you();
		return;
	}

	print "<fb:header>Trying to synch with Monochrome...</fb:header>\n";
	write_dashboard();

	my $mono = BBS::Monochrome->new(login=>$login, password=>$password);

	if ($mono) {
		leave_file_context($mono);

		$mono->send_escape();
		$mono->put('Y');
		$mono->waitfor('/\[\?\]:Help/');
		$mono->put('N');
		$mono->waitfor('/\(Up to 40 characters\) : /');

		my $nameline = $mono->get();

		$mono->logout();

		print "<p>Hello, <b>$nameline</b>. Obviously you do have a working\n";
		print "Mono account. You don't need to press \"Forget login\" above unless\n";
		print "you want the Monochrome Facebook application to forget your\n";
		print "password (say, if you change it on Mono and want to re-enter it.)\n";
		print "Otherwise, stay logged in here as long as you like; it doesn't\n";
		print "time out.</p>\n";

		print "<p><a href=\"http://apps.facebook.com/monochrome/\">Continue...</a></p>";

		my %userinfo = ( login=>$login, password=>$password );

		store \%userinfo, persistent();
	} else {
		print "<p>Either you don't really have a Mono account at all, or the\n";
		print "password you gave was wrong. You should\n";
		print "<a href=\"http://apps.facebook.com/monochrome/\">try again</a>, or\n";
		print "else <a href=\"http://www.mono.org\">ask the Mono people for support</a>.</p>\n";
	}
}

sub status_page {
	write_dashboard();

	if ($vars{feeling}) {

		$vars{feeling} = substr($vars{feeling}, 0, 50);

		my $mono = reliable_connection();

		$mono->goto('MTU');
		$mono->put('X');
		$mono->waitfor('/Text: /');
		$mono->print($vars{feeling});
		$mono->waitfor('/to continue/');
		$mono->print('');

		$mono->logout();

		print "<p><b>Okay, your status has been updated.</b></p>";

	}

	print <<EOT
		<p>This program allows you to tell everybody how you're feeling today, without
		the usual hassle of telling 20 people exactly the same thing.</p>

		<p>Simply type in a short line (50 chars) describing your feelings at this
		moment in time, and the world will know how you feel. Once you've told people
		that you use this file, they'll get used to looking at how you're feeling
		before putting their foot in it!</p>

		<p><b>REMINDER:</b> The Status file is NOT Xrated. Any swearing found
		in the file will be dealt with as a breach of 
		Monochrome's Conditions of Use.</p>

		<form method="POST" action="http://apps.facebook.com/monochrome/status">
		<p>So, how are you today? <input type="text" size="20" maxchars="50" name="feeling"/>
		<input type="submit" value="OK"/>
		</p></form>
EOT

}

sub diary_page {
	write_dashboard();

	if ($vars{subject} && $vars{diary}) {

		$vars{subject} = substr($vars{subject}, 0, 50);
		$vars{diary} =~ s/\n\./\n \./g;

		my $mono = reliable_connection();

		$mono->goto('MLY');
		$mono->put('D');
		$mono->put('A');
		$mono->waitfor('/Subject: /');
		$mono->print($vars{subject});
		$mono->print($vars{diary});
		$mono->print('.');
		$mono->waitfor('/====/');
		$mono->print(' ');

		$mono->logout();

		print "<p><b>Okay, your diary has been updated.</b></p>";

	}

	print <<EOT
		<p>This is where you can update your Monologue diary from within Facebook.
		If you don't have a diary, it probably won't work.</p>

		<form method="POST" action="http://apps.facebook.com/monochrome/diary">
		<input size="65" maxchars="65" name="subject"/><br>
		<textarea cols="50" rows="20" name="diary"/><br>
		<input type="submit" value="OK"/>
		</form>
EOT

}

sub signout_page {

	unlink persistent();

	print "<p>Okay, I've forgotten about you.\n";
	print "<a href=\"http://apps.facebook.com/monochrome/login\">Log back in?</a></p>\n";
}

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

sub write_dashboard {
	print "<fb:dashboard>\n";
	print "<fb:action href=\"http://apps.facebook.com/monochrome/\">Home</fb:action>\n";
	print "<fb:action href=\"http://apps.facebook.com/monochrome/status\">Set status</fb:action>\n";
	print "<fb:action href=\"http://apps.facebook.com/monochrome/diary\">Update diary</fb:action>\n";
	print "<fb:action href=\"http://apps.facebook.com/monochrome/signout\">Forget login</fb:action>\n";
	print "<fb:action href=\"http://www.mono.org\">www.mono.org</fb:action>\n";
	print "</fb:dashboard>\n\n";
}

sub fetch_user_details {
	my $filename = persistent();

	if (-e $filename) {
		return %{retrieve($filename)};
	} else {
		return ();
	}
}

sub reliable_connection {
	my $login = $user_details{login};
	my $password = $user_details{password};
	my $mono = BBS::Monochrome->new(login=>$login, password=>$password);

	check_actually_connected($mono);
	leave_file_context($mono);

	return $mono;
}

sub leave_file_context {
	my ($mono) = @_;

	while ($mono->context() eq 'file') {
		$mono->put('C');
		$mono->synch();
	}

}

sub check_actually_connected {
	my ($mono) = @_;

	if (!defined $mono) {
		print "<p>Your Mono credentials seem to have been destroyed.</p>";
		print "<p><a href=\"http://apps.facebook.com/monochrome/signout\">Go here to start afresh.</a></p>";
		exit(0);
	}
}

sub persistent {
	die "fb_sig_user is not numeric" unless $vars{fb_sig_user} =~ /^\d*$/;
	return "$datastore/$vars{fb_sig_user}";
}