#!/usr/bin/perl # WWW::Facebook::API scaffolding: # Copyright David Leadbeater 2007 . # Licensed under the same terms as Perl itself. # bcqdapp: # Copyright Alexander Oelzant 2007 # as far as admissible my code is under the GNU GPL v3 or later # http://www.gnu.org/licenses/gpl.html # A simple example of using WWW::Facebook::API within a facebook canvas. # You will need to change the api_key, secret and app_path below to match your # account. To get an api_key and secret, go to # http://www.facebook.com/developers/editapp.php?new, choose "Use FBML" and # enter a unique name for the canvas which you should put into app_path. # setup: # create db and enter values below (currently only mysql suppported) # insert bc cid # insert real url of script below use strict; use CGI; use JSON::DWIW; use WWW::Facebook::API; use Data::Dumper; use LWP; use Encode; use HTML::Entities; use DBI; use Digest::MD5 qw(md5_hex); use URI::Escape qw(uri_escape_utf8 uri_escape uri_unescape ); use POSIX qw(strftime); my ($appname,$appkey,$appsecret,$appid,$bookcrossinguserxml); my ($url,$logfile,$userfile,$appstyle); my ($mysql_db,$mysql_user,$mysql_pass); my $tmpdir="/home/aoe/tmp"; my $appua="facebook bcqdapp/0.1 lwp/perl aoe@30hd.org"; my $bookcrossingurl="http://www.bookcrossing.com/"; my (@fb_templates); if ($0 =~ /bc-dev/) { $appname="bcqdtest"; $appkey = 'aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa'; $appsecret = 'aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa'; # $appid=26167435608; $url="http://tigerente.htu.tuwien.ac.at/~aoe/cgi-bin/bc-dev.cgi/"; $logfile="$tmpdir/bc-test.log"; $userfile="$tmpdir/bc-testuser.log"; $appstyle="style=\"background-color: pink\""; $mysql_db="bcqdtest"; $mysql_user="bcqdtestu"; $mysql_pass="xxxxxxxx"; # $bookcrossinguserxml="http://alpha.bookcrossing.com/files/services/jp/basicServices.asp"; $bookcrossinguserxml="${bookcrossingurl}files/services/jp/basicServices.asp"; @fb_templates=(44934945608); } else { ######################################## # INSERT PARAMETERS HERE ######################################## $appname="bcqdapp"; $appkey = 'aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa'; $appsecret = 'aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa'; # $appid=10060119125; $url="http://tigerente.htu.tuwien.ac.at/~aoe/cgi-bin/bc.cgi/"; $logfile="$tmpdir/bc.log"; $userfile="$tmpdir/bcuser.log"; $appstyle=""; $mysql_db="bcqdapp"; $mysql_user="bcqdappu"; $mysql_pass="pass"; $bookcrossinguserxml="${bookcrossingurl}files/services/jp/basicServices.asp"; # CAVE: templates have to be initialized with the -t option, id transferred here manually @fb_templates=(28151494125); } my $editstyle="border:solid 2px grey; padding:10px; margin: 10px;"; my $itemstyle="color: grey; font-weight: bolder;"; my $newsfile="$tmpdir/bc_news.html"; my $helpfile="$tmpdir/bc_help.html"; my $facebook = WWW::Facebook::API->new( api_key => $appkey, secret => $appsecret, app_path => "$appname", # app_id => "$appid", parse => 1, ); our %action_map = ( '' => \&index_page, tab => \"e_page, info => \&info_page, info_callback => \&attach_page, # publish_callback => \&publish_callback_page, publish_page => \&publish_page, publish_self_page => \&publish_page, publish_friend_page => \&publish_page, clear => \&clear_page, clickquote2 => \"e_page, clickquote => \"e_page, quote => \"e_page, changebcname => \&changebcname_page, add => \&add_page, remove => \&remove_page, attach => \&attach_page, news => \&news_page, stats => \&stats_page, list => \&list_page, help => \&help_page, layout => \&layout_page, verify => \&verify_page, # not yet fully implemented: source => \&source_page, about => \&about_page, ); # convenient my $apphomeurl=$facebook->get_facebook_url("www")."/apps/application.php?api_key=".$facebook->api_key(); my $appurl=$facebook->get_app_url(); # various bc urls/data my $bookcrossingjoin="${bookcrossingurl}join"; my $bookcrossinglogo="${bookcrossingurl}images/RunningBook33.gif"; my $bookcrossingcid="xxxxxxxxxx"; # test bc api: # curl -d "action=memberstats&cid=xxxxxxxxxx&username=xxx&ip=1.2.3.4" http://www.bookcrossing.com/files/services/jp/basicServices.asp ############################################## # globals (should really go into objects/subs) ############################################## # my $verifylogo=" ✓"; # default layout my $defaultlayout="home member-since books-registered released-in-the-wild releases-caught books-found tell-a-friend-referrals new-member-referrals forum-posts bc-default-lists"; my %layoutoptions=( "home" => ["home", '$$values{homecity_web}, '. '$$values{homestate_web}, '. '$$values{homecountry_web}' ], "age" => ["age",'$$values{age}'], "member-since" => ["member since",'$$values{membersince}'], "homepage" => '$homepage', "books-registered" => ["books registered",'$$values{BookRegistrationCount} total, $$values{BookRegistrationCountLastWk} during last 4 weeks'], "released-in-the-wild" => ["released in the wild",'$$values{BookReleaseCount} total, $$values{BookReleaseCountLastWk} during last 4 weeks'], "releases-caught" => ["releases caught",'$$values{ReleasesCaught}'], "books-found" => ["books found",'$$values{BooksFound}'], "tell-a-friend-referrals" => ["tell-a-friend referrals",'$$values{TellAFriendReferralCount} total, $$values{TellAFriendReferralCountLastWk} during last 4 weeks'], "new-member-referrals" => ["new member referrals",'$$values{NewMemberReferralCount} total, $$values{NewMemberReferralCountLastWk} during last 4 weeks'], "forum-posts" => ['forum posts','$$values{ForumPostCount} total, $$values{ForumPostCountLastWeek} during last 4 weeks'], "bc-default-lists" => 'my books by status: All TBR AVL PC RSV TRV Wishlist ', "bc-friends" => 'bc friends: $bcfriends', "verified" => '$verifiedstring' ); # expand editor boxes - pointless but maybe cute my $edexp=' '; # replace box my $updatepreview=< EOF sub main { # Should also work with FastCGI (via CGI::Fast). my $q = new CGI; my $params = $facebook->canvas->validate_sig($q); if ( $params->{user} ) { # Canvas takes care of setting up a session for us, no need to call the # auth methods. $facebook->session_key( $params->{session_key} ); } # else { # # # User hasn't added app (could reject/display info/whatever) # # (Or handle later when a user is needed). # print "app not added?"; # } # cli use ... if (!$ENV{REMOTE_ADDR}) { # || $q->param("keywords")) { my $singleprofile=$ARGV[0]; #$facebook->auth->get_session($facebook->auth->create_token); # session_key( $params->{session_key} ); if ($singleprofile =~ /^-h/) { print "help: no option - update all, update single user -i - init db -c - clear db -tc - clear and set up templates -t - set up templates -p - check whether uid is page -d dump profile fbml\n"; exit(0); } if ($singleprofile =~ /^-c/) { clear_db($ARGV[1]); exit(0); } if ($singleprofile =~ /^-i/) { init_db($ARGV[1]); exit(0); } if ($singleprofile =~ /^-t/) { if ($singleprofile =~ /^-tc/) { for (@fb_templates) { print "deactivating $_\n"; $facebook->feed->deactivate_template_bundle_by_id( template_bundle_id => $_); } } print "Current template bundles:\n"; my @bundles=$facebook->feed->get_registered_template_bundles; if (!@bundles) { print "(none)\n"; my $json_oneliner = JSON::DWIW->to_json( ["{*actor*}, using the BookCrosssing.com application $appname, had the following to say about {*title*} by {*author*}: {*comment*}", "{*actor*} presents {*title*} from BookCrosssing.com using $appname", "{*actor*} comments about BookCrosssing.com using $appname: {*comment*}", "{*actor*} wants to remind you about BookCrosssing.com using $appname" ] ); my $json_short = JSON::DWIW->to_json([ { "template_title" => "{*actor*}, using the BookCrosssing.com application $appname, had the following to say about {*title*} by {*author*}:", "template_body" => "{*comment*}" # $q->span({-style=>"$itemstyle"},"Comment: ")." {*comment*}" } ] ); my $json_full = JSON::DWIW->to_json({ "template_title" => "{*actor*} presents {*title*} from BookCrosssing.com using $appname", "template_body" => "{*content*}" } ); my $feedid=$facebook->feed->register_template_bundle( one_line_story_templates => $json_oneliner, 'short_story_templates' => $json_short, 'full_story_template' =>$json_full ); print $feedid,"\n"; } else { print Dumper(@bundles),"\n"; # 'template_bundle_id' => '44583070608', ... #for my $id (@bundles) { # print Dumper($facebook->feed->get_registered_template_bundle_by_id( # template_bundle_id => $id # )); #} } exit(0); } if ($ARGV[0] =~ /^-p/) { #$facebook->auth->get_session($facebook->auth->get_session(rand)); # create_token); # session_key( $params->{session_key} ); my $params={profile => $ARGV[1]}; print "$ARGV[1] ",check_is_page($params),"\n"; exit(0); } #if (@ARGV+1) { # print get_editor($q->param,$params); # exit 0; #} #my $params={profile => 1478310081 }; #close STDOUT; if ($ARGV[1] =~ /^-d/) { my $type=2; if ($ARGV[1] =~ /(\d+)/) { $type=$1; } print STDERR $facebook->profile->get_fbml( uid => $singleprofile, type => $type ),"\n$singleprofile type $type\n"; exit 0; } my ($update,$id); my $dbh=connect_db(); my $userlist=$dbh->selectall_arrayref("SELECT uid,bcname from fb_user WHERE (installed!=0 OR installed IS NULL) AND bcname IS NOT NULL AND bcname != ''"); if ($dbh && ref $userlist eq "ARRAY" && @$userlist > 0) { my $start=time; my $ferrors=0; my $werrors=0; if ($singleprofile) { open OUT,">/dev/stdout"; } else { open OUT,">$tmpdir/bc.out"; } $|=1; print OUT "Start: ".strftime("%a %b %e %H:%M:%S %Y", localtime)."\n"; for my $user (@$userlist) { my ($id,$bcname)=@$user; if ($id && (!$singleprofile || $id eq $singleprofile)) { print OUT "$id: $bcname\n"; my $params={"profile" => $id, "user" => $id}; my $quote=get_xml_user(undef,$params); if ($quote !~ /^error/s) { my $new=mini_format(undef, $params, $quote); my $new_narrow=make_narrow("$quote"); $facebook->throw_errors(0); $facebook->profile->set_fbml( profile => $new, uid => $id, profile_main => $new_narrow); my $response = $facebook->call_success; if (!$response->[0]) { print OUT "error with user $id ($bcname): $response->[1]\n"; my_log("auto-update error with user $id ($bcname): $response->[1]"); $ferrors++; } if (!set_info($id)) { $ferrors++; } } else { $werrors++; } } } my $countu=@$userlist; print OUT "Finish: ".strftime("%a %b %e %H:%M:%S %Y", localtime)."\n"; print OUT "Total: ",(time-$start)," s ($countu users), ",(time-$start)/@$userlist," s/user\n"; my_log("auto-update stats: total ".(time-$start)." s ($countu), ".(time-$start)/@$userlist." s/user"); print OUT "Errors: $ferrors in facebook update, $werrors in bookcrossing download (",($ferrors+$werrors)/(time-$start),"/s)\n"; } exit(0); } if (!$facebook->canvas->in_fb_canvas($q) && !$q->path_info =~/source/) { print $q->header; redirect("Must be called in facebook canvas"); } my ( $action, $param ) = ( $q->path_info =~ m!^/(\w+)/?(.*)! ); if ( my $s = $action_map{$action} ) { my $user=$params->{user}; my $profile=$params->{profile}; my $page_id=$params->{page_id}; my $logatt="$action (user: $user, profile: $profile, page: $page_id)"; my $dbh=connect_db(); if ($dbh && $user) { $dbh->do("UPDATE fb_user SET last_active=NOW() where uid=$user"); } my_log( $logatt ); $s->( $param, $params ); } else { print $q->header; div_error("Action unknown"); } # Clear session_key (for if running under FastCGI). $facebook->session_key(undef); } sub list_page { my ($page_id, $listname, $hash, $lid, $bcid, $owner, $comment); my ( $param, $params ) = @_; my $pagestring=""; my $q = new CGI; my $dbh=connect_db(); print $q->header(); print $edexp; # get pages info if ($params->{is_admin}) { print "" } print $q->pre(Dumper($param)),$q->pre(Dumper($params)) if $appname =~ /test/; # TODO: show list by hash $listname=$q->param("listname"); $listname = encode_entities(decode("utf-8",$listname)); $page_id=get_pageid($params); if (check_is_page($params)) { $pagestring="?fb_page_id=$page_id"; } if ($page_id) { print get_menu("list management",$pagestring); } my ($bcnameweb,$bcnameuri,$verified,$bcnamexmluri)=get_bcname($page_id); $hash=$q->param("hash"); $bcid=$q->param("bcid"); if ($bcid =~ /(\d+)\/*$/) { $bcid=$1; } if ($param =~ /^[0-9a-f]{32}$/) { $hash=$param; } # create list if ($listname && !$hash) { my $lists=$dbh->selectall_arrayref("SELECT name,hash,lid,comment FROM list_base where uid=? and name=?",undef,$page_id,$listname); if (!${$$lists[0]}[0] && $q->param("create")) { $hash=md5_hex(rand(time.$$.$0.$page_id)); $comment=$q->param("commentlist"); my $public=$q->param("public"); if ($dbh->do("INSERT into list_base (name,hash,uid,comment,public) values (?,?,?,?,?)",undef,$listname,$hash,$page_id,$comment,$public)) { #if ($dbh->do("INSERT into list_base (name,hash,uid) values (?,?,?)",undef,$listname,$hash,$page_id)) { print $q->p("create of list $listname successful", $q->a({href=>"${appurl}list/$hash$pagestring"},"$listname")); } else { print $q->p("ERROR: create of list $listname unsuccessful"); } } else { $lid=${$$lists[0]}[2]; $hash=${$$lists[0]}[1]; $comment=${$$lists[0]}[3]; } } # check hash - delete if bogus if ($hash) { my $lists=$dbh->selectall_arrayref("SELECT name,lid,uid,comment FROM list_base where hash=?",undef,$hash); if ($lists && @$lists == 1) { $listname = ${$$lists[0]}[0]; $lid = ${$$lists[0]}[1]; $owner = ${$$lists[0]}[2]; $comment = ${$$lists[0]}[3]; } else { $hash=undef; } if ($q->param("create") && $q->param("commentlist") && ($owner == $page_id || $params->{is_admin})) { if ($dbh->do("UPDATE list_base set comment=? where lid=$lid",undef,$q->param("commentlist"))) { print $q->p("comment changed successfully"); $comment=$q->param("commentlist"); } } } # remove book(s) from list ... if ($hash && grep(/delete/,$q->param())) { # todo: check other bounds (co-editors ...) if ($owner == $page_id || $params->{is_admin}) { if ($q->param("delete_list")) { if ($dbh->do("DELETE FROM list_base where lid=$lid")) { print $q->p("list $listname removed successfully"); if (my $rows_deleted=$dbh->do("DELETE FROM list_entry where lid=$lid" >= 0)) { print $q->p("$rows_deleted books removed successfully"); } } else { print $q->p("list $listname could not be removed"); } } for my $book (grep /^delete\d+$/,$q->param()) { $book=~ /^delete(\d+)$/; my $bcid=$1; my $books=$dbh->selectall_arrayref("SELECT * from bc_book where bcid=?",undef,$bcid); if (@$books == 1) { my ($title, $authors, $journalers)=get_book($bcid); print "got book $title ($bcid) to delete" if $appname =~ /test/; #print $q->p($dbh->error) if $dbh->error; } my $entries=$dbh->selectall_arrayref("SELECT * FROM list_entry where lid=? and bcid=?",undef,$lid,$bcid); if (@$entries == 1) { if ($dbh->do("DELETE FROM list_entry where lid=$lid and bcid=$bcid")) { print $q->p("bcid $bcid removed from $lid successfully"); } else { print $q->p("bcid $bcid could not be removed "); } } } } else { print $q->p("permission denied for user $page_id to insert $bcid"); } } elsif ($hash && $q->param("public")) { if ($owner == $page_id || $params->{is_admin}) { my $public=($q->param("public")?1:0); if ($dbh->do("UPDATE list_base SET public=$public where lid=$lid",undef)) { print $q->p("list $listname set to public=".$q->param("public")); } else { print $q->p("list $listname could not be modified"); } } else { print $q->p("permission denied for user $page_id to insert $bcid"); } } # insert book into list ... if ($hash && $bcid) { # todo: check other bounds (co-editors ...) if ($owner == $page_id) { print $q->p("hash $hash, bcid $bcid, bcname $bcnameweb") if $appname =~ /test/; my $books=$dbh->selectall_arrayref("select * from bc_book where bcid=?",undef,$bcid); if (@$books == 0) { my ($author,$title,$journal); my ($title, $authors, $journalers)=get_book($bcid); print "got book" if $appname =~ /test/; $author = join(", ", map {"".encode_entities(decode("utf-8",$_)).""} @$authors); if (ref($journalers) eq "ARRAY" && @$journalers) { $journal = @$journalers." journalers (".encode_entities(decode("utf-8",@$journalers[0])).""; $journal .= "-".encode_entities(decode("utf-8",@$journalers[-1])).")"; } #print $q->p($dbh->error) if $dbh->error; } my $entries=$dbh->selectall_arrayref("SELECT * FROM list_entry where lid=? and bcid=?",undef,$lid,$bcid); if (@$entries == 0) { if ($dbh->do("INSERT into list_entry (lid,bcid,uid,comment) values (?,?,?,?)",undef,$lid,$bcid,$page_id,$q->param("commentbook"))) { print $q->p("bcid $bcid inserted successfully") if $appname =~ /test/; } } } else { print $q->p("permission denied for user $page_id to insert $bcid"); } } # list list if ($listname) { my ($ownername)=get_bcname($owner); if (defined $lid) { print " \"Read ", $q->h1("list ".$q->a({-href=>"${url}list/$hash"},$listname)." of user ".$q->a({-href=>"${bookcrossingurl}mybookshelf/$ownername"},$ownername)); my $commentform=output_form($comment); if ($listname && $hash && ($owner == $page_id || $params->{is_admin})) { print $q->start_div({-style=>"$editstyle"}), $q->start_form(-action=>"${appurl}list/$pagestring",-method=>"POST",-no_sticky=>1), $q->hidden(-name=>"hash",-value=>"$hash"), $q->hidden(-name=>"create", -value => 1), "optional comment:
", $q->textarea(-name=>"commentlist", -rows=>1, -columns=>20, -override=>1, -value=>$commentform, -id=>"commentlist", -onFocus=> "call_me('list');return false;", -onChange=> "call_me('list');return false;", -onKeyUp=> "call_me('list');return false;", -onClick=> "call_me('list');return false;", -onLoad => "call_me('list');return false;", -onBlur => "call_me('list');return false;" ), $q->submit("update comment"), $q->end_form, $q->end_div; } else { if ($comment) { print $q->div({-style=>$editstyle},$q->p(output_format($comment))); } } if ($owner == $page_id) { print $q->p("list $listname has url ". $q->a({href=>"${appurl}list/$hash"},"${appurl}list/$hash")); print $q->p("or ". $q->a({href=>"${url}list/$hash"},"${url}list/$hash")); } my $entries=$dbh->selectall_arrayref("SELECT bcid,comment FROM list_entry where lid=?",undef,$lid); if (ref($entries) eq "ARRAY" && @$entries) { print $q->start_div; if ($owner == $page_id) { print $q->start_form(-action=>"${appurl}list/$hash$pagestring",-method=>"POST",-no_sticky=>1), $q->hidden(-name=>"hash", -value=>"$hash"); } print $q->start_table; for my $entry (@$entries) { my ($bcid,$comment)=@$entry; my ($title,$authors,$journalers,$pic)=get_book($bcid); my $author = join(", ", map {"".encode_entities(decode("utf-8",$_)).""} @$authors); my @jentries=map {"".encode_entities(decode("utf-8",$_)).""} @$journalers; my $journal; if (@$journalers > 6) { $journal=@$journalers." entries ".join(", ",@jentries[0..2]).", ..., ".join(", ",@jentries[-3..-1]); } elsif (@$journalers > 1) { $journal=@$journalers." entries ".join(", ",@jentries); } else { $journal="1 entry by ".$jentries[0]; } print $q->Tr($q->td([$q->a({href=>"${bookcrossingurl}journal/$bcid"},$title)." by $author, $journal".output_format($comment),$q->a({href=>"${bookcrossingurl}journal/$bcid"},$q->img({-src=>$pic,-align=>"right"})), ($owner==$page_id?$q->checkbox(-name=>"delete$bcid", -label=>"del", -value=>1):"") ])); } print $q->end_table; if ($owner == $page_id || $params->{is_admin}) { print $q->submit("delete checked books"), "editing comments not yet implemented - for now remove and reinsert", $q->end_form; } print $q->end_div; } } } # list lists if ($page_id) { if ($hash) { my $lists=$dbh->selectall_arrayref("SELECT name,hash FROM list_base where uid=?",undef,$page_id); if ($lists && @$lists) { print $q->h1("Current Lists:"); } else { print $q->h1("currently no lists, add one below"); } my @listm; for my $list (@$lists) { my ($name,$hash)=@$list; push @listm,$q->a({href=>"${appurl}list/$hash$pagestring"},"$name"); } print $q->p(join(", ",@listm)); } else { my $public; my $lists=$dbh->selectall_arrayref("SELECT name,hash,count(bcid),public FROM list_base LEFT JOIN (list_entry) ON (list_base.lid=list_entry.lid) WHERE list_base.uid=? GROUP BY list_base.name",undef,$page_id); my @listm; for my $list (@$lists) { my ($name,$hash,$count,$public)=@$list; push @listm,$q->Tr( $q->td([ $q->a({href=>"${appurl}list/$hash$pagestring"},"$name"), "$count books", $q->span({-style=>"display: inline; float: left;"},$q->start_form(-action=>"${appurl}list/$hash$pagestring",-method=>"POST",-no_sticky=>1). $q->hidden(-name=>"hash", -value=>"$hash"). $q->hidden(-name=>"delete_list",-value=>1). $q->submit(-name=>"delete list"). $q->end_form), $q->span({-style=>"display: inline; float: left;"},$q->start_form(-action=>"${appurl}list/$hash$pagestring",-method=>"POST",-no_sticky=>1). $q->hidden(-name=>"hash", -value=>"$hash"). $q->checkbox(-name=>"public",-checked=>$public,-value=>1). $q->submit(-name=>"set"). $q->end_form ) ]) ); } if ($lists && @$lists) { print $q->h1("Your Current Lists:"),$q->table(@listm); } else { print $q->h1("currently no lists, add one below"); } } } print $q->p("Others' public lists: ", join(", ", map {$q->a({href=>"${appurl}list/$$_[1]"},"$$_[0]")} @{get_lists("foreign",$page_id)})); if ($page_id) { # list options: insert book into list if ($listname && $hash && ($owner == $page_id || $params->{is_admin})) { my $commentform=output_form($comment); print $q->start_div({-style=>"$editstyle"}), $q->start_form(-action=>"${appurl}list/$hash$pagestring",-method=>"POST",-no_sticky=>1, -name=>"form1", -id=>"form1"), "add BC book to $listname (full BCID, second part or journal URL):", $q->hidden(-name=>"hash", -value=>"$hash"), $q->textfield(-name=>"bcid",-override=>1)."
", $q->submit("add book"). " optional comment: ", $q->textarea(-name=>"commentbook", -rows=>1, -columns=>40, -override=>1, #-clickrewriteurl=>"$appurl", #-clickrewriteid=>"comment", -id=>"commentbook", -onFocus=> "call_me('book');return false;", -onChange=> "call_me('book');return false;", -onKeyUp=> "call_me('book');return false;", -onClick=> "call_me('book');return false;", -onLoad => "call_me('book');return false;", -onBlur => "call_me('book');return false;" ), $q->end_form, $q->end_div; } print $q->start_div({-style=>"$editstyle"}). $q->start_form(-action=>"${appurl}list/$pagestring",-method=>"POST",-no_sticky=>1). "add list:". $q->textfield(-name=>"listname"). $q->hidden(-name=>"create", -value => 1). $q->checkbox(-name=>"public",-checked=>0,-value=>1), "optional comment: ", $q->textarea(-name=>"commentlist", -rows=>1, -columns=>20, -override=>1, #-clickrewriteurl=>"$appurl", #-clickrewriteid=>"comment", -id=>"commentlist", -onFocus=> "call_me('list');return false;", -onChange=> "call_me('list');return false;", -onKeyUp=> "call_me('list');return false;", -onClick=> "call_me('list');return false;", -onLoad => "call_me('list');return false;", -onBlur => "call_me('list');return false;" ), $q->submit("create list"), $q->span({-style=>"float: right"}, $q->a({-href=>"${appurl}list/$pagestring"},"list overview")). $q->end_form. $q->end_div; } else { print $q->p($q->a({-href=>"${appurl}list/$hash$pagestring"},"administration,")," Not a ",$q->a({-href=>"${bookcrossingurl}"},"BookCrossing")," member yet? ",$q->a({-href=>"${bookcrossingurl}join"},"Sign Up Now!")); } print $q->end_html; } sub source_page { my ( $param, $params ) = @_; my $q = new CGI; print $q->header("text/plain"); return; #print "
",Dumper(\%ENV),"
"; open SOURCE,"<$ENV{SCRIPT_FILENAME}" || print "$ENV{SCRIPT_FILENAME}"; while (my $x=) { $x =~ s/\tsecret => '.*'/\tsecret => 'insert key here'/g; print $x; } } sub remove_page { my ( $param, $params ) = @_; my $q = new CGI; print $q->header; my $page_id=get_pageid($params); my $dbh=connect_db(); my $u=$dbh->selectall_arrayref("SELECT uid from fb_user WHERE uid=?",undef,$page_id); if (ref($u) eq "ARRAY" && @$u == 1) { if (!$dbh->do("UPDATE fb_user SET installed=0,last_update=NOW() WHERE uid=?",undef,$page_id)) { my_log("($page_id): updateerroradd"); } } else { if (!$dbh->do("INSERT INTO fb_user (uid,installed,last_update,first_install) VALUES (?,0,NOW(),NOW())",undef,$page_id)) { my_log("($page_id): inserterroradd"); } } print $q->start_html,$q->h1("removed"),$q->end_html; } sub publish_page { my ( $param, $params ) = @_; my ($title,$author,$pic,$journalers,$page_id,$owner); my $titleurl=""; my $attachment=""; my $attachlist=""; my $comment=""; my $content = ""; my $q = new CGI; $page_id=get_pageid($params); my $method=$q->param("method"); if ($method =~ /publisher_getInterface/) { my ($noneselected, $listsel, $commentform)=("","",""); $noneselected=($attachlist eq ""?"selected":""); my $listsel=join("",map {""} @{get_lists("all",$page_id)}); my $edit=<WARNING: EXPERIMENTAL Enter book journal url, BCID or book number here:
Append a list instead:
Comment:
Preview:
EOF $content="$edit"; print $q->header('application/json'); my ($json_str, $error_msg) = JSON::DWIW->to_json({ content=>{ fbml => $edit # publishEnabled=>1, # commentEnabled=>1 }, method=>$method} ); print $json_str; } else { for ($q->param) { print STDERR "$_ = ",$q->param($_),"\n"; } if ($q->param("list")) { # if ($q->param("list") =~ m#([a-f0-9]+)/*$#) { $attachlist=$q->param("list"); # } } elsif ($q->param("bcid")) { if ($q->param("bcid") =~ m#(\d+)/*$#) { $attachment=$1; } } elsif ($q->param("app_params[list]")) { $attachlist=$q->param("app_params[list]"); } elsif ($q->param("app_params[bcid]")) { if ($q->param("app_params[bcid]") =~ m#(\d+)/*$#) { $attachment=$1; } } if ($q->param("comment")) { #$comment=encode_entities(decode("utf-8",$q->param("comment"))); $comment=$q->param("comment"); $comment =~ s/\\(.)/$1/msg; } elsif ($q->param("app_params[comment]")) { $comment=$q->param("app_params[comment]"); $comment =~ s/\\(.)/$1/msg; } if ($attachment) { my ($authors); ($title, $authors, $journalers,$pic)=get_book($attachment); $titleurl="${bookcrossingurl}journal/$attachment"; if (!$comment) { my $dbh=connect_db(); my $u=$dbh->selectall_arrayref("SELECT list_entry.comment from list_entry LEFT JOIN list_base ON (list_base.lid=list_entry.lid) WHERE list_base.uid=? AND list_entry.bcid=?",undef,$page_id,$attachment); if (ref($u) eq "ARRAY" && @$u >= 1) { $comment=${$$u[0]}[0]; } } my @jform; my $jlast=""; $author = join(", ", map {"".encode_entities(decode("utf-8",$_)).""} @$authors); # format entries and determine unique count for my $j (@$journalers) { push @jform,"$j" unless $j eq $jlast; $jlast=$j; # ugly } $content = " \"$title\" ". "

$title

by $author

"; if (@$journalers) { # output list $content .= "

" . 0+@jform." Journalers: "; if (@jform > 6) { $content .= join(", ",@jform[0..2]),", ..., ". join(", ",@jform[-3..-1]); } else { $content .= join(", ",@jform); } $content .= "

"; } } elsif ($attachlist) { my ($public,$lcomment,$count); ($owner, $title, $public,$lcomment,$count)=get_list($attachlist); if (!$comment) { $comment=$lcomment; } my $listurl="${appurl}list/$attachlist"; $titleurl=$listurl; my $publicurl="${url}list/$attachlist"; $content .= "

See $owner's ". ($public?"public":"private")." list $title with $count entries (at the time of writing) also accessible here

"; } else { $content = "

nothing attached yet

"; } my $commentformat=output_format($comment); my $commentform=output_form($comment); $content .= "

Comment: $commentformat

" if $comment; my $page_id=get_pageid($params); my_log("($page_id): publish $attachment ($title by $author) $comment"); $content="
$content
"; # output result - JSON or HTML ... if ($method) { # {"content": # {"feed": # {"template_id":55555555, # "template_data": # {"word":"supercalifragilisticexpialidocious"} # } # }, # "method":"publisher_getFeedStory" # } # {actor} presents {title} to {target}/{comment} print $q->header('application/json'); my ($json_str, $error_msg) = JSON::DWIW->to_json({ content=>{ feed => { template_id => $fb_templates[0], template_data => { title => "$title", author => ($author?$author:$owner), comment => $comment, content => $content, images => [ { src=>"$pic", href=>"${bookcrossingurl}journal/$attachment" } ] }, }, publishEnabled=>1, commentEnabled=>1}, method=>$method} ); print $json_str; my_log ("publishing $title by $author ($titleurl)"); } else { # preview print $q->header(),$content; } } } sub attach_page { my ( $param, $params ) = @_; my ($title,$author,$pic,$journalers,$page_id); my $attachment=""; my $attachlist=""; my $comment=""; my $content = ""; my $q = new CGI; print $q->header; #print $q->pre(Dumper($params)); #print $q->pre($param); #print $q->pre($q->param); if ($q->param("list")) { # if ($q->param("list") =~ m#([a-f0-9]+)/*$#) { $attachlist=$q->param("list"); # } } elsif ($q->param("bcid")) { if ($q->param("bcid") =~ m#(\d+)/*$#) { $attachment=$1; } } $page_id=get_pageid($params); if ($q->param("comment")) { #$comment=encode_entities(decode("utf-8",$q->param("comment"))); $comment=$q->param("comment"); $comment =~ s/\\(.)/$1/msg; } if ($attachment) { my ($authors); ($title, $authors, $journalers,$pic)=get_book($attachment); if (!$comment) { my $dbh=connect_db(); my $u=$dbh->selectall_arrayref("SELECT list_entry.comment from list_entry LEFT JOIN list_base ON (list_base.lid=list_entry.lid) WHERE list_base.uid=? AND list_entry.bcid=?",undef,$page_id,$attachment); if (ref($u) eq "ARRAY" && @$u >= 1) { $comment=${$$u[0]}[0]; } } my @jform; my $jlast=""; $author = join(", ", map {"".encode_entities(decode("utf-8",$_)).""} @$authors); # format entries and determine unique count for my $j (@$journalers) { push @jform,"$j" unless $j eq $jlast; $jlast=$j; # ugly } $content = " \"$title\" ". "

$title

by $author

"; if (@$journalers) { # output list $content .= "

" . 0+@jform." Journalers: "; if (@jform > 6) { $content .= join(", ",@jform[0..2]),", ..., ". join(", ",@jform[-3..-1]); } else { $content .= join(", ",@jform); } $content .= "

"; } } elsif ($attachlist) { my ($owner, $title, $public,$lcomment,$count)=get_list($attachlist); if (!$comment) { $comment=$lcomment; } my $listurl="${appurl}list/$attachlist"; my $publicurl="${url}list/$attachlist"; $content .= "

See $owner's ". ($public?"public":"private")." list $title with $count entries (at the time of writing) also accessible here

"; } else { $content = "

nothing attached yet

"; } my $commentformat=output_format($comment); my $commentform=output_form($comment); $content .= "

Comment: $commentformat

" if $comment; if ($q->param("message_sent") < 1) { my $noneselected=($attachlist eq ""?"selected":""); my $listsel=join("",map {""} @{get_lists("all",$page_id)}); print << "EOF" $edexp

WARNING: EXPERIMENTAL

Append a list instead:
Click here to preview attachment

Preview:
EOF } else { # log final attach } print "
"; print "$content
"; if ($q->param("message_sent") >= 1) { my $page_id=get_pageid($params); my_log("($page_id): attach $attachment ($title by $author) $comment"); } } sub add_page { my ( $param, $params ) = @_; my ($page_id,$bcname); my $pagestring=""; my $q = new CGI; my $page_id=get_pageid($params); print $q->header; # get pages info if ($params->{is_admin}) { print "" } if (check_is_page($params)) { $pagestring="?fb_page_id=$page_id"; } print get_menu("$appname home",$pagestring); my $dbh=connect_db(); my $u=$dbh->selectall_arrayref("SELECT uid from fb_user WHERE uid=?",undef,$page_id); if (ref($u) eq "ARRAY" && @$u == 1) { if (!$dbh->do("UPDATE fb_user SET installed=1,last_update=NOW() WHERE uid=?",undef,$page_id)) { my_log("($page_id): updateerroradd"); } } else { if (!$dbh->do("INSERT INTO fb_user (uid,installed,last_update,first_install) VALUES (?,1,NOW(),NOW())",undef,$page_id)) { my_log("($page_id): inserterroradd"); } } # mark pages in db - different links, ... check_is_page($params); print $q->pre(Dumper($param)),$q->pre(Dumper($params)) if $appname =~ /test/; print "Welcome to the BookCrossing Application!", "
", "". "

Not a BookCrossing member? ". "". "Sign up Now!". "". "

". "

If you have not yet set your BookCrossing user name, please do so below. You can also elect to have a link to your profile shown to everyone browsing this page, if you wish to do so, please select the "public" option.

\n". "

If you have no idea what BookCrossing is all about, just imagine the world as a single huge library - see BookCrossing.com for details on inventory and checking out ;-). If you are not a member yet, you can join without further obligations at BookCrossing.com/join

"; print format_index_page($param,$params), "
"; } sub stats_page { my ( $param, $params ) = @_; my ($page_id,$bcname); my $pagestring=""; my $q = new CGI; print $q->header; # get pages info if ($params->{is_admin}) { print "" } #print $q->pre(Dumper($param)),$q->pre(Dumper($params)) if $appname =~ /test/; #print $q->pre(Dumper(%ENV)) if $appname =~ /test/; my $page_id=get_pageid($params); if (check_is_page($params)) { $pagestring="?fb_page_id=$page_id"; } print get_menu("stats",$pagestring), "BookCrossing Application Stats", ; print format_stats_page($param,$params, 0); } sub format_stats_page { my ( $param, $params,$num) = @_; my ($page_id); my $limit=""; my $content=""; my $pagestring=""; $page_id=get_pageid($params); my ($bcnameweb,$bcnameuri,$verified,$bcnamexmluri)=get_bcname($page_id); if (check_is_page($params)) { $pagestring="?fb_page_id=$page_id"; } my $q = new CGI; my $dbh=connect_db(); my ($total, $installed, $removed)=get_stats(); $content= "
"; $content .= $q->p("Current installations with a bcname set: $installed (total number of installations: $total, removals: $removed)"); # clean: get data from db # by install date my $users=$dbh->selectall_arrayref("select uid,bcname,UNIX_TIMESTAMP(first_install),UNIX_TIMESTAMP(last_update) from fb_user where (installed!=0 OR installed IS NULL) and bcname IS NOT NULL and public=1 and bcname != '' ORDER BY first_install DESC LIMIT 10"); if (ref($users) eq "ARRAY" && @$users > 0) { $content .= "
". $q->start_table. $q->Tr($q->th({-colspan=>2},"Most Recent Public Installations")); for my $user (@$users) { my ($bcnameweb,$bcnameuri,$verified)=get_bcname($$user[0]); my ($public,$fpublic)=get_public($$user[0]); my $entry=$q->a({-href=>"${bookcrossingurl}mybookshelf/$bcnameuri"},$bcnameweb); if ($verified) { $entry .= $verifylogo; if ($fpublic) { my ($first,$last)=get_fullname($$user[0]); if (check_is_page($params)) { $entry .= "
(". $q->a({-href=>$facebook->get_facebook_url("www")."/pages/$last/$$user[0]"},$$user[0]). ")"; } else { $entry .= "
(". $q->a({-href=>$facebook->get_facebook_url("www")."/profile.php?id=$$user[0]"},"$first $last"). ")"; } } } my $tz="GMT"; if ($page_id) { my $tzfql=$facebook->fql->query( query => "SELECT timezone FROM user WHERE uid=$page_id"); if ($tzfql->[0]->{timezone}) { $tz=$tzfql->[0]->{timezone}; } } $content .= $q->Tr($q->td([$entry,""])); my ($bcnameweb,$bcnameuri,$verified)=get_bcname($$user[0]); } $content .= $q->end_table. "
"; # by activity $users=$dbh->selectall_arrayref("select uid,bcname,TIMEDIFF(NOW(),last_active) from fb_user where (installed!=0 OR installed IS NULL) and bcname IS NOT NULL and public=1 and bcname != '' ORDER BY last_active DESC LIMIT 10"); if (ref($users) eq "ARRAY" && @$users > 0) { $content .= "
". $q->start_table. $q->Tr($q->th({-colspan=>2},"Recently Active")); for my $user (@$users) { my ($bcnameweb,$bcnameuri,$verified)=get_bcname($$user[0]); my ($public,$fpublic)=get_public($$user[0]); my $entry=$q->a({-href=>"${bookcrossingurl}mybookshelf/$bcnameuri"},$bcnameweb); if ($verified) { $entry .= $verifylogo; if ($fpublic) { my ($first,$last)=get_fullname($$user[0]); if (check_is_page($params)) { $entry .= "
(". $q->a({-href=>$facebook->get_facebook_url("www")."/pages/$last/$$user[0]"},$$user[0]). ")"; } else { $entry .= "
(". $q->a({-href=>$facebook->get_facebook_url("www")."/profile.php?id=$$user[0]"},"$first $last"). ")"; } } } $content .= $q->Tr($q->td([$entry,"$$user[2]"])); }; $content .= $q->end_table. "
"; } my @friends=split(",",$params->{friends}); $dbh->do("DELETE FROM friends WHERE uid=?",undef,$params->{user}); my @bookfriends; if (@friends) { for my $friend (@friends) { my $is_friends=$dbh->selectall_arrayref("SELECT uid FROM fb_user WHERE (installed!=0 OR installed IS NULL) AND uid=$friend"); if (ref($is_friends) eq "ARRAY" && @$is_friends > 0) { $dbh->do("INSERT INTO friends (uid,friend) VALUES (?,?)",undef,$params->{user},$friend); my ($fbcnameweb,$fbcnameuri,$verified)=get_bcname($friend); my ($firstname,$lastname)=get_fullname($friend); push @bookfriends, "$firstname $lastname ($fbcnameweb".($verified?$verifylogo:"").")"; } } } if (@bookfriends) { $content .= $q->p("BC friends: ",join(", ",@bookfriends)); } } if ($page_id) { $content .= $q->p("Your lists: ", join(", ", map {$q->a({href=>"${appurl}list/$$_[1]"},"$$_[0]").($$_[3]?" (public)":"")} @{get_lists("own",$page_id)})); } $content .= $q->p("Others' public lists: ", join(", ", map {$q->a({href=>"${appurl}list/$$_[1]"},"$$_[0]")} @{get_lists("foreign",$page_id)})); # alpha list if (!$num) { my $users=$dbh->selectall_arrayref("select bcname,uid,UNIX_TIMESTAMP(NOW())-UNIX_TIMESTAMP(last_update),fullname_public from fb_user where (installed!=0 OR installed IS NULL) and bcname IS NOT NULL and bcname != '' and public=1"); if (ref($users) eq "ARRAY") { $content .= $q->h3("Current Public Users Listed Alphabetically"); # $q->p(join(", ", map {$q->a({-href=>"${bookcrossingurl}mybookshelf/".uri_escape($$_[0]),-style=>($$_[1] < 86400?"color: red;":($$_[1] < 86400*7?"color:brown;":""))},encode_entities(decode("utf-8",$$_[0])))} sort {uca($$a[0]) cmp uca($$b[0])} map {$_} @$users)). for my $user (sort {uca($$a[0]) cmp uca($$b[0])} @$users) { my ($bcname,$uid,$timeago,$fpublic)=@$user; my ($fbcnameweb,$fbcnameuri,$verified)=get_bcname($uid); $content .= $q->a({-href=>"${bookcrossingurl}mybookshelf/$fbcnameuri",-style=>($timeago < 86400?"color: red;":($timeago < 86400*7?"color:brown;":""))},$fbcnameweb); if ($verified) { $content .= $verifylogo; if ($fpublic) { my_log("fpublic"); my ($first,$last)=get_fullname($uid); if (check_is_page($params,$uid)) { $content .= " (". $q->a({-href=>$facebook->get_facebook_url("www")."/pages/$last/$uid"},$last). ")"; } else { $content .= " (". $q->a({-href=>$facebook->get_facebook_url("www")."/profile.php?id=$uid"},"$first $last"). ")"; } } } $content .= ", "; }; # remove last ", " $content =~ s/, $//s; $content .= $q->p("Changed within past ", $q->span({-style=>"color: red;"},"24 hours"),"/", $q->span({-style=>"color: brown;"},"7 days")); } $content .= $q->h2("Results of last auto update run:").$q->p([grep /^Start:|^Finish:|^Total:|^Errors:/, (split /\n/, cat("$tmpdir/bc.out"))]); } $content .= $q-> end_div; return $content; } sub verify_page { my ( $param, $params ) = @_; my ($page_id); my $pagestring=""; my $layout=$defaultlayout; my $q = new CGI; print $q->header; # get pages info if ($params->{is_admin}) { print "" } $page_id=get_pageid($params); my ($bcnameweb,$bcnameuri,$verified,$bcnamexmluri)=get_bcname($page_id); if (check_is_page($params)) { $pagestring="?fb_page_id=$page_id"; } #print $q->pre(Dumper($param)),$q->pre(Dumper($params)) if $appname =~ /test/; #print $q->pre(Dumper(%ENV)) if $appname =~ /test/; print get_menu("verify",$pagestring), "Bookcrossing Name Verification", ; print $q->p("This page provides a unique cookie and instructions to verify your bookcrossing account with this application. Currently this is not particularly useful except to prove your bookcrossing identity to visitors and users, however there might be more options in the future, e. g. showing your Facebook name besides the BookCrossing one, sharing list administration etc."); # verify user if ($q->param("cookie")) { my $ip=$q->remote_host(); if ($ip =~ /localhost/) { $ip="128.131.95.40"; } my $values=parse_xml(wget(${bookcrossinguserxml},"action=memberstats&cid=$bookcrossingcid&username=$bcnamexmluri&ip=$ip")); if (!$values) { print $q->("Error retrieving profile from bookcrossing.com"); } else { $$values{"homepage"} =~ m#^${appurl}verify/([a-f0-9]{32})$#; my $userhpcookie=$1; print $q->p("verifying ($bcnameweb,$page_id,$userhpcookie) ..."); my $result=verify_bcname(uri_unescape($bcnameuri),$page_id,$userhpcookie); print $q->p($result); if ($result == 1) { print $q->p("Don't forget to reset your homepage value :)"); } } } if ($verified) { print $q->h1("You are verified as $bcnameweb!"); print $q->p("No further action is required. Cookies below are for your nourishment only."); } # show auth blurb if page owner if (($page_id == $params->{user} || $params->{is_admin})) { my $cookie=md5_hex("$bcnameuri $page_id" . rand() . time . cat($0)); my $dbh=connect_db(); $dbh->do("DELETE FROM cookies WHERE uid=?",undef,$page_id); my $u=$dbh->do("INSERT INTO cookies (bcname,uid,cookie) VALUES (?,?,?)",undef,uri_unescape($bcnameuri),$page_id,$cookie); if ($u) { print $q->p(["Your current cookie for BC user $bcnameweb is $cookie.", "Usage: set your BookCrossing homepage field temporarily to the following string", "${appurl}verify/$cookie", "and click here: " ]), $q->start_form(-action=>"${appurl}verify",-method=>"POST",-no_sticky=>1), $q->hidden(-name=>"cookie",-value=>"$cookie"), $q->submit(-name=>"verify BC profile"), $q->end_form; # print $q->p(["Your current cookie for BC user $bcnameweb is $cookie.", # "Usage: send a message via BookCrossing to me (aoe). Enter verify for the subject line and http://${appurl}verify $cookie in the mail body.", # "CAVE: since this mail is processed automatically, it is not a good idea to include personal messages or abuse, you should use a different subject line for that.", # "Turnaround time _should_ be below 1 minute. However, reloading this page will generate a new cookie - go to layout to check up on the progress."] # ); # print $q->div({-style=>$editstyle}, # $q->table( # $q->Tr($q->td({-width=>"120m",-style=>"color: red"},"Click here, ->
enter subject and paste cookie line - voilá!"), # $q->td($q->p("To: aoe"). # $q->pre("Subject: verify # #${appurl}verify $cookie #"))))); } else { print $q->p("Some error occurred generating your cookie, please reload to try again."); } } } sub layout_page { my ( $param, $params ) = @_; my ($page_id); my $pagestring=""; my $layout=$defaultlayout; my $q = new CGI; print $q->header; # get pages info if ($params->{is_admin}) { print "" } $page_id=get_pageid($params); my ($bcnameweb,$bcnameuri,$verified,$bcnamexmluri)=get_bcname($page_id); if (check_is_page($params)) { $pagestring="?fb_page_id=$page_id"; } #print $q->pre(Dumper($param)),$q->pre(Dumper($params)) if $appname =~ /test/; #print $q->pre(Dumper(%ENV)) if $appname =~ /test/; print get_menu("layout",$pagestring), "BookCrossing Application Layout", ; my @setlayout; for my $name (grep /^layout-/,$q->param) { my $value=$q->param($name); if ($value > 0 && $value < 100) { $name =~ s/^layout-//; @setlayout[$value]=$name; } } if (($page_id == $params->{user} || $params->{is_admin}) && @setlayout) { my $newlayout=join(" ",grep(/./,@setlayout)); my $dbh=connect_db(); my $u=$dbh->selectall_arrayref("SELECT layout from fb_layout WHERE uid=?",undef,$page_id); if (ref($u) eq "ARRAY" && @$u >= 1) { $u=$dbh->do("UPDATE fb_layout set layout=? WHERE uid=?",undef,$newlayout,$page_id); } else { $u=$dbh->do("INSERT INTO fb_layout (layout,uid) VALUES (?,?)",undef,$newlayout,$page_id); } my $quote=get_xml_user($param,$params); my $new=mini_format($param, $params, $quote); my $new_narrow=make_narrow("$quote"); my $printnew=$new; $printnew=~ s/fb:visible-to-added-app-users/fb:if-user-has-added-app/msg; print $q->div({-style=>"$editstyle; width:380px"},$printnew); if ($quote !~ /^error/s) { $facebook->profile->set_fbml( profile => $new, uid => $page_id, profile_main => $new_narrow); if (!set_info($page_id)) { my ($bcnameweb,$bcnameuri,$verified,$bcnamexmluri)=get_bcname($page_id); print OUT "info error with user $page_id ($bcnameweb)\n"; my_log("auto-update error with user $page_id ($bcnameweb)"); } } } print get_xml_user( $param, $params, 1); } sub get_xml_user { my ( $param, $params, $edit ) = @_; my $page_id=get_pageid($params); my ($bcnameweb,$bcnameuri,$verified,$bcnamexmluri)=get_bcname($page_id); my $pagestring; if (check_is_page($params)) { $pagestring="?fb_page_id=$page_id"; } my $q = new CGI; my $dbh=connect_db(); my $layout=$defaultlayout; my $content=""; my $userurl="${bookcrossingurl}mybookshelf/$bcnameuri/"; my $usertitle; my $u=$dbh->selectall_arrayref("SELECT layout from fb_layout WHERE uid=?",undef,$page_id); if (ref($u) eq "ARRAY" && @$u >= 1) { $layout = ${$$u[0]}[0]; } my $index=1; my $ip=$q->remote_host(); if ($ip =~ /localhost/) { $ip="128.131.95.40"; } my $userxml=wget(${bookcrossinguserxml},"action=memberstats&cid=$bookcrossingcid&username=$bcnamexmluri&ip=$ip"); if ($userxml) { my $values=parse_xml($userxml); if ($$values{wingsimg}) { $usertitle="the "; $usertitle.="$bcnameweb "; $usertitle.="bookshelf "; } else { $usertitle="the "; $usertitle.="$bcnameweb "; $usertitle.="bookshelf "; } my $homepage=""; if ($$values{homepage}) { if (length($$values{homepage}) < 45) { $homepage=$q->td(["home page","$$values{homepage}"]); } else { $homepage=$q->td({-colspan=>2},"$$values{homepage}"); } } my $bcfriends=""; my $friends=$dbh->selectall_arrayref("SELECT friend FROM friends LEFT JOIN fb_user ON (friend=fb_user.uid) WHERE (installed!=0 OR installed IS NULL) AND public=1 and friends.uid=?",undef,$page_id); if (ref($friends) eq "ARRAY" && @$friends >= 1) { my @bookfriends; for my $friend (map {$$_[0]} @$friends) { if ($dbh->do("SELECT uid FROM fb_user WHERE (installed!=0 OR installed IS NULL) AND uid=$friend") > 0) { my ($fbcname)=get_bcname($friend); my ($firstname,$lastname)=get_fullname($friend); push @bookfriends, "$firstname $lastname ($fbcname)"; } } $bcfriends=join (", ",@bookfriends); } my $verifiedstring=($verified ? "verified as $bcnameweb ✓" : "click here to verify now"); if ($edit) { $content .= $q->start_form(-action=>"${appurl}layout/$pagestring",-method=>"POST",-no_sticky=>1); }; $content .= $q->start_table.$q->col({-width=>"130px"}); my %copy=map {$_,$_} keys %layoutoptions; for my $entry (split(" ","$layout")) { $index++; $copy{$entry}=undef; if (ref($layoutoptions{$entry}) eq "ARRAY") { $content .= $q->Tr( ($edit?$q->td($q->textfield(-name=>"layout-$entry",-value=>$index++)):""), $q->td([@{$layoutoptions{"$entry"}}]) ); } else { $content .= $q->Tr( ($edit?$q->td($q->textfield(-name=>"layout-$entry",-value=>$index++)):""), $layoutoptions{"$entry"}); } } if ($edit) { $content .= $q->Tr($q->th({-colspan=>3},"Currently not included (set number to greater than zero to insert):")); for my $entry (grep /./, values(%copy)) { if (ref($layoutoptions{$entry}) eq "ARRAY") { $content .= $q->Tr( $q->td($q->textfield(-name=>"layout-$entry",-value=>0)), $q->td([@{$layoutoptions{"$entry"}}]) ); } else { $content .= $q->Tr( $q->td($q->textfield(-name=>"layout-$entry",-value=>0)), $layoutoptions{"$entry"}); } } } $content .= $q->end_table; if ($edit) { $content .= $q->submit; $content .= $q->end_form; $content .= $q->h2("Usage"). $q->p("Lines with positive integers between 0 and 100 (exclusive) determine the order of the profile content. 0 means do not display, odd numbers have been left out to make inserting easier (absolute values are meaningless)."). $q->p("If you seem to have less friends than expected, this might be a flaw in the application or in your social network. However, only friends who have the app installed and agreed to have their info made public will be shown."); } $content =~ s#(?div({-style=>"padding: 10px 10px 10px 10px"}, " \"Read ". $q->h1($usertitle) ). $q->div({-style=>"padding:10px"}, $content); } else { return "error: timeout fetching user xml: $userxml (not changed, reload for previous content)"; } } sub help_page { my ( $param, $params ) = @_; my $pagestring=""; my $q = new CGI; print $q->header; # get pages info if ($params->{is_admin}) { print "" } my $page_id=get_pageid($params); my ($bcnameweb,$bcnameuri,$verified,$bcnamexmluri)=get_bcname($page_id); if (check_is_page($params)) { $pagestring="?fb_page_id=$page_id"; } #print $q->pre(Dumper($param)),$q->pre(Dumper($params)) if $appname =~ /test/; #print $q->pre(Dumper(%ENV)) if $appname =~ /test/; print get_menu("help",$pagestring), "BookCrossing Application Help", ; print "
", cat($helpfile), "
" ; } sub news_page { my ( $param, $params ) = @_; my $pagestring=""; my $q = new CGI; print $q->header; # get pages info if ($params->{is_admin}) { print "" } my $page_id=get_pageid($params); my ($bcnameweb,$bcnameuri,$verified,$bcnamexmluri)=get_bcname($page_id); if (check_is_page($params)) { $pagestring="?fb_page_id=$page_id"; } #print $q->pre(Dumper($param)),$q->pre(Dumper($params)) if $appname =~ /test/; #print $q->pre(Dumper(%ENV)) if $appname =~ /test/; print get_menu("news",$pagestring), ""; print "
", format_news_page(0), "
"; } sub index_page { my ( $param, $params ) = @_; my $pagestring=""; my $q = new CGI; print $q->header; # get pages info if ($params->{is_admin}) { print "" } my $page_id=get_pageid($params); my ($bcnameweb,$bcnameuri,$verified,$bcnamexmluri)=get_bcname($page_id); if (check_is_page($params)) { $pagestring="?fb_page_id=$page_id"; } print $q->pre(Dumper($param)),$q->pre(Dumper($params)) if $appname =~ /test/; print $q->pre(Dumper(%ENV)) if $appname =~ /test/; print get_menu("$appname home",$pagestring), "", "
", format_index_page($param, $params), "
"; } sub info_page { my ( $param, $params ) = @_; my $q = new CGI; print $q->header; print "
";
    print Dumper($params);
    print "
"; } sub quote_page { my ( $param, $params ) = @_; my $q = new CGI; print $q->header; my $page_id=get_pageid($params); my ($bcnameweb,$bcnameuri,$verified,$bcnamexmluri)=get_bcname($page_id); if ($bcnameuri) { my $quote=get_xml_user($param,$params); my $new=mini_format($param, $params, $quote); my $new_narrow=make_narrow("$quote"); my $printnew; if ($q->path_info =~ /clickquote2/) { $printnew=$new_narrow; } else { $printnew=$new; } if ($params->{in_canvas_page}) { $printnew=~ s/fb:visible-to-added-app-users/fb:if-user-has-added-app/msg; } print $printnew; #close STDOUT; if ($quote !~ /^error/s) { $facebook->profile->set_fbml( profile => $new, uid => $page_id, profile_main => $new_narrow); #my $info_fields=(field => 'test', # items => ((label => 'testlabel', # description => 'test description')) # ); if (!set_info($page_id)) { my ($bcnameweb,$bcnameuri,$verified,$bcnamexmluri)=get_bcname($page_id); print OUT "error with user $page_id ($bcnameweb)\n"; my_log("auto-update error with user $page_id ($bcnameweb)"); } } } elsif ($page_id == $params->{user} || $params->{is_admin}) { #print mini_format($param,$params, $q->pre(Dumper($params))); print mini_format($param,$params, '' ); } else { print mini_format($param,$params,"
No data yet - ask page owner to enter their BookCrossing user name
"); } return $bcnameuri; } sub changebcname_page { my ( $param, $params ) = @_; my ($bcname,$public,$fpublic,$quote,$command,$verified); my $pagestring=""; my $content=""; my $q = new CGI; print $q->header; my $page_id=get_pageid($params); # get pages info unless ($page_id == $params->{user} || $params->{is_admin}) { print $q->h1("Permission denied"),$q->p("ask page owner to set their BC name"); return; } if ($params->{is_admin}) { $content.="" } $content.=$q->pre(Dumper($q->param())),$q->pre(Dumper($params)) if $appname =~ /test/; $command="bcname"; if($ENV{QUERY_STRING} =~ /\bpublic=([^&]*)/ || $q->param("public")) { $public=1; $command="public$command"; } if ($q->param("bcname")) { #$bcname=encode("utf-8",decode_entities($q->param("bcname"))); $bcname=$q->param("bcname"); } elsif($ENV{QUERY_STRING} =~ /\bbcname=([^&]+)/) { $bcname=$1; } else { ($bcname)=get_bcname($page_id); } my $dbh=connect_db(); my $u=$dbh->selectall_arrayref("SELECT bcname,authenticated from fb_user WHERE uid=?",undef,$page_id); if (ref($u) eq "ARRAY" && @$u == 1) { if ($bcname eq ${$$u[0]}[0]) { $verified=${$$u[0]}[1]; } else { my_log(">$bcname< ne >${$$u[0]}[0]<"); $verified=0; } if($q->param("fpublic")) { if ($public && $verified) { $fpublic=1; $command="full$command"; } else { $command="fullerror$command"; } } if (!$dbh->do("UPDATE fb_user SET bcname=?,public=?,fullname_public=?,authenticated=?,last_update=NOW() WHERE uid=?",undef,$bcname,$public,$fpublic,$verified,$page_id)) { my_log("($page_id): updateerror$command $bcname "); } else { my_log("($page_id): $command $bcname ${$$u[0]}[0]"); } } else { if (!$dbh->do("INSERT INTO fb_user (uid,bcname,public,last_update,first_install) VALUES (?,?,?,NOW(),NOW())",undef,$page_id,$bcname,($command=~/public/?1:0))) { my_log("($page_id): inserterror$command $bcname "); } else { my_log("($page_id): $command $bcname"); } } open LOG,">>$userfile"; print LOG "($page_id): $command $bcname\n"; close LOG; $content.="

$page_id $bcname

\n" if $appname =~ /test/; my $quote=get_xml_user(undef,$params); my $new=mini_format($param, $params, $quote); if ($quote !~ /^error/s) { my $new_narrow=make_narrow("$quote"); # $facebook->profile->set_fbml( markup => $new, uid => $page_id ); $facebook->profile->set_fbml( profile => $new, uid => $page_id, profile_main => $new_narrow); if (!set_info($page_id)) { my ($bcnameweb,$bcnameuri,$verified,$bcnamexmluri)=get_bcname($page_id); print OUT "error with user $page_id ($bcnameweb)\n"; my_log("info auto-update error with user $page_id ($bcnameweb)"); } } $page_id=get_pageid($params); if (check_is_page($params)) { $pagestring="?fb_page_id=$page_id"; } if ($page_id) { $content .= get_menu("$appname home",$pagestring); } my $printnew=$new; $printnew=~ s/fb:visible-to-added-app-users/fb:if-user-has-added-app/msg; $content .= $q->div({-style=>"$editstyle; width:380px"},$printnew); $content .= "
". format_index_page($param,$params). "
"; if ($q->param("profileform")) { print $new; } else { print $content; } } sub clear_page { my ( $param, $params ) = @_; my ($page_id); my $q = new CGI; print $q->header; my $new=mini_format($param, $params); print $new; close STDOUT; $page_id=get_pageid($params); # $facebook->profile->set_fbml( markup => $new, uid => $page_id ); $facebook->profile->set_fbml( profile => $new, uid => $page_id, profile_main => $new); } sub format_index_page { my ( $param, $params ) = @_; my ($pagestring); my $content=""; my @pages; my $added=$params->{added}; my $q = new CGI; my $page_id=get_pageid($params); if (check_is_page($params)) { $pagestring.="?fb_page_id=$page_id"; } if ($params->{added} || ($params->{is_admin} && $params->{page_added})) { my ($bcnameweb,$bcnameuri,$verified,$bcnamexmluri)=get_bcname($page_id); if (check_is_page($params)) { $pagestring="?fb_page_id=$page_id"; } my ($public,$fpublic)=get_public($page_id); $content .= " \"Read ". $q->h2("Settings"). $q->start_p. $q->start_div({-style=>"$editstyle"}). $q->start_form(-action=>"${appurl}changebcname/$pagestring",-method=>"POST",-no_sticky=>1). "Set/Update BookCrossing user name: ". $q->textfield(-name=>"bcname",-override=>1, -value=>decode("utf-8",uri_unescape($bcnamexmluri))). $q->p( $q->checkbox(-name=>'public', -checked=>$public, -value=>1, -label=>'public link to BookCrossing profile? '), "Show your BookCrossing user name to others (even non-Facebook users) for networking purposes (your real/Facebook name will remain hidden)" ); if ($verified) { $content .= $q->p( $q->checkbox(-name=>'fpublic', -checked=>$fpublic, -value=>1, -label=>'public link to Facebook profile?'), "Show your full name/Facebook link to others (even non-Facebook users) for networking purposes" ); } $content .= $q->end_p. $q->submit. $q->end_form. $q->end_div. " \"Read ". $q->p. $q->h2("Miscellaneous Functions"). "
  • Manually update the stats (should normally happen automagically every two hours, occasionally a few profiles will be blocked during one run, but I've never seen that happen during two consecutive updates, in fact the condition usually seems to vanish after a few minutes)
    • ". "
  • Clear the box (mainly useful for testing - user name remains cached, box will be regenerated on next update run)
    • ". "
  • Info (for debugging)
    • ". "
  • Application's homepage to install, uninstall, comment or block it.
    • ". "
  • To configure this application for use on one of your pages, please use the edit button in the title bar of this app on your page for administration.
    • ". "
" ; } else { $content .= "". "

Not a BookCrossing member? ". "". "Sign up Now!". "". "

". "It seems you haven't". " added this application yet; if you would like to do so now, "; $content .= " please click here.

". "

To configure this application for use on one of your pages, please use the edit button in the title bar of this application's box on your page (should also work via the setup link now).

". "

If you have no idea what BookCrossing is all about, just imagine the world as a single huge library - see Bookcrossing.com for details on inventory and checking out ;-). If you are not a member yet, you can join without any obligations whatsoever at Bookcrossing.com/join.

". " \"Read ". $q->h2("Synopsis ",$q->a({-href=>"help$pagestring"},"(more)")). $q->p("This application shows your BookCrossing info in the facebook profile or on other pages and provides links to the BookCrossing site in general and your bookshelf in particular. It is intended to raise awareness for the movement and proudly display your achievements."); } $content .= " \"Read ". $q->h2("Statistics and Links ".$q->a({-href=>"stats$pagestring"},"(more)")); $content .= format_stats_page($param,$params,"first_install",10); $content .= " \"Read ". $q->h1("About BookCrossing: see ". "". "$bookcrossingurl". " or follow Ballycumber, the ever running book!"). $q->p("
"). $q->h2("News ",$q->a({-href=>"news"},"(more)")). " \"Read " ; $content .= format_news_page(3); return $content; } sub format_news_page { my ($count)=@_; my $content = cat($newsfile); if ($count) { my $remove=@{[$content =~ /
.*?<\/dd>/msg]}-$count; $content =~ s/(
.*?<\/dd>[^<]*){$remove}//msg; } return $content; } sub get_public { my ($page_id)=@_; my $num; my $dbh=connect_db(); if ($dbh && $page_id > 0) { $num=$dbh->selectall_arrayref("select public,fullname_public from fb_user where uid=$page_id"); if (ref($num) eq "ARRAY" && @$num == 1) { return @{$$num[0]}; } } } sub get_stats { my ($total, $installed, $removed); my $num; my $dbh=connect_db(); $num=$dbh->selectall_arrayref("select count(*) from fb_user where (installed!=0 OR installed IS NULL) and bcname IS NOT NULL and bcname != ''"); if (ref($num) eq "ARRAY" && @$num == 1) { $installed=${$$num[0]}[0]; } $num=$dbh->selectall_arrayref("select count(*) from fb_user"); if (ref $num eq "ARRAY" && @$num == 1) { $total=${$$num[0]}[0]; } $num=$dbh->selectall_arrayref("select count(*) from fb_user where installed=0"); if (ref $num eq "ARRAY" && @$num == 1) { $removed=${$$num[0]}[0]; } return $total, $installed, $removed; } sub get_list { my ($owner, $title, $public,$comment,$count); my ($hash)=@_; my $base_query="SELECT bcname,name,list_base.public,list_base.comment,count(bcid) FROM list_base LEFT JOIN (fb_user) ON (list_base.uid=fb_user.uid) LEFT JOIN (list_entry) ON (list_base.lid=list_entry.lid) "; my $dbh=connect_db(); my $lists=$dbh->selectall_arrayref("$base_query WHERE list_base.hash = ? GROUP BY list_base.name",undef,$hash); if (ref $lists eq "ARRAY") { return @{$$lists[0]}; } else { return; } } sub get_lists { my ($type,$page_id)=@_; # list public lists my $lists; my $q=new CGI; my $dbh=connect_db(); my $base_query="SELECT name,hash,count(bcid),public,list_base.uid FROM list_base LEFT JOIN (list_entry) ON (list_base.lid=list_entry.lid)"; if ($type =~ /private/i && $page_id) { $lists=$dbh->selectall_arrayref("$base_query WHERE list_base.uid = ? AND public!=1 GROUP BY list_base.name",undef,$page_id); } elsif ($type =~ /foreign/i && $page_id) { $lists=$dbh->selectall_arrayref("$base_query WHERE list_base.uid != ? AND public=1 GROUP BY list_base.name",undef,$page_id); } elsif ($type =~ /own/i && $page_id) { $lists=$dbh->selectall_arrayref("$base_query WHERE list_base.uid = ? GROUP BY list_base.name",undef,$page_id); } elsif ($type =~ /all/i && $page_id) { $lists=$dbh->selectall_arrayref("$base_query WHERE list_base.uid = ? OR public=1 GROUP BY list_base.name",undef,$page_id); } else { # public $lists=$dbh->selectall_arrayref("$base_query WHERE public=1 GROUP BY list_base.name"); } return $lists; } sub redirect { my ($msg)=@_; div_error("Error: $msg
Please go to facebook (".strftime("%a %b %e %H:%M:%S %Y", localtime).")"); exit; } sub div_error { print "
", join( "", @_ ), "
"; } sub cat { my ($file,$in); ($file)=@_; return -1 unless defined $file; return -1 unless -f $file; my $oldifs=$/; undef $/; open I, $file; $in=; close I; $/=$oldifs; return $in; } sub wget { my ($ua,$request,$response); my ($fetchurl,$post,$timeout)=@_; $timeout=10 unless $timeout; if ($post) { $request = HTTP::Request->new(POST => "$fetchurl"); $request->content_type('application/x-www-form-urlencoded'); $request->content($post); } else { $request = HTTP::Request->new(GET => "$fetchurl"); } my $q=new CGI; if ($facebook->canvas->get_user($q)) { my $auchop=$appurl; chop $auchop; $request->referer($auchop.CGI::path_info()); } else { $request->referer(CGI::self_url()); } $ua = LWP::UserAgent->new; $ua->agent($appua); $ua->timeout(10); $response = $ua->request($request); # process ... if ($response->is_success) { return $response->content; } else { my_log("error $fetchurl".($post?"?$post":"").": ".$response->status_line); return undef; } } sub parse_xml { my ($s)=@_; my %v; while ($s =~ m#<(.*?)>#g) { if ($1 eq $3 && !$v{$1}) { my ($name,$value)=($1,$2); $v{$1}=$2; } } for my $key ("ForumPostCount", "ForumPostCountLastWeek", "NewMemberReferralCount", "TellAFriendReferralCountLastWk", "TellAFriendReferralCountLastWk", "TellAFriendReferralCount", "BooksFound", "ReleasesCaught", "BookReleaseCount", "BookReleaseCountLastWk", "BookRegistrationCountLastWk", "BookRegistrationCount") { $v{$key} = 0 unless $v{$key}; } for my $splitname ("homecity","homestate","homecountry") { # normal: #$v{$splitname."_uri"}=uri_escape_utf8(decode("UTF-8",$v{$splitname})); # "bookcrossing encoding": # $v{$splitname."_uri"}=uri_escape(encode("utf-8",$v{$splitname})); # javascript encoding: $v{$splitname."_uri"}=decode("UTF-8",$v{$splitname}); $v{$splitname."_uri"} =~ s/([\x80-\x{FFFF}])/sprintf('%%u%04x',ord($1))/eg; $v{$splitname."_uri"} =~ s/%/\$/g; $v{$splitname."_web"}=encode_entities(decode("utf-8",$v{$splitname})); } return \%v; } # global - ugly my $getbooktime; sub get_book { my ($title,@authorlist,@journalers,$pic,$books); $getbooktime=time unless $getbooktime; my ($bcid)=@_; if ($bcid !~ /^\d+$/) { return; } my $dbh=connect_db(); if ($dbh) { $books=$dbh->selectall_arrayref("SELECT title,author,journal,UNIX_TIMESTAMP(NOW())-UNIX_TIMESTAMP(last_update),pic FROM bc_book where bcid=?",undef,$bcid); my @authors=split(",",${$$books[0]}[1]); if (ref($books) =~ /ARRAY/ && @$books && (${$$books[0]}[3] < 3600 || ((time-$getbooktime) > 5)) && ${$$books[0]}[0]) { my @journalers; # interpret shortened journal list # 13 no1,no2,no3,no11,no12,no13 my $journal=${$$books[0]}[2]; $journal =~ /^(\d+) (.*)/; my ($jcount,$jlist)=($1,$2); if ($jcount > 3) { @journalers[0..2,$jcount-3..$jcount-1]=split(",",$jlist); } else { @journalers[0..$jcount-1]=split(",",$jlist); } # split author list return (${$$books[0]}[0],\@authors,\@journalers,${$$books[0]}[4]); } ($title, $pic)=(${$$books[0]}[0],${$$books[0]}[4]); @authorlist=@authors; } my $url="${bookcrossingurl}journal/$bcid"; my $content=wget($url,undef,1); # DEBUG: # my $content=cat("/home/aoe/tmp/v.html"); if ($content) { if ($content =~ /]*Click to view large image[^>]*>]*src=['"]([^'"]*)['"]/s) { $pic=$1; $pic =~ s#^/#$bookcrossingurl#msg; } if ($content =~ m#by ((?:[^<]*]*>[^<]*)+)#s) { @authorlist=(); my $authors="$1"; for my $author ($authors=~ m#]*>([^<]*)#sg) { push @authorlist,$author; } } @journalers=($content =~ m#Journal entry \d+ by.*?([^<]*)#msg); if ($content =~ m#

]*booktitle[^>]*>(.*)

#s) { $title=encode_entities(decode("utf-8",$1)); } # failsafe reconnect - could be useful $dbh=connect_db(); if ($dbh) { my $journal; if (@journalers > 6) { $journal=@journalers." ".join(", ",@journalers[0..2],@journalers[-3..-1]); } else { $journal=@journalers." ".join(", ",@journalers); } # in db, but empty or not current (see if condition above) if (ref($books) =~ /ARRAY/ && @$books) { $dbh->do("UPDATE bc_book SET last_update=NOW(),title=?,author=?,journal=?,pic=? WHERE bcid=?",undef,$title,join(", ",@authorlist),$journal,$pic,$bcid); } else { $dbh->do("INSERT INTO bc_book (bcid,last_update,title,author,journal,pic) values (?,NOW(),?,?,?,?)",undef,$bcid,$title,join(", ",@authorlist),$journal,$pic); } } } return ($title, \@authorlist, \@journalers,$pic); } sub get_user { my ($user)=@_; my ($userurl,$fetchurl,$content,$result); # if ($appname =~ /test/) { # my $p=get_xml_user($user); # if ($p && $p !~ /^0$/ms && $p !~ /error: /ms) { # return $p; # } # } $fetchurl="${bookcrossingurl}mybookshelf/$user/"; #$userurl="http://$user.bookcrossing.com/"; # CAVE: almost anything is allowed in names $userurl=$fetchurl; $content = wget($fetchurl); # process ... if ($content) { if ($content =~ m#(

the .*?$user.*?bookshelf

).*?).*?Stats are updated every few hours#msi) { #$result='

