#!/usr/bin/perl
use warnings;
use strict;
use autodie;
use Carp;
use File::Basename;
use Data::Dumper;
use YAML::Syck;
use WWW::Facebook::API;
use IO::Handle;
use Filter::Self;

$YAML::Syck::ImplicitUnicode = 1;
binmode STDOUT, ":utf8";
binmode STDERR, ":utf8";
${^OPEN} = ":utf8\0:utf8";

my @default_config_files = ("facebook-config", "$ENV{HOME}/.facebook-config");

# deps: cpan autodie YAML::Syck WWW::Facebook::API
# recommends: ntp

=head1 NAME

Facebook::Easy - access facebook data easily

=head1 SYNOPSIS

use Facebook::Easy

=head1 DESCRIPTION

Facebook::Easy helps you to access data from Facebook easily.

=head1 METHODS

=over 4

=item $fb = Facebook::Easy->new()

Create a new object to access facebook.

=cut

sub new($class, $config_file) {
	my $self = {};
	bless ($self, $class);
	.load_config($config_file);
	return $self;
}

meth load_config($config_file) {
	.config_file = $config_file
	  || grep { -e $_ } @default_config_files
	  or die "config file not found, tried: @default_config_files";
	.config = LoadFile($config_file);
	for my $k (keys %.config) {
		my $k1 = $k;
		if ($k1 =~ tr/A-Z /a-z_/) {
			.config{$k1} = delete .config{$k};
		}
	}
}

meth msg {
	print STDERR @_;
	my $log = .log;
	if ($log) { print $log @_; }
}

meth setup_config_file {
	# TODO instructions
	die "No config file was found\n  tried: @default_config_files";
}

__END__


my $fb = WWW::Facebook::API->new(
	desktop         => 1,
	api_key         => $C->{api_key},
	secret          => $C->{secret},
	session_key     => $C->{session_key},
	session_expires => $C->{session_expires},
	session_uid     => $C->{session_uid},
	throw_errors    => 1,
	debug           => 0,
);

my $config_file     = "config";

# FIXME put in config?
my $names_file      = "names";
my $people_dir      = "people";

my @user_fields     = qw(uid first_name last_name name pic_small pic_big pic_square pic affiliations profile_update_time timezone religion birthday birthday_date sex hometown_location meeting_sex meeting_for relationship_status significant_other_id political current_location activities interests is_app_user music tv movies books quotes about_me hs_info education_history work_history notes_count wall_count status has_added_app online_presence locale proxied_email profile_url email_hashes pic_small_with_logo pic_big_with_logo pic_square_with_logo pic_with_logo allowed_restrictions verified profile_blurb family username website is_blocked);

my @stream_fields   = qw(post_id viewer_id app_id source_id updated_time created_time filter_key attribution actor_id target_id message app_data action_links attachment comments likes privacy type permalink tagged_ids is_hidden);

my @comment_fields  = qw(xid object_id post_id fromid time text id username reply_xid);

my $user_fields     = join ', ', @user_fields;
my $stream_fields   = join ', ', @stream_fields;
my $comment_fields  = join ', ', @comment_fields;

my $config_modified = 0;

sub open_utf {
	my ($mode, $file) = @_;
	open(my $fh, $mode, $file);
	binmode $fh, ":utf8";
	return $fh;
}

sub load_file {
	my ($file) = @_;
	my $fh = open_utf('<', $file);
	return Load(join '', <$fh>);
}

sub dump_file {
	my ($mode, $file, @data) = @_;
	my $fh = open_utf($mode, $file);
	print $fh Dump(@data);
}

my $C = load_file($config_file);
for my $k (keys %$C) {
	my $k1 = $k;
	if ($k1 =~ tr/A-Z /a-z_/) {
		$C->{$k1} = delete $C->{$k}; 
	}
}

msg("slurp ", format_localtime(), "\n\n");

my $fb = WWW::Facebook::API->new(
	desktop         => 1,
	api_key         => $C->{api_key},
	secret          => $C->{secret},
	session_key     => $C->{session_key},
	session_expires => $C->{session_expires},
	session_uid     => $C->{session_uid},
	throw_errors    => 1,
	debug           => 0,
);

sub get_session_key {
	my $url = $fb->get_infinite_session_url;
	my $url_perms = "http://www.facebook.com/connect/prompt_permissions.php?api_key=$C->{api_key}&v=1.0&next=http://www.facebook.com/connect/login_success.html?xxRESULTTOKENxx&display=popup&ext_perm=read_stream,publish_stream&enable_profile_selector=0";  # &enable_profile_selector=1&profile_selector_ids=1234%2C5454";
	msg "Please authorize this slurp app, at:\n";
	msg "  $url\n";
	msg "  $url_perms\n";
	if ($C->{browser}) {
		msg "  (opening in $C->{browser})\n";
		system "\Q$C->{browser}\E \Q$url\E &";
		system "\Q$C->{browser}\E \Q$url_perms\E &";
	}
	msg "then enter your one-time code (or ^C): ";
	my $token = <STDIN>;
	chomp $token;
        $fb->auth->get_session($token);
	$fb->{session_key} or croak "failed: get_session_key";
	$C->{session_key}     = $fb->{session_key};
	$C->{session_expires} = $fb->{session_expires};
	$C->{session_uid}     = $fb->{session_uid};
	$config_modified = 1;
}