the Members Plus details...chichMembers Plus details... bookshelf

'; my ($title,$content)=($1,$2); $title =~ s###g; $title =~ s#$user#$user#g; $title .= " \"Read "; $result = "$title$content"; $result =~ s#(]+href=")/#$1$bookcrossingurl#msg; $result =~ s#(]+src=")/#$1$bookcrossingurl#msg; } else { $result = "

the $user bookshelf

\"Read

you seem to have either empty stats or no bookcrossing account at all

"; } } else { $result="error: timeout fetching $fetchurl $result (not changed, reload for previous content)"; } #print STDERR $result; return $result; } sub get_pageid { my ($params)=@_; my $page_id; if ($params->{profile_user}) { # in tab, and might be someone else's $page_id=$params->{profile_user}; } elsif ($params->{'profile'}) { $page_id=$params->{'profile'}; } elsif ($params->{'page_id'}) { $page_id=$params->{'page_id'}; } else { $page_id=$params->{'user'}; } return $page_id; } sub get_bcname { my ($page_id)=@_; my $dbh=connect_db(); if ($page_id) { if ($dbh) { my $userlist=$dbh->selectall_arrayref("SELECT bcname,authenticated FROM fb_user where uid=?",undef,$page_id); if (ref($userlist) eq "ARRAY" && @$userlist > 0) { my ($bcname,$verified)=@{$$userlist[0]}; # normal (and for xml!) # return (encode_entities(decode("utf-8",$bcname)),uri_escape($bcname),$verified); return (encode_entities(decode("utf-8",$bcname)),uri_escape(encode("utf-8",$bcname)),$verified,uri_escape($bcname)); } } } } sub uca { my ($s)=@_; $s =~ s/[^a-zA-Z0-9]//g; return uc($s); } sub my_log { my ($logatt)=@_; open LOG,">>$logfile"; print LOG time." $logatt\n"; close LOG; } sub check_is_page { my ($params,$page_id) = @_; my $dbh=connect_db(); if (!$page_id) { $page_id=get_pageid($params); } if (!$page_id) { return 0; } my $cached_is_page=$dbh->selectall_arrayref("SELECT is_page FROM fb_user WHERE uid=$page_id"); if (ref($cached_is_page) eq "ARRAY" && @$cached_is_page == 1 && defined ${$$cached_is_page[0]}[0]) { return ${$$cached_is_page[0]}[0]; } my $is_page=0; if ($params->{is_admin} && $params->{page_id}) { $is_page=1; } if ($params->{session_key}) { my $res=$facebook->fql->query( query => "SELECT name FROM page WHERE page_id=$page_id"); if ($res->[0]->{name}) { $is_page=1; } } $dbh->do("UPDATE fb_user SET is_page=$is_page WHERE uid=$page_id"); return $is_page; } sub get_fullname { my ($uid)=@_; my ($first, $last); my $dbh=connect_db(); my $name=$dbh->selectall_arrayref("SELECT firstname,lastname FROM person LEFT JOIN (fb_user) ON (person.pid = fb_user.pid) where uid=$uid"); if (ref($name) eq "ARRAY" && @$name == 1 && ${$$name[0]}[1]) { ($first, $last) = @{$$name[0]}; } else { my $res; if ($res = $facebook->fql->query( query => "SELECT first_name, last_name FROM user WHERE uid=$uid" )) { $dbh->do("INSERT INTO person (firstname, lastname) VALUES (?,?)",undef,$res->[0]->{first_name}, $res->[0]->{last_name}); ($first,$last)=($res->[0]->{first_name}, $res->[0]->{last_name}); } elsif ($res=$facebook->fql->query( query => "SELECT name FROM page WHERE page_id=$uid")) { my $bcname=$dbh->selectall_arrayref("SELECT bcname FROM fb_user WHERE uid=$uid"); if (ref($bcname) eq "ARRAY" && @$bcname == 1 && ${$$bcname[0]}[0] =~ /./) { $dbh->do("INSERT INTO person (lastname) VALUES (?)",undef,$res->[0]->{name}); } ($first, $last) = undef,$res->[0]->{name}; } my $pid=$dbh->{mysql_insertid}; if ($pid) { $dbh->do("UPDATE fb_user SET pid=$pid WHERE uid=$uid"); } } return encode_entities(decode("utf-8",$first)), encode_entities(decode("utf-8",$last)); } sub mini_format { my ( $param, $params, $content ) = @_; my ($attribution, $logatt, $atturl); my $user=$params->{user}; check_is_page($params); if ($params->{user} && defined($params->{added})) { my $user=$params->{user}; my ($f,$l)=get_fullname($user); $attribution="$f $l"; $atturl="http://www.facebook.com/profile.php?id=$user"; $logatt="$f $l ($user)"; } else { $attribution="a dull perl script"; $atturl=$apphomeurl; $logatt="unknown"; } if ($params->{profile} && $params->{session_key}) { my $profile=$params->{profile}; my $res = $facebook->fql->query( query => "SELECT first_name, last_name FROM user WHERE uid=$profile" ); $logatt.=" for $res->[0]->{first_name} $res->[0]->{last_name} ($profile)"; } if ($logatt !~ /^unknown$/) { my_log($logatt); } # render user's lists if available my $page_id=&get_pageid($params); my ($bcnameweb,$bcnameuri,$verified,$bcnamexmluri)=get_bcname($page_id); my $dbh=connect_db(); my @listm; my $listhtml=""; my $lists=$dbh->selectall_arrayref("SELECT name,hash FROM list_base where uid=? AND public=1",undef,$page_id); my $q=new CGI; if ($lists && @$lists) { for my $list (@$lists) { my ($name,$hash)=@$list; push @listm,$q->a({href=>"${appurl}list/$hash"},"$name"); } if ($lists && @$lists) { $listhtml = $q->p("${bcnameweb}'s lists: ". join(", ",@listm)); } } my $tz="GMT"; # if ($page_id) { # $facebook->throw_errors(0); # my $tzfql=$facebook->fql->query( query => "SELECT timezone FROM user WHERE uid=$page_id"); # my $response = $facebook->call_success; # if ($response->[0]) { # $tz=$tzfql->[0]->{timezone}; # } # } my $date=time; return "
$content$listhtml".get_editor($param,$params)." updated $tz
"; } sub get_editor() { my ($param,$params)=@_; my $pagestring=""; my $editor; my $page_id=&get_pageid($params); my ($bcnameweb,$bcnameuri,$verified,$bcnamexmluri)=get_bcname($page_id); my $bookcrossingtaf="${bookcrossingurl}friend/$bcnameuri"; if (!$bcnameweb) { $bookcrossingtaf=$bookcrossingjoin; } if (check_is_page($params)) { $pagestring.="?fb_page_id=$page_id"; } my $install='install'; my $setup='setup"; my $tz="GMT"; # if ($page_id) { # $facebook->throw_errors(0); # my $tzfql=$facebook->fql->query( query => "SELECT timezone FROM user WHERE uid=$page_id"); # my $response = $facebook->call_success; # if ($response->[0]) { # $tz=$tzfql->[0]->{timezone}; # } # } $editor=''; $editor .= <
update EOF if ($appname =~ /test/) { $editor .= '|new' } $editor .= '
'; $editor .= ''. "|$setup|about this app". "
"; $editor .= # ''. " Pentecost 2009 BC Meetup in Vienna
". ' BookCrossing - '. # "not a member yet? ". "". "sign up now!". "". "". # ''. ''; return $editor; } sub get_menu { my ($item,$pagestring)=@_; my $q=new CGI; my $addwarning; if ($pagestring =~ /=(\d+)/) { my $page_id=$1; my $pagename=[get_fullname($page_id)]->[1]; my $pageurl=$facebook->get_facebook_url("www")."/pages/$pagename/$page_id"; $addwarning=$q->h1({-style=>"padding: 20px 20px 0 20px;"},"Page: $pagename,
click here to edit your own profile settings").$q->hr; } my $menu=$q->div({-style=>"padding: 20px;"}, " \"Read ", ( map {$q->a({-href=>"$$_[0]"}, $q->span({-style=>"background-color: ".($item eq $$_[1]?"lightblue":"lightgrey")."; font-size: larger; padding: 10px; border: 5px;"}, "$$_[1]") )} (["$appurl$pagestring","$appname home"],["${appurl}list/$pagestring","list management"],["${appurl}news/$pagestring","news"],["${appurl}help/$pagestring","help"],["${appurl}stats/$pagestring","stats"],["${appurl}layout/$pagestring","layout"],["${appurl}verify/$pagestring","verify"])), $addwarning, '