if (!$C->{session_key}) {
	get_session_key();
}

$C->{last_scan} //= 0;
my $time_top = time() - $C->{time_fuzz};

my $uid = $fb->users->get_logged_in_user;

my $names = {};
my $names_modified = 0;
my $updates;
my $posts;

my @uids;

my $people = {};
my $person_dirs = {};

my $user;
my $user_dir;

my $all_streams_merged = [];

if (-e $names_file) { $names = load_file($names_file); }
if (! -e $people_dir) { mkdir $people_dir; }

sub add_name {
	my ($uid, $name) = @_;
	if (!exists $names->{$uid} || $names->{$uid} ne $name) {
		$names->{$uid} = $name;
		$names_modified = 1;
	}
}

sub get_names {
	msg "fetching names:\n";
	my $name_rows = $fb->fql->query(query => qq{
		SELECT uid, name FROM user
		WHERE (uid = $uid
		    OR uid IN (SELECT uid2 FROM friend WHERE uid1 = $uid))
	});
	for my $p (@$name_rows) {
		my $u = $p->{uid};
		my $person_dir = "$p->{name} $u";
		$person_dir =~ s{[/\s\0]}{_}g;
		$person_dirs->{$u} = $person_dir;
		if ($u eq $uid) {
			$user_dir = $person_dir;
		}
		add_name($u, $p->{name});
	}
	@uids = map {$_->{uid}} @$name_rows;
	msg "\n";
}

get_names();

# sort_wall("wall++"); exit;
# sort_all_walls(); exit;

sub get_info {
	msg "fetching info:\n";
	$updates = $fb->fql->query(query => qq{
		SELECT $user_fields FROM user
		WHERE (uid = $uid
		    OR uid IN (SELECT uid2 FROM friend WHERE uid1 = $uid))
		  AND profile_update_time >= $C->{last_scan}
		  AND profile_update_time < $time_top
	});
	for my $p (@$updates) {
		$people->{$p->{uid}} = $p;
		my $person_dir = $person_dirs->{$p->{uid}};
		msg $person_dir;
		if (! -d "$people_dir/$person_dir") {
			my @old_dir = glob "$people_dir/*_$p->{uid}";
			if (@old_dir == 1) {
				rename $old_dir[0], "$people_dir/$person_dir";
				msg "  (was $old_dir[0])";
			} else {
				if (@old_dir > 1) {
					msg "  (error, multiple directories)";
				} else {
					msg "  (new)";
				}
				mkdir "$people_dir/$person_dir";
			}
		}
		msg "\n";
		dump_file('>', "$people_dir/$person_dir/info", $p);
	}
	msg "\n";
	msg "loading info:\n";
	if (@$updates) { $config_modified = 1; }
	$updates = {map {$_->{uid}, $_} @$updates};

	for my $u (@uids) {
		if (!$people->{$u}) {
			my $person_dir = $person_dirs->{$u};
			$people->{$u} = load_file("$people_dir/$person_dir/info");
		}
	}
	$user = $people->{$uid};
	$user or die "failed: get_info";
	msg "\n";
}

get_info();

sub format_localtime {
	my ($time) = @_;
	my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($time);
	$year += 1900; ++$mon;
	return sprintf("%04d/%02d/%02d %02d:%02d:%02d",$year,$mon,$mday,$hour,$min,$sec);
}