'. '

' ); return $menu; } sub connect_db { my $dsn = "DBI:mysql:database=$mysql_db"; my $dbh = DBI->connect_cached($dsn, $mysql_user, $mysql_pass); # my $drh = DBI->install_driver("mysql"); return $dbh; } sub clear_db { my $dbh=connect_db(); if (! $dbh) { print "don't forget to create the db and authorize the user: # mysqladmin create $mysql_db mysql> grant all on $mysql_db.* to '$mysql_user'@'localhost' identified by \"$mysql_pass\"; "; die "db connection failed"; } # drop old $dbh->do("DROP TABLE list_perm"); $dbh->do("DROP TABLE list_entry"); $dbh->do("DROP TABLE list_base"); $dbh->do("DROP TABLE bc_book"); $dbh->do("DROP TABLE bc_user"); $dbh->do("DROP TABLE fb_user"); $dbh->do("DROP TABLE person"); } # no line breaks ... sub output_form { my ($string)=@_; my $string = (encode_entities(decode("utf-8",$string))); return $string; } # encode with line breaks sub output_format { my ($string)=@_; my $string = (encode_entities(decode("utf-8",$string))); if ($string) { $string="
$string"; } $string =~ s#$#
#mg; return $string; } sub init_db { my ($dblog)=@_; my $basets=1203249177-100; my $dbh=connect_db(); if (! $dbh) { print "don't forget to create the db and authorize the user: # mysqladmin create $mysql_db mysql> grant all on $mysql_db.* to '$mysql_user'@'localhost' identified by \"$mysql_pass\"; "; die "db connection failed"; } # drop old # $dbh->do("DROP TABLE list_perm"); # $dbh->do("DROP TABLE list_entry"); # $dbh->do("DROP TABLE list_base"); # $dbh->do("DROP TABLE bc_book"); # $dbh->do("DROP TABLE bc_user"); # $dbh->do("DROP TABLE fb_user"); # $dbh->do("DROP TABLE person"); # create new $dbh->do("CREATE TABLE person (pid INT NOT NULL AUTO_INCREMENT, firstname VARCHAR(40), lastname VARCHAR(40), PRIMARY KEY (pid))"); $dbh->do("CREATE TABLE fb_user (uid BIGINT NOT NULL, PRIMARY KEY (uid), pid INTEGER, FOREIGN KEY (pid) REFERENCES person ON DELETE RESTRICT, bcname VARCHAR(40), public BOOL, fullname_public, authenticated BOOL, installed BOOL, is_page BOOL, first_install TIMESTAMP DEFAULT 0, last_update TIMESTAMP DEFAULT 0, last_active TIMESTAMP DEFAULT CURRENT_TIMESTAMP ON UPDATE CURRENT_TIMESTAMP)"); $dbh->do("CREATE TABLE bc_user (bcname VARCHAR(40) NOT NULL, PRIMARY KEY (bcname))"); # not yet used $dbh->do("CREATE TABLE bc_book (bcid INT NOT NULL, PRIMARY KEY (bcid), last_update TIMESTAMP, registrar VARCHAR(40), title VARCHAR(80), author VARCHAR(60), journal VARCHAR(200),FOREIGN KEY (registrar) REFERENCES bc_user.bcname ON DELETE CASCADE, pic VARCHAR(100))"); # wishlist $dbh->do("CREATE TABLE list_base (lid INT NOT NULL AUTO_INCREMENT, PRIMARY KEY (lid), uid BIGINT NOT NULL, FOREIGN KEY (uid) REFERENCES fb_user ON DELETE CASCADE, hash CHAR(32), name VARCHAR(40) NOT NULL, public BOOL, comment VARCHAR(1000))"); $dbh->do("CREATE TABLE list_entry (eid INT NOT NULL AUTO_INCREMENT, PRIMARY KEY (eid), uid BIGINT, FOREIGN KEY (uid) REFERENCES fb_user ON DELETE CASCADE, bcid INT NOT NULL, FOREIGN KEY (bcid) REFERENCES bc_book, lid INT NOT NULL, FOREIGN KEY (lid) REFERENCES list_base, comment VARCHAR(1000))"); $dbh->do("CREATE TABLE list_perm (pid INT NOT NULL AUTO_INCREMENT, PRIMARY KEY (pid), uid BIGINT, FOREIGN KEY (uid) REFERENCES fb_user ON DELETE CASCADE)"); $dbh->do("CREATE TABLE fb_layout (uid BIGINT, FOREIGN KEY (uid) REFERENCES fb_user ON DELETE CASCADE, layout TEXT)"); $dbh->do("CREATE TABLE friends (uid BIGINT, FOREIGN KEY (uid) REFERENCES fb_user ON DELETE CASCADE, friend BIGINT, FOREIGN KEY (friend) REFERENCES fb_user ON DELETE CASCADE)"); $dbh->do("CREATE TABLE cookies (uid BIGINT, FOREIGN KEY (uid) REFERENCES fb_user ON DELETE CASCADE, bcname VARCHAR(40) NOT NULL, cookie CHAR(32), time TIMESTAMP)"); #open LOG,"<$logfile"; if ($dblog) { open LOG,"<$dblog"; } else { open LOG,"<$logfile"; } while (my $line=) { if ($line !~ /(bcname )/ && $line =~ /^(?:\d* )?([^\(]*?) ?((?:Van )?[^\( ]*?) \((\d+)\)/) { my ($t,$f,$l,$u); ($f,$l,$u)=($1,$2,$3); if ($line =~ /^(\d+) /) { $t=$1; } else { $t=$basets++; } my $pid=0; if ($f && $l) { my $persons=$dbh->selectall_arrayref("SELECT pid FROM person where firstname=? and lastname=?",undef,$f, $l); #print Dumper($persons); #print $pid,"\n"; if (ref($persons) eq "ARRAY" && @$persons == 1) { $pid=${$$persons[0]}[0]+0; } else { $dbh->do("INSERT INTO person (firstname, lastname) VALUES (".$dbh->quote($f).", ".$dbh->quote($l).")"); $pid=$dbh->{mysql_insertid}; } } my $fb_users=$dbh->selectall_arrayref("SELECT uid FROM fb_user where uid=?",undef,$u); if (ref($fb_users) eq "ARRAY" && @$fb_users == 1) { $dbh->do("UPDATE fb_user SET pid=?,installed=1,last_update=FROM_UNIXTIME($t) WHERE uid=?",undef,$pid,$u); } else { $dbh->do("INSERT INTO fb_user (uid,pid,installed,first_install,last_update) VALUES (?,?,?,FROM_UNIXTIME($t),FROM_UNIXTIME($t))",undef,$u,$pid,1); } } elsif ($line =~ /^(\d+) add \(.*?: (\d+)/) { my ($t,$u)=($1,$2); my $isin=$dbh->selectall_arrayref("SELECT uid FROM fb_user where uid=?",undef,$u); if (ref($isin) eq "ARRAY" && @$isin == 1) { $dbh->do("UPDATE fb_user SET installed=1,last_update=FROM_UNIXTIME($t) WHERE uid=?",undef,$u); } else { $dbh->do("INSERT INTO fb_user (uid,installed,first_install,last_update) VALUES (?,1,FROM_UNIXTIME($t),FROM_UNIXTIME($t))",undef,$u); } } elsif ($line =~ /^(\d+) remove \(.*?: (\d+)/) { my ($t,$u)=($1,$2); my $isin=$dbh->selectall_arrayref("SELECT uid FROM fb_user where uid=?",undef,$u); if (ref($isin) eq "ARRAY" && @$isin == 1) { $dbh->do("UPDATE fb_user SET installed=0,last_update=FROM_UNIXTIME($t) WHERE uid=?",undef,$u); } else { $dbh->do("INSERT INTO fb_user (uid,installed,first_install,last_update) VALUES (?,0,FROM_UNIXTIME($t),FROM_UNIXTIME($t))",undef,$u); } } elsif ($line =~ /\((\d+)\): (\w*)bcname (.*)/) { my $t; my ($u,$f,$b)=($1,$2,$3); if ($line =~ /^(\d+) /) { $t=$1; } else { $t=$basets++; } my $isin=$dbh->selectall_arrayref("SELECT bcname FROM bc_user where bcname=?",undef,$b); if (ref($isin) eq "ARRAY" && @$isin == 0) { $dbh->do("INSERT INTO bc_user (bcname) VALUES (?)",undef,$b); } $isin = $dbh->selectall_arrayref("SELECT uid FROM fb_user where uid=?",undef,$u); if (ref($isin) eq "ARRAY" && @$isin == 1) { my $public=($f=~/public/?1:0); $dbh->do("UPDATE fb_user SET bcname=?,public=$public,installed=1,last_update=FROM_UNIXTIME($t) WHERE uid=?",undef,$b,$u); } else { my $public=($f=~/public/?1:0); $dbh->do("INSERT INTO fb_user (uid,bcname,public,installed,last_update,first_install) VALUES (?,?,$public,1,FROM_UNIXTIME($t),FROM_UNIXTIME($t))",undef,$u,$b); } } } } # verify user, md5 tuple sub verify_bcname { my ($user,$page_id,$cookie)=@_; my $dbh=connect_db(); my $usercookie=$dbh->selectall_arrayref("SELECT uid from cookies WHERE bcname=? AND cookie=? AND (UNIX_TIMESTAMP()-UNIX_TIMESTAMP(time)) < 86400 and uid=?",undef,$user,$cookie,$page_id); if (ref($usercookie) eq "ARRAY" && @$usercookie == 1) { my ($uid)=@{$$usercookie[0]}; my $success=$dbh->do("UPDATE fb_user SET authenticated=1 WHERE uid=? AND bcname=?",undef,$uid,$user); my $event; if (!$success) { $event="error: "; } $event .= "update fb_user set authenticated=1 where uid=$uid and bcname=$user"; my_log "$event"; $dbh->do("delete from cookies where uid=? AND bcname=?",undef,$uid,$user); return "$success: $event"; } else { return "error: bad cookie"; } } sub make_narrow { my ($new_narrow) = @_; $new_narrow=get_editor().$new_narrow; # strip table info, make first column "item" with colon $new_narrow =~ s#]*>##msg; $new_narrow =~ s##
#msg; $new_narrow =~ s#]*>([^<]*?)\s*]*>#$1: #msg; $new_narrow =~ s###msg; $new_narrow =~ s#]*>##msg; $new_narrow =~ s#]*>#