sub post_short {
	my ($post) = @_;
	my $time = format_localtime($post->{created_time});
	my $source = $names->{$post->{source_id}}||"";
	my $actor = $names->{$post->{actor_id}}||"";
	my $message = $post->{message};
	for ($message) { s/\n+$//; s/\n/  /g; }
	return "$time\t$source\t$actor\t$message\n";
}

sub get_extra_names {
	my ($extra_uids) = @_;
	my $extra = join ',', @$extra_uids;
	my $extra_names = $fb->fql->query(query => qq{
		SELECT uid, name FROM user
		WHERE uid IN ($extra)
	});
	for my $p (@$extra_names) {
		my $u = $p->{uid};
		add_name($u, $p->{name});
	}
	msg "\n";
}

sub dump_posts {
	my ($posts, $mode, $wall_file, $w_file, $echo) = @_;
	my $wall_fh = open_utf($mode, $wall_file);
	my $w_fh    = open_utf($mode, $w_file);
	for my $post (@$posts) {
		print $wall_fh Dump($post);
		my $line = post_short($post);
		print $w_fh $line;
		if ($echo) { msg $line; }
	}
}

sub get_stream {
	my ($source_id, $time_from, $time_to) = @_;
	my $source_id_v = $source_id ? $names->{$source_id} : '<all>';
	msg "fetching stream $source_id_v:\n";
	my $query;
	my $last_scan;
	my $file_suffix = "";
	if ($source_id) {
		# query for one wall
		$query = qq{
			SELECT $stream_fields FROM stream
			WHERE source_id = $source_id
		};
	} else {
		# general query for recent posts by friends
		$file_suffix = "+";
		$query = qq{
			SELECT $stream_fields FROM stream
			WHERE (source_id = $uid OR source_id IN (SELECT uid2 FROM friend WHERE uid1 = $uid))
		};
	}

	if ($time_from) {
		$query .= qq{
			  AND created_time >= $time_from
		};
	}
	if ($time_to) {
		$query .= qq{
			  AND created_time < $time_to
		};
	}

	$posts = $fb->fql->query(query => $query);

	if ($posts && @$posts) {
		# I think with the general query for recent posts, it does not filter by time properly, so do that here:
		if ($time_from) {
			@$posts = grep { $_->{created_time} >= $time_from } @$posts;
		}
		if ($time_to) {
			@$posts = grep { $_->{created_time} < $time_to } @$posts;
		}

		my %extra_uids;
		for my $post (@$posts) {
			if (!$names->{$post->{actor_id}}) {
				$extra_uids{$post->{actor_id}} = 1;
			}
		}
		my $extra_uids = [keys %extra_uids];
		if (@$extra_uids) {
			msg "  fetching extra names\n";
			get_extra_names($extra_uids);
		}

		my $person_dir = $person_dirs->{$source_id||$uid};
		$posts = sort_posts($posts);

		if ($merge) {
			push @$all_streams_merged, @$posts;
		}

		my ($wall_fh, $w_fh);
		if (!$merge_only) {
			dump_posts($posts, '>>', "$people_dir/$person_dir/wall$file_suffix", "$people_dir/$person_dir/w$file_suffix", 1);
		}
		$config_modified = 1;
	}
	msg "\n";
}

get_stream($uid);
get_stream(undef);

sub get_all_streams {
	for my $u (@uids) {
		my $time_target = time();
		if ($u ne $uid) {
			get_stream($u, 1);
			$time_target += $C->{stream_table_wait};
			my $time = time();
			my $delay = $time_target - $time;
			if ($delay <= 0) { $delay = 0; $time_target = $time; }
#			warn "wait $C->{stream_table_wait} time $time target $time_target sleeping for $delay\n";
			sleep($delay);
		}
	}
}

if ($C->{get_all_streams}) {
	get_all_streams();
}

if ($C->{get_all_streams} && $C->{merge_all_streams}) {
	$all_streams_merged = sort_posts($all_streams_merged);
	dump_posts($all_streams_merged, '>>', "wall++", "w++", 0);

	filter_relevant();
}

sub filter_relevant {
	my $mode = '>>';
	my $relevant = $all_streams_merged;

	if (! -e "read") {
		$mode = '>';
		$relevant = [load_file("read")];
	}
	
	$relevant = [grep {
		$_->{message} &&
		($_->{source_id} eq $uid || $_->{actor_id} eq $uid || $_->{source_id} eq $_->{actor_id})
	  } @$relevant];

	dump_posts($relevant, $mode, "read", "r", 0);
}

#msg "reading comments:\n"
#my $comments = $fb->fql->query(query => qq{
#	SELECT $comment_fields FROM comment
#	WHERE source_id = $uid
#	  AND time >= $C->{last_scan}
#	  AND time < $time_top
#});
#
#for my $comment (@$posts) {
#}

# TODO remove ex-friends?
# TODO slurp old posts from new friends / maintain a per-file timestamp
# TODO save new last_scan value (max of new profile_update_time values)
# TODO load other people's info from files
# TODO keep files in arcs/git and auto-commit for history / diff support
# TODO get image of each person

# TODO read comments

for (glob "$people_dir/$user_dir/*") {
	my $n = basename($_);
	-e $n or symlink $_, $n;
}

if ($names_modified) {
	dump_file('>', $names_file, $names);
}

if ($config_modified) {
	$C->{last_update} = $time_top;
	if ($C->{get_all_streams}) {
		$C->{last_update_all_streams} = $time_top;
	}
	dump_file('>', $config_file, $C);
}

msg("\n");


# utility:

sub sort_posts {
	my ($posts) = @_;
	return [sort { $a->{created_time} <=> $b->{created_time} } @$posts];
}

sub sort_wall {
	my ($file) = @_;
	msg "sorting: $file\n";
	my $posts = [load_file($file)];
	$posts = sort_posts($posts);
	dump_file('>', $file, @$posts);
	(my $w_file = $file) =~ s{wall(\+[+\d]*)$}{w$1};
	my $w_fh = open_utf('>', $w_file);
	for my $post (@$posts) {
		my $line = post_short($post);
		print $w_fh $line;
	}
}

sub sort_all_walls {
	msg "sorting all walls:\n";
	for my $u (@uids) {
		my $person_dir = $person_dirs->{$u};
		for my $file ("$people_dir/$person_dir/wall", "$people_dir/$person_dir/wall+") {
			if (-e $file) {
				sort_wall($file);
			}
		}
	}
	msg "\n";
}

exit;

=back

=head1 HISTORY

Written by Sam Watkins, 2010.

=cut

1