#msg; $new_narrow =~ s##

#msg; # strip div (takes too much space) $new_narrow =~ s#]*>##msg; $new_narrow =~ s#
##msg; # abbreviations $new_narrow =~ s# total, (\d*) during last 4 weeks#, $1 l4w#msg; $new_narrow =~ s#referrals#refs#msg; $new_narrow =~ s#released in the wild#wild released#msg; # set right form $new_narrow =~ s#/clickquote/#/clickquote2/#msg; # remove join time $new_narrow =~ s#(member since.*\d+/\d+/\d\d\d\d) \d+:\d\d:\d\d [AP]M#$1#msg; # my books by status: $new_narrow =~ s#my books by status: ##msg; my $updatenote="updated ".gmtime(time)." GMT"; return "
$new_narrow
"; } sub set_info { return 1; my ($id)=@_; my $info_fields = ['field' => 'Favorite Bands', 'items' => [{'label'=> 'The Mountain Goats', 'image' => 'http://foo.bar/Mountain_goats.jpg', 'description'=>'The Mountain Goats is an urban folk band led by American singer-songwriter John Darnielle.', 'link'=>'http://apps.facebook.com/music/Mountain_goats.php'}, {'label'=>'Radiohead', 'description' => 'Radiohead are an English alternative rock band from Oxfordshire.', 'image'=> 'http://foo.bar/Mountain_goats.jpg', 'link'=>'http://apps.facebook.com/music/Mountain_goats.php'}]]; # print STDERR Dumper($info_fields),"\n"; $facebook->throw_errors(0); $facebook->profile->set_info(title => 'BC Info', type => 5, info_fields => $info_fields, uid => $id); my $response = $facebook->call_success; $facebook->throw_errors(1); my $info_fields=$facebook->profile->get_info(uid => $id); print STDERR "after:\n", Dumper($info_fields),"\n"; if (!$response->[0]) { my ($bcnameweb,$bcnameuri,$verified,$bcnamexmluri)=get_bcname($id); print OUT "info error with user $id ($bcnameweb): $response->[1]\n"; my_log("info error with user $id ($bcnameweb): $response->[1]"); return 0; } return 1; } main();