#!/usr/bin/perl -w # Copyright © 2010-2013 Jamie Zawinski # # Permission to use, copy, modify, distribute, and sell this software and its # documentation for any purpose is hereby granted without fee, provided that # the above copyright notice appear in all copies and that both that # copyright notice and this permission notice appear in supporting # documentation. No representations are made about the suitability of this # software for any purpose. It is provided "as is" without express or # implied warranty. # # Reads a Twitter stream, via the Twitter API, and re-posts those twits to # Facebook, via the Facebook API. Posts are recorded, so that we don't # duplicate them. # # There are a bunch of special cases in here for the DNA Lounge Twitter # stream. If the twit contains a URL pointing to a DNA Lounge flyer, # calendar entry or blog post, then the Facebook post is generated in # a more verbose, out-of-band way so that it has more sensible text and # images attached, includes things like "buy tickets" links, etc. # # Posts that don't contain DNA Lounge URLs are handled more generally. # Posts that appear to have images in them are posted with the image # thumbnail as an attachment; URL-shorteners are expanded; etc. # # # DNA Lounge-specific deployment details: # # This must only be run on cerebrum, because it uses one state file: # "/home/store/.dnalounge-twithist". That file must be globally # writable, since this script is run by both the user "store" (for # various cron-driven posts like "This week!", and for mirroring # manually-made twits) and also by user "archive" (for the # calendar-cron-driven "Tonight!" and "Starting now!" posts.) # # Also, both "store" and "archive" must have a ".dnalounge-twitter-pass" # and ".dnalounge-facebook-pass" file. # # This is also used to mirror the "jwz" account to Facebook, but that # uses a separate state file. # # # Created: 2-Oct-2010. require 5; use diagnostics; use strict; use open ":encoding(utf8)"; use POSIX qw(mktime strftime); use Fcntl; use Fcntl ':flock'; # import LOCK_* constants use JSON::Any; use Net::Twitter; use Data::Dumper; use LWP::Simple; use LWP::UserAgent; use Date::Parse; use HTML::Entities; my $progname = $0; $progname =~ s@.*/@@g; my $version = q{ $Revision: 1.134 $ }; $version =~ s/^[^\d]+([\d.]+).*/$1/; my $verbose = 0; my $debug_p = 0; my $web_root = (-d "/var/www/dnalounge" ? "/var/www/dnalounge" : "."); my $rss_file = "$web_root/calendar/dnalounge.rss"; my $weekly_file = "$web_root/calendar/weekly-thisweek.txt"; my $url_base = "http://www.dnalounge.com/"; my $blog_rss = "${url_base}backstage/log/feed/"; my $dummy_flyer = "${url_base}flyers/noflyer-thumb.jpg"; # All posting uids must share the same hist file, or there will be dups! # This file must be readable and writable by all users who run this script. # my $history_dir = "/home/store/"; ############################################################################ # # Web-scraping utilities. # ############################################################################ sub url_quote($) { my ($u) = @_; # utf8::encode($u); # Split wide chars into multi-byte sequences. $u =~ s|([^- a-zA-Z0-9.\@_])|sprintf("%%%02X", ord($1))|gse; $u =~ s| |+|gs; return $u; } sub url_unquote($) { my ($url) = @_; $url =~ s/[+]/ /g; $url =~ s/%([a-z0-9]{2})/chr(hex($1))/ige; return $url; } # Convert any HTML entities to Unicode characters, including <, etc. # sub html_unquote($) { my ($s) = @_; return HTML::Entities::decode_entities ($s); } # If the URL is a known URL-shortener, open it to return the real URL. # If 'force_p', then chase all redirects even if unrecognized. # sub unpack_tinyurl($;$); sub unpack_tinyurl($;$) { my ($url, $force_p) = @_; my $re = '^https?://( tinyurl\.com | bit\.ly | j\.mp | t\.co | youtu\.be | fb\.me )/'; # We can rewrite this one without hitting the network. return $url if ($url =~ s@^\Qhttp://youtu.be/\E@http://www.youtube.com/watch?v=@si); if (!$force_p) { return $url unless ($url =~ m@$re@sx); } my $ua = LWP::UserAgent->new (max_redirect => 0); $ua->agent ("$progname/$version"); my $res = $ua->get ($url); my $ret = ($res && $res->code) || 'null'; if ($ret eq '301' || $ret eq '302') { my $loc = $res->header('Location'); print STDERR "$progname: unpacked: $url => $loc\n" if ($verbose > 2); if ($loc) { $url = $loc; return $url unless ($url =~ m@$re@sx); return unpack_tinyurl($url); } } return $url; } # expands the first URL relative to the second. # sub expand_url($$) { my ($url, $base) = @_; $url =~ s/^\s+//gs; # lose whitespace at front and back $url =~ s/\s+$//gs; if (! ($url =~ m/^[a-z]+:/)) { $base =~ s@(\#.*)$@@; # strip anchors $base =~ s@(\?.*)$@@; # strip arguments $base =~ s@/[^/]*$@/@; # take off trailing file component my $tail = ''; if ($url =~ s@(\#.*)$@@) { $tail = $1; } # save anchors if ($url =~ s@(\?.*)$@@) { $tail = "$1$tail"; } # save arguments my $base2 = $base; $base2 =~ s@^([a-z]+:/+[^/]+)/.*@$1@ # if url is an absolute path if ($url =~ m@^/@); my $ourl = $url; $url = $base2 . $url; $url =~ s@/\./@/@g; # expand "." 1 while ($url =~ s@/[^/]+/\.\./@/@s); # expand ".." $url .= $tail; # put anchors/args back print STDERR "$progname: relative URL: $ourl --> $url\n" if ($verbose > 2); } else { print STDERR "$progname: absolute URL: $url\n" if ($verbose > 2); } return $url; } ############################################################################ # # Twitter and Facebook OpenID auth. Everything is terrible. # ############################################################################ sub load_twitter_keys($) { my ($user) = @_; my $consumer = 'UNKNOWN'; my $consumer_secret = 'UNKNOWN'; my $access = 'UNKNOWN'; my $access_secret = 'UNKNOWN'; # Read our twitter tokens error ("no \$HOME") unless defined($ENV{HOME}); my $file = "$ENV{HOME}/.$user-twitter-pass"; if (open (my $in, '<', $file)) { print STDERR "$progname: read $file\n" if ($verbose); while (<$in>) { s/#.*$//s; s/\s*$//s; if (m/^\s*$/s) { } elsif (m/^CONSUMER\s*[:=]\s*(.*)$/si) { $consumer = $1; } elsif (m/^CONSUMER_SECRET\s*[:=]\s*(.*)$/si) { $consumer_secret = $1; } elsif (m/^ACCESS\s*[:=]\s*(.*)$/si) { $access = $1; } elsif (m/^ACCESS_SECRET\s*[:=]\s*(.*)$/si) { $access_secret = $1; # } else { # error ("$file: unparsable line: $_"); } } close $in; } elsif ($debug_p) { print STDERR "$progname: $file: $!\n"; } else { error ("$file: $!"); } return ($consumer, $consumer_secret, $access, $access_secret); } sub load_facebook_token($) { my ($app) = @_; my $file = $ENV{HOME} . "/.$app-facebook-pass"; my $token = undef; open (my $in, '<', $file) || error ("$file: $!"); while (<$in>) { if (m/^OAUTH2:\s*(.*?)\s*$/s) { $token = $1; } } close $in; error ("no access token in $file\n\n" . "\t\t run: facebook-rss.pl --generate-session\n") unless $token; print STDERR "$progname: read $file\n" if ($verbose); return $token; } ############################################################################ # # Parse stuff specific to the DNA Lounge calendar, blog, etc. # ############################################################################ # Given a flyer, calendar and/or blog URL, find the corresponding event in # the DNA Lounge calendar RSS or blog, and return the things we'd like to # link to: # ($title, $desc, \@tickets, $facebook_event_url, $thumb_img) # sub load_dnalounge_info($$$$$) { my ($flyer_url, $cal_url, $blog_url, $video, $date) = @_; return unless ($flyer_url || $cal_url || $blog_url || $video || $date); if ($blog_url) { $LWP::Simple::ua->agent("$progname/$version"); my $rss = LWP::Simple::get ($blog_rss); $rss =~ s/(\s*(.*?)\s*@si); my ($date) = ($item =~ m@\s*(.*?)\s*@si); my ($url) = ($item =~ m@\s*(.*?)\s*@si); my ($body) = ($item =~ m@\s*(.*?)\s*$@$1@gs; my ($img) = ($body =~ m@]*?\bSRC="(.*?)"@si); $body =~ s/<(P|BR|TD|TR|TABLE)\b[^<>]*>/ /gsi; $body =~ s/<[^>]+>//gsi; $body =~ s/\s+/ /gsi; # newlines not allowed $body =~ s/^\s+|\s+$//gsi; # $body =~ s/^(.{995}).*$/$1 .../s; # 1000 character limit. Truncate. $body =~ s/^(.{200}).*$/$1 .../s; # Let's go shorter for this one. $img = expand_url ($img, $blog_url) if $img; return ($title, $date, $body, undef, undef, $img); } error ("no blog entry for $blog_url"); return (); } return unless ($flyer_url || $cal_url || $video || $date); open (my $in, '<', $rss_file) || error ("$rss_file: $!"); local $/ = undef; # read entire file my $body = <$in>; close $in; $body =~ s/(]*>([^<>]+)<@si; my ($eid) = m@]*>([^<>]+)<@si; my ($eurl) = m@]*>([^<>]+)<@si; my ($desc) = m@]*>([^<>]+)<@si; my $ecal; # If the item uses the flyer as its guid, also find the calendar url. { my ($yyyy, $mm, $dd) = ($eurl =~ m@(\d{4})[-/](\d\d)(?:\.html#|[-/])(\d\d[a-z]?)@s); $ecal = "${url_base}calendar/$yyyy/$mm-$dd.html"; } if (($eid && $date && $eid eq $date) || ($eflyer && $flyer_url && $eflyer eq $flyer_url) || ($eurl && $cal_url && $eurl eq $cal_url) || ($ecal && $cal_url && $ecal eq $cal_url) || ($video && $desc && $desc =~ m@\Q$video@s)) { my @tix; my ($title) = m@]*>([^<>]+)<@si; my ($date) = m@]*>([^<>]+)<@si; my ($time) = m@]*>([^<>]+)<@si; my ($f2) = m@]*>([^<>]+)<@si; my ($desc) = m@]*>([^<>]+)<@si; my ($fb) = m@]*> (https?://www\.facebook\.com[^<>]+)<@six; s%]*)>([^<>]+)<%{ my ($a, $t) = ($1, $2); my ($n) = ($a =~ m/text="([^\"]+)"/si); $n = 'Buy Tickets' unless $n; my @s = ($n, $t); push @tix, \@s; ''; }%gsexi; $date =~ s@^(\d\d?) ([a-z]+) (\d{4}) \(([a-z]+)\)$@$4, $2 $1@si; $date = "$date. $time"; $flyer_url = $f2 unless $flyer_url; my $thumb = $flyer_url; $thumb =~ s@\.html$@-1-thumb.jpg@s if $thumb; # If we don't have a flyer, but we do have a video, use the thumb of # the video as the image for this Facebook post. # if (! $thumb) { my ($id) = ($desc =~ m@youtube\.com/watch\?v=([^/&?\s\"\'<>]+)@si); $thumb = "http://img.youtube.com/vi/${id}/0.jpg" if ($id); } $title = html_unquote ($title); return ($title, $date, $desc, \@tix, $fb, $thumb); } } return (); } # Given a list of tickets, add entries to the FB post. # # Input: [( ticket_id, ticket_url ) ... ] # Output looks like: # # Buy Tickets: [$20] # Extra Stuff: [$25] # Like - Comment - [RSVP] # sub fb_add_dnalounge_tickets($$$$) { my ($post, $tix, $rsvp, $prefix) = @_; if ($rsvp) { # A post can only have one action. $post->{actions} = JSON::Any->new->objToJson ( { name => 'RSVP', link => $rsvp }); } my @tix = ($tix ? @$tix : ()); # Nah, this is redundant and gives the DESCRIPTION one less line. # if ($rsvp) { # my @r = ("RSVP", $rsvp); # push @tix, \@r; # } my $props = $post->{properties} || ''; $props =~ s@^{\s*(.*)\s*}$@$1@s; foreach my $t (@tix) { my ($name, $url) = @$t; my $anchor; # Split the name into label/link. # "Buy Tickets: $12" => "Tickets: [$10]" # "Buy Tickets" => "Tickets: [Buy]" if ($name =~ s/: *(\$[\d.]+)$//s) { $anchor = $1; } elsif ($name eq "RSVP") { $name = "Are you going"; $anchor = "RSVP"; } else { $name =~ s/\b(Buy|Tickets?)\b//gsi; # lose words "buy" and "tickets" $name =~ s/:\s*$//s; # lose trailing colon $name =~ s/^\s+|\s+$//gs; # compress space $name = "Tickets" unless $name; # "Tickets" if nothing left $anchor = "Buy"; # "Buy" if nothing found } $name = "$prefix: $name" if $prefix; $name =~ s/: Buy Tickets$//si; $props .= ', ' if $props; $props .= "\"$name\": "; $props .= JSON::Any->new->objToJson ({ text => $anchor, href => $url }); } $post->{properties} = "{ $props }"; } # Mark this post as being at DNA Lounge, by setting the "place" field # to the ID of the DNA Lounge (or DNA Pizza) page. # sub fb_dnalounge_add_location($$$) { my ($post, $page, $token) = @_; my $ret = fb_load("page id", "$page?fields=id&access_token=$token"); my $id = ($ret ? $ret->{id} : undef); $post->{place} = $id if $id; } # Adjust DNA Lounge stuff in the just-constructed post for a "This week!" post. # sub fb_dnalounge_munge_weekly($$$$) { my ($post, $user, $app, $token) = @_; my $txt = $post->{message}; $txt =~ s@\s*\b(https?:[^\s]+[a-z\d/])\s*@ @si; my $url = ($1 || ''); $txt =~ s/\s+$//s; open (my $in, '<', $weekly_file) || error ("$weekly_file: $!"); my @events = <$in>; close $in; my $desc = ''; my $img = ''; my $link = ''; my $count = 0; foreach my $key (@events) { chop ($key); my ($yyyy, $mm, $dd, $suf) = ($key =~ m/^(\d{4})-(\d\d)-(\d\d)([a-z]?)$/s); error ("unparsable key: $key") unless $dd; my ($title, $time, $desc2, $tix, $rsvp, $thumb) = load_dnalounge_info (undef, undef, undef, undef, $key); my $etime = mktime (0, 0, 0, $dd, $mm-1, $yyyy-1900, 0, 0, -1); my $dotw = strftime ("%A", localtime($etime)); # If the first event in the list is DG, omit it. # This is so that when we send this twit out on Monday, # it doesn't constantly list tonight's event. # next if ($count == 0 && $title =~ m/^Death Guild$/si); my $title2 = $title; $title2 =~ s/: .*$//s; fb_add_dnalounge_tickets ($post, $tix, undef, $title2); $desc .= "$dotw: $title; "; $img = $thumb unless $img; $count++; last if ($count > 5); } $desc =~ s/\s+$//s; $desc =~ s/;$/!/s; # Instead of using the image of the first flyer, use the cover image? # # Well, we can't use the FB-hosted image ("FBCDN image is not # allowed in stream") and setting {object_id} instead of {picture} # doesn't work either. # # my $ret = fb_load ("cover", "$app?fields=cover&access_token=$token"); # my ($cid, $curl) = ($ret && $ret->{cover} ? # ($ret->{cover}->{cover_id}, # $ret->{cover}->{source}) # : ()); # $img = $curl if $curl; # # So we could use the copy on dnalounge.com instead: # # $img = "${url_base}/facebook/cover.jpg?" . # strftime ("%Y-%m-%d", localtime); # cache buster # # But actually that looks like shit. It's unreadably small. $post->{message} = "This week at DNA Lounge! $desc"; $post->{name} = 'This week at DNA Lounge!'; $post->{link} = $url; $post->{picture} = $img; } # Adjust DNA Lounge stuff in the just-constructed post. # sub fb_dnalounge_munge_post($$$$) { my ($post, $user, $app, $token) = @_; my $txt = $post->{message}; my $url = $post->{link}; fb_dnalounge_add_location ($post, $user, $token) if ($user eq 'dnalounge' || $user eq 'dnapizza'); if (! $url) { $url = $1 if ($txt =~ s@\s*\b(https?://[^\s\[\]()<>\"\']+[a-z\d/])\s*@ @si); } return unless $url; my $flyer = ($url =~ m@dnalounge\.com/flyers/@) ? $url : ''; my $calendar = ($url =~ m@dnalounge\.com/calendar/@) ? $url : ''; my $blog = ($url =~ m@dnalounge\.com/backstage/log/@)? $url : ''; my $video = ($url =~ m@youtube\.com/watch\?v=([^/&?\s\"\'<>]+)@si ? $url : ''); my $video_title = undef; if ($verbose) { print STDERR "$progname: DNA flyer: $flyer\n" if ($flyer); print STDERR "$progname: DNA cal: $calendar\n" if ($calendar); print STDERR "$progname: DNA blog: $blog\n" if ($blog); print STDERR "$progname: DNA video: $video\n" if ($video); } # Format things specially for This week at DNA Lounge" posts. # if ($txt && $txt =~ m/^[^a-z]*THIS WEEK[:!] (Sun|Mon|Tue|Wed|Thu|Fri|Sat)\b/si) { print STDERR "$progname: DNA weekly: $txt\n" if $verbose; return fb_dnalounge_munge_weekly ($post, $user, $app, $token); } if ($post->{name}) { # Lose prefix and trailing date. $post->{name} =~ s/^DNA Lounge (Calendar)?: //si; $post->{name} =~ s/, \s \d\d? [-\s] [A-Z][a-z][a-z] [-\s] \d{4} \s \(? [A-Za-z]+ \)? $ //sx; } # Given a DNA flyer, calendar and/or blog URL, find this event in the RSS. my ($title, $time, $desc, $tix, $rsvp, $thumb) = load_dnalounge_info ($flyer, $calendar, $blog, $video, undef); return unless $title; # no match to RSS: old event, or not DNA. # If this is a "starting now" post, omit the ticket links, since it # is already off-sale. # $tix = undef if ($txt && $txt =~ m@\bstarting now\b@si); # If we don't have a description, extract one from the associated DNA URL. # if (! $post->{description}) { my ($message, $img, $link, $name, $desc2) = fb_parse_thumb_metadata ($post->{link} || $post->{message}, $user, $app); $post->{description} = $desc2 if $desc2; } # Prefer the Facebook event page link to the DNA calendar page. # if ($rsvp && (!$post->{link} || $post->{link} =~ m@/calendar/@)) { $post->{link} = $rsvp; } # If it's a DNA URL but there's no image, add the dummy flyer. # if ($post->{message} && !$post->{picture} && $dummy_flyer) { $post->{name} = $post->{message}; $post->{message} = ""; $post->{picture} = $dummy_flyer; if ($url) { $post->{link} = $url; $post->{name} =~ s/\s*\b\Q$url\E\s*//; $post->{description} = $desc unless $post->{description}; } } # If the "name" is contained in the "message", nuke "name" and move # "description" up to "name". # my $n = $post->{name}; if ($n && $post->{description} && $post->{message} && $post->{message} =~ m/\Q$n\E/si) { $post->{name} = $post->{description}; $post->{description} = ""; } # Add the "properties" array with "Buy tickets" and "RSVP" links. # fb_add_dnalounge_tickets ($post, $tix, $rsvp, undef); # If we're favoriting a YouTube video, we normally include the description # from YouTube. However, if we also included "Buy Tickets" links, that # causes them to be pushed off the bottom of the box. Those are more # important, so if we have those, let's just omit the description. # if ($post->{message} && $post->{properties} && $post->{message} =~ m@Favorited a video: "(.*?)"@si) { $post->{name} = $1; $post->{description} = ""; } # If there's a description, and is exactly one "Buy Tickets" link, # let's omit the "RSVP" link next to "Like" and replace it with # "Buy Tickets: $10" or whatever. Chances are the description # would have made the "Buy Tickets" link be invisible. # if ($post->{description} || $post->{name}) { my $props = JSON::Any->new->jsonToObj ($post->{properties}) if $post->{properties}; if ($props && scalar (keys (%$props)) == 1) { my $k = (keys (%$props))[0]; $post->{actions} = JSON::Any->new->objToJson ( { name => "$k: " . $props->{$k}->{text}, link => $props->{$k}->{href} }); delete $post->{properties}; } } } ############################################################################ # # Convert Twitter text to something more verbose to post to Facebook # by parsing any included URLs to find images, etc. # This part is not DNA Lounge-specific. # ############################################################################ # If the URL in the text is from one of the common image-hosting services, # find the URL of the underlying image itself. We have to do this because # many of these services don't include the proper metadata to find it in # the normal way. # # Returns ($new_text, $image_url, $image_page_href, $image_page_title) # or (). # sub fb_parse_photo_hosts($) { my ($txt) = @_; my $t2 = $txt; my ($page_url, $thumb_url, $data); my $page_title = ''; if ($t2 =~ s@\s*\b(https?:// ( yfrog\.com | plixi\.com | img\.ly | twitpic\.com | instagr\.am | lockerz\.com | twitter\.com ) /([-_a-z\d/]+))\s*@ @six) { my ($site, $id); ($page_url, $site, $id) = ($1, $2, $3); $thumb_url = $page_url; # initially - now munge it. print STDERR "$progname: found photo host: $site\n" if $verbose; if ($site =~ m/yfrog/si) { # Facebook won't do thumbnails with the "xxx:iphone" URL. # I'm guessing it doesn't like the colon, even when encoded. # So force one more redirect to get the underlying image URL. $thumb_url .= ':iphone'; $thumb_url = unpack_tinyurl($thumb_url, 1); $thumb_url =~ s/xsize=480&ysize=480/xsize=640&ysize=640/s; } elsif ($site =~ m/twitpic/si) { $thumb_url = 'http://twitpic.com/show/large/' . $id; } elsif ($site =~ m/img\.ly/si) { $thumb_url = 'http://img.ly/show/large/' . $id; } elsif ($site =~ m/plixi/si || $site =~ m/lockerz/si) { $thumb_url = 'http://api.plixi.com/api/tpapi.svc/imagefromurl' . '?size=big&url=' . $thumb_url; } elsif ($site =~ m/instagr\.am/si) { $id =~ s@/+$@@s; $thumb_url = 'http://instagr.am/' . $id . '/media/?size=l'; } elsif ($site =~ m/twitter\.com/si) { $thumb_url = undef; if ($page_url =~ m@status/([^/]+)/photo@si) { # Photo post # Give me a fucking break. We have to dig it out of the HTML, # because Twitter is above providing us with an "image_src" tag. # We used to be able to dig it out of the XML API instead of # HTML, but Twitter intentionally broke that too. Fuck those guys, # seriously. my $ua = LWP::UserAgent->new (); $ua->agent ("$progname/$version"); my $res = $ua->get ($page_url); my $ret = ($res && $res->code) || 'null'; if ($ret ne '200') { print STDERR "$progname: error: $ret for $page_url (skipping)\n"; } else { my $html = $res->content; ($thumb_url) = ($html =~ m/src=[\'\"]([^\"<>]*?\.jpg:large)[\'\"]/si); print STDERR "$progname: error: no image on $page_url (skipping)\n" unless ($thumb_url); } } $t2 = $txt unless $thumb_url; # put it back if we found nothing } else { error ("unknown site: $site"); } $t2 =~ s/\s+$//s; } # See if the twit contains a bare image. # if (! $thumb_url) { if ($t2 =~ s@\s*\b(https?://[^\s\"\']+?\.(gif|jpe?g|png))\b@@si) { $page_url = $1; $page_url = unpack_tinyurl ($page_url, 1); $thumb_url = $page_url; $t2 =~ s/\s+$//s; $t2 = 'Image' unless $t2; } } return () unless $thumb_url; # If the original text contained more than one URL (could be multiple # photos, only one of which is used as the thumbnail) leave all of the # URLs in place. But if it contained only one URL, omit it, as the # thumbnail links directly there. # $t2 = $txt if ($txt =~ m/https?:.*https?:/si); return ($t2, $thumb_url, $page_url, $page_title); } # If there's a URL in the text, retrieve it, and parse out any thumbnail- # related metadata ("og:image", "image_src", etc.) in the LINK and META # tags. # # Returns ($new_text, $thumb_img_url, $page_url, $page_title, $desc) or (). # sub fb_parse_thumb_metadata($$$) { my ($txt, $user, $app) = @_; my $t2 = $txt; my $url; my ($thumb_title, $thumb_url, $description); if ($t2 =~ s@\s*\b(https?://[^\s\[\]()<>\"\']+[-_a-z\d/])\s*@ @si) { my $url = $1; $t2 =~ s/^\s+|\s+$//gsi; $url = unpack_tinyurl ($url, 1); my $ua = LWP::UserAgent->new (); $ua->agent ("$progname/$version"); my $fb_url = undef; # If we're trying to get the thumbnail and description of a Facebook # URL, do it through the Graph. It is the height of hubris that # Facebook's *own pages* do not include Open Graph tags when they # invented the fucking things. # if ($url =~ m@^https?://(?:[a-z]+\.)?facebook\.com/.*\b(\d{8,})\b@s) { $fb_url = "https://graph.facebook.com/$1?fields=name,source"; } print STDERR "$progname: retrieving $url\n" if $verbose; my $res = $ua->get ($fb_url || $url); my $ret = ($res && $res->code) || 'null'; if ($ret ne '200') { print STDERR "$progname: error: $ret for $url (skipping)\n"; } else { my $html = $res->content; utf8::decode ($html); # Pack multi-byte UTF-8 back into wide chars. my $link = $1 if (($html =~ m@(]*? REL = [\"\'] image_src [\"\'] [^<>]* >)@six) || ($html =~ m@(]*? PROPERTY = [\"\'] og:image [\"\'][^<>]*>)@six)); my ($url2) = ($link =~ m@\b (?: HREF | CONTENT ) = [\"\'] ( [^\"\'<>]+ )@six) if $link; my ($desc) = ($html =~ m@( ]*? (?: PROPERTY | NAME ) = [\"\'] (?: og: )? description [\"\'][^<>]*> ) @six); (undef, $desc) = ($desc =~ m@\b CONTENT \s* = ([\"\']) ( [^<>]*? ) \1@six) if $desc; if ($fb_url && !$url2) { # # Extract the image from the graph JSON. # Omit the description, since that is probably already taken # care of in $txt # ($url2) = ($html =~ m@ "source" \s* : \s* " (.*?) " @sx); #($desc) = ($html =~ m@ "name" \s* : \s* " (.*?) " @sx); foreach ($url2, $desc) { s/\\//gs if $_; } } my $ot2 = $t2; $description = $desc if ($desc); if ($url2 || $desc) { $url2 = expand_url ($url2, $url) if $url2; ($thumb_title) = ($html =~ m@(.*?)@si); #### Kludge: This is really a DNA Lounge thing. #### if ($ot2 =~ m@Favorited a video: "(.*?)"@si) { $thumb_title = $1; $t2 = $ot2; } $thumb_title = '' unless $thumb_title; $thumb_title =~ s/\s+/ /gs; $thumb_title =~ s/^\s+|\s+$//gs; $thumb_title =~ s/ - Youtube$//si; $thumb_url = $url2; # Munge the URL for a non-thumb-sized image. # if (! $thumb_url) { } elsif ($thumb_url =~ m/posterous\.com/) { $thumb_url =~ s/thumb\d+\.jpg$/scaled500.jpg/s; } elsif ($thumb_url =~ m/twitgoo/) { $thumb_url =~ s/_th\.jpg$/.jpg/s; } if ($verbose) { if ($url2) { print STDERR "$progname: found thumb $url2 ($thumb_title)\n"; } else { print STDERR "$progname: found thumbless desc ($thumb_title)\n"; } } } else { print STDERR "$progname: no thumb\n" if $verbose; } foreach ($t2, $thumb_title, $description) { next unless $_; s/\s+/ /gs; s/^\s+|\s+$//gs; # Lose web site name at the beginning. s/^(@?(\Q$user\E|\Q$app\E)\b[:\s]*)+//si; #### Kludge. s/^DNA Lounge: //s; # Also remove dates at beginning. s/^\d\d?[-\s][A-Z][a-z][a-z][-\s]\d{4}(\s\(?[A-Za-z]+\)?)?:?\s+//s; } return () unless ($thumb_url || $description); return ($t2, $thumb_url, $url, $thumb_title, $description); } } return (); } # If this is a RT, use the user's twitter avatar as the image. # Returns ($page_url, $thumb_url, $page_title) or (). # sub fb_parse_twitter_avatar($) { my ($txt) = @_; my $t2 = $txt; my ($user) = ($txt =~ m/\b RT \b [:\s]* \@? ([_a-z\d]+)\b/six); ($user) = ($txt =~ m/\@([_a-z\d]+)\b/si) unless $user; return () unless $user; # Kludge: are we ourselves? return () if ($user eq 'dnapizza' || $user eq 'dnalounge' || $user eq 'jwz'); my $ua = LWP::UserAgent->new (); $ua->agent ("$progname/$version"); # The API is gone so just dig it out of the HTML. Screw you guys. my $url = 'http://twitter.com/' . $user; print STDERR "$progname: retrieving $url\n" if $verbose; my $res = $ua->get ($url); my $ret = ($res && $res->code) || 'null'; if ($ret ne '200') { print STDERR "$progname: error: $ret for $url (skipping)\n"; } else { my $html = $res->content; my ($img) = ($html =~ m@src=[\'\"](http[^\'\"<>]+/profile_images/[^\'\"<>]+)@si); if (! $img) { print STDERR "$progname: no avatar in $url (skipping)\n"; return (); } $img =~ s/_bigger//gs; my ($title) = ($html =~ m@(.*?)<@si); $title =~ s@ on Twitter@@gs; return ($url, $img, $title); } return (); } # Split a piece of text into two: the first sentence, and the rest. # The sentence won't be longer than $max_length. If the first sentence # is too long, it will be divided earlier than at the end. # sub fb_split_sentence($$) { my ($text, $max_length) = @_; my $min_length = 10; # Always take at least this many characters. my ($first, $rest) = ($text =~ m/ ^ ( .{$min_length,}? [.?!] (?: \" | " )? ) \s+ ( .* )$/six); return ($text, '') unless $first; # If the first sentence is too long, try to split it at the last # colon or semicolon. # while (length ($first) > $max_length && $first =~ m/ ^ ( .{$min_length,}? [:;] (?: \" | " )? ) \s+ ( .* )$/six) { ($first, $rest) = ($1, "$2 $rest"); } # If it is still too long, try to split it at the last comma. # while (length ($first) > $max_length && $first =~ m/ ^ ( .{$min_length,}? [,] (?: \" | " )? ) \s+ ( .* )$/six) { ($first, $rest) = ($1, "$2 $rest"); } # If it is still too long, move the split-point back by words until it fits. # while (length ($first) > $max_length && $first =~ m/ ^ ( .{$min_length,}? ) \s+ ( [^\s]+ )$/six) { ($first, $rest) = ($1, "$2 $rest"); } return ($first, $rest); } # Given some text we're going to post, look at any URLs in it and determine # an image attachment and corresponding caption to put on that post. # Returns an array of "post" parameters. # sub fb_make_attachment($$$$$) { my ($user, $app, $token, $private_p, $txt) = @_; $txt =~ s/\s+/ /gs; $txt =~ s/^\s+|\s+$//gs; # If I have at-replied to myself, remove that from the front. $txt =~ s/^(@(\Q$user\E|\Q$app\E)\b[:\s]*)+//si; if ($txt =~ m/^@/s) { print STDERR "$progname: skipping at-reply $txt\n" if $verbose; return undef; } # Unpack all shortened URLs. $txt =~ s@(https?:[^\s]+[a-z\d/])@{ unpack_tinyurl($1) }@gsexi; #### KLUDGE: Always ignore the text in the twit if this is a jwz #### post with a shorturl. Instead always just use the info from #### the web site. # $txt =~ s@^.*\b(http://jwz.org/b/[^\s]+)\s*$@$1@gs; # A Facebook post looks like this: # # MESSAGE. All work and no play makes Jack a dull boy. All # work and no play makes Jack a dull boy. All work and no play # makes Jack a dull boy. All work and no play makes Jack a # dull boy. All work and no play makes Jack a dull boy. All # work and no play makes Jack a dull boy. All work and no play # makes Jack a dull boy. All work and no play [ SHOW MORE ] # # ---------------- # | | NAME. All work and no play makes Jack a # | | dull boy. All work and no play makes... # | | # | thumbnail | CAPTION. All work and no play makes Jack a # | | dull boy. # | 90 x 90 | # | | DESCRIPTION. All work and no play makes Jack # | | a dull boy. All work and no play makes # | | Jack a dull boy. All work and no play # ---------------- # # https://developers.facebook.com/docs/guides/attachments/ says: # # NAME: title of the post. Should fit on "one line in user's stream". # CAPTION: Subtitle describing why the user posted the item. "One line". # DESCRIPTION: About the story. 1000 characters, 300 shown. # # Empirically: # # MESSAGE appears at the top in the default font size, and can have more # than 5200 characters. It goes into "see more" mode in the stream at # around 350 characters. # # Other text is to the right of the thumbnail, in a smaller font. # # NAME is bold, and has an HREF on it. An error is signaled if it is # more than 1000 characters. It is elided at around 160 characters. # # CAPTION appears directly beneath NAME. # # DESCRIPTION is specified but no CAPTION, then CAPTION is set to the # host name from the LINK. # # NAME, CAPTION and DESCRIPTION are contained within a DIV with # "overflow: hidden", so only around 260 characters total show up. # # If PROPERTIES are specified, of the form: # # { "Label 1": { "text" => "A", "href" = "B" }, ... } # # then those appear below CAPTION and DESCRIPTION. However, they are # also included in the "overflow: hidden" DIV, so you can't see them if # there are too many words in NAME + CAPTION + DESCRIPTION. # Oh, get this. Facebook seems to have two modes of presentation: # # Style 1: # - larger image # - says "shared a link" on feed, and "in San Francisco" on page # - says "-- at DNA Lounge" # # Style 2: # - smaller image # - says "via mobile" on page # # Style 2 is used if there are any PROPERTIES or ACTIONS. # Otherwise, Style 1 is used. # # So that sucks. It means we have to pick between large images, and # having "Buy" and "RSVP" links. my $post = {}; my $photo_p = 0; { my $msg = $txt; # at the top my $name = ''; # next to image, line 1 my $desc = ''; # next to image, line 2 my $img = undef; my $link = undef; # First try to find a thumbnail from one of the photo hosting services. # if (! $img) { my @r = fb_parse_photo_hosts ($txt); if (@r) { ($msg, $img, $link, $name) = @r; $photo_p = 1; } } # Then try to find a thumbnail via meta tags. # if (! $img) { my @r = fb_parse_thumb_metadata ($txt, $user, $app); ($msg, $img, $link, $name, $desc) = @r if @r; } # Then try to use a Twitter avatar, if we're retwitting someone. # if (! $img) { my @r = fb_parse_twitter_avatar ($txt); if (@r) { ($link, $img, $name) = @r; # If there was already a Twitter /status/ URL in there, # use that instead of the user's home page. # $link = $1 if ($msg =~ s@\s+(https?://twitter.com/[^\s]*?/status/[^\s]*)@@s); # Put the whole twit next to the avatar image instead of above. $desc = $msg; $name = ''; $msg = ''; } } # Construct the post hash. $post->{message} = $msg || ''; $post->{picture} = $img if $img; $post->{link} = $link if $link; $post->{name} = $name if $name; $post->{description} = $desc if $desc; } # After loading links and metadata, adjust things in DNA-specific ways. fb_dnalounge_munge_post ($post, $user, $app, $token); # If after all that we still don't have an image, use the default one. # if (! $post->{picture} && $dummy_flyer) { $post->{picture} = $dummy_flyer; $post->{link} = $1 if ($post->{message} =~ s@\s*\b(https?://[^\s\[\]()<>\"\']+[-_a-z\d/])\s*@ @si); } if ($post->{picture}) { # Clear MESSAGE if it's the same as NAME. $post->{message} = "" if ($post->{name} && ($post->{message} eq $post->{name} || $post->{message} eq $post->{name} . ".")); # Clear NAME if it's the same as LINK. $post->{name} = "" if ($post->{name} && $post->{name} eq $post->{link}); # Let's use the canonical YouTube thumbs so that FB adds a play button. # "http://i3.ytimg.com/vi/___/maxresdefault.jpg?feature=og" ==> # "http://img.youtube.com/vi/___/0.jpg". # $post->{picture} =~ s@^https?://[a-z\d]+\.ytimg\.com/vi/([^/?&]+).*$ @http://img.youtube.com/vi/$1/0.jpg@six; # Move everything toward the top to fill in missing slots. # if (!$post->{message} && $post->{name}) { $post->{message} = $post->{name}; $post->{name} = $post->{description}; $post->{description} = ""; } if (!$post->{name} && $post->{description}) { $post->{name} = $post->{description}; $post->{description} = ""; } # Let's try to take the text and divided it into three parts to # make someone efficient use of space. We'll put the title of the # post at the top in MESSAGE (not a link) then make the first # sentence of the post be the NAME (and a link) then put the rest # in DESCRIPTION. if ($post->{name} && !$post->{description}) { ($post->{name}, $post->{description}) = fb_split_sentence ($post->{name}, 100); } # If we only have one piece of text, put that next to the image # instead of above it. # if ($post->{message} && !$post->{name} && !$post->{description}) { $post->{name} = $post->{message}; $post->{message} = ""; } # If we still have no NAME, extract the host name from the URL. # $post->{name} = 'Photo' if (!$post->{name} && $photo_p); if (!$post->{name} && $post->{link}) { ($post->{name}) = ($post->{link} =~ m@^https?://(?:[-_a-z]+\.)?([^/.]+\.[^/]+)@si); $post->{name} = $post->{message} unless $post->{name}; $post->{name} = "Link" unless $post->{name}; } } # Gaah, if we ended up with a URL in the description, that must be # the *real* link, so use that instead. # if ($post->{description} && $post->{description} =~ s@^\s*(https?://[^\s]+)\s*@@s) { $post->{link} = $1; } # Some late reformatting to make the text be more Facebook-compatible. # foreach my $f ('message', 'name', 'caption', 'description') { my $ff = $post->{$f}; next unless $ff; $ff = html_unquote ($ff); # Facebook ignores newlines. $ff =~ s/^\s+|\s+$//gs; $ff =~ s/\s+/ /gs; # Lose "my-name: " at the beginning of the text. $ff =~ s/^(@?(\Q$user\E|\Q$app\E)\b[:\s]*)+//si; $ff =~ s/^(.{995}).*$/$1 .../s; # 1000 character limit. Truncate. $post->{$f} = $ff; } # Let's try to wipe out the Twitter advertising that Facebook sucks in. # If we use   instead of "" or " ", that shit goes away. # if ($post->{picture}) { $post->{caption} = "\x{A0}" unless $post->{caption}; $post->{description} = "\x{A0}" unless $post->{description}; } if ($private_p) { $post->{privacy} = JSON::Any->new->objToJson ({ value => 'SELF' }); } return $post; } ############################################################################ # # Posting to Facebook. # ############################################################################ # Load a URL from Facebook, convert JSON to hashrefs. # Retry a few times if it fails. # my $fb_first_time_p = 1; sub fb_load($$;$$) { my ($description, $args, $post_args, $ignore_errors) = @_; $ignore_errors = 0 unless defined ($ignore_errors); my $url; if ($args =~ m/^http/s) { $url = $args; } else { $url = 'https://graph.facebook.com/'; $args =~ s/\?/&/g; $args =~ s/&/?/; $url .= $args; } if ($post_args) { foreach my $k (keys %$post_args) { my $v = $post_args->{$k}; utf8::encode ($v); # Unpack wide chars to multi-byte UTF-8. $post_args->{$k} = $v; } } my $obj = undef; my $err = undef; my $retries = ($debug_p ? 1 : 10); $retries = 1 if ($ignore_errors > 1); my $ua = $LWP::Simple::ua; $ua->agent("$progname/$version"); # $ua->add_handler("request_send", sub { shift->dump; return }); # $ua->add_handler("response_done", sub { shift->dump; return }); for (my $i = 0; $i < $retries; $i++) { my $res = undef; if ($post_args) { $res = $ua->post ($url, Content_Type => 'form-data', Content => $post_args); } else { $res = $ua->get ($url); } my $ret = ($res && $res->code) || 'null'; my $json = ($res && $res->content) || ''; if ($json && $json =~ m/^access_token=/s) { $obj = $json; # You complete asshats! Non-JSON response! } elsif ($json) { eval { my $j = JSON::Any->new; $obj = $j->jsonToObj ($json); }; } if ($ret ne '200') { $err = "Error $ret: $description: "; if ($obj && $obj->{error} && $obj->{error}->{message}) { $err .= $obj->{error}->{message}; } else { $err .= $res->message; } $obj = undef; $retries = 0 if ($post_args); } last if defined ($obj); } if (!$obj || $err) { $err = "$description failed" unless $err; if (! $ignore_errors) { if ($fb_first_time_p && $err =~ m/^Error 4\d\d/si) { # A 500 error means something other than bogus token. $err .= ("\n" . "\t\t This might mean your access_token is bogus.\n" . "\t\t Check your ~/.APPNAME-facebook-pass file.\n"); } else { $err .= " after $retries tries -- $url"; } error ($err); } return undef; } $fb_first_time_p = 0; return $obj; } # If we're posting to a page, we have to trade in our user-token for a # page-token or else things post as "Jamie Zawinski" instead of "DNA Lounge". # sub fb_swap_token($$) { my ($page, $token) = @_; my $ret = fb_load ("page id", "$page?fields=id&access_token=$token"); my $page_id = ($ret ? $ret->{id} : undef); error ("can't find ID of page $page") unless $page_id; $ret = fb_load ("account token", "me/accounts?access_token=$token"); error ("can't find account tokens") unless ($ret && $ret->{data}); my $token2 = undef; foreach my $a (@{$ret->{data}}) { next unless ($a->{id} eq $page_id); $token2 = $a->{access_token}; last; } error ("unable to find token for $page") unless $token2; print STDERR "$progname: swapped token to $page\n" if ($verbose > 1); return $token2; } sub fb_post($$$$) { my ($user, $app, $private_p, $txt) = @_; # For debug printouts. # $Data::Dumper::Indent = 1; $Data::Dumper::Terse = 1; $Data::Dumper::Quotekeys = 0; $Data::Dumper::Pair = "\t=> "; $Data::Dumper::Pad = " "; $Data::Dumper::Sortkeys = sub($) { # Print fields in Facebook order. my ($hash) = @_; my @keys = keys(%$hash); my %sk = ( 'message' => ' 01', 'link' => ' 02', 'picture' => ' 03', 'name' => ' 04', 'caption' => ' 05', 'description' => ' 06', 'properties' => ' 07', 'actions' => ' 08', 'place' => ' 09', 'privacy' => ' 10', ); @keys = sort { ($sk{$a} || $a) cmp ($sk{$b} || $b); } @keys; return \@keys; }; my $token = load_facebook_token ($app); $token = fb_swap_token ($user, $token) if ($user eq 'dnalounge' || $user eq 'dnapizza'); my $post = fb_make_attachment ($user, $app, $token, $private_p, $txt); return unless ($post); my $ret = fb_load("user id", "$user?fields=id&access_token=$token"); my $userid = ($ret ? $ret->{id} : undef); # if (!$userid && $user eq 'dnapizza') { $userid = '192927147394687'; } # if (!$userid && $user eq 'dnalounge') { $userid = '12161711085'; } error ("unable to find uid of Facebook user \"$user\"") unless $userid; # No undefs in the hash. foreach my $k (keys %$post) { # delete $post->{$k} $post->{$k} = '' unless defined($post->{$k}); } if ($debug_p > 1) { print STDOUT ("<DIV STYLE='border: 1px solid; width: 30em;" . "overflow: hidden; padding: 1em;'>" . ($post->{message} || "[NO MSG]") . ($post->{picture} ? "<DIV STYLE='width: 100%; height: 5em;" . " overflow: hidden; margin: 1em;'>" . "<A HREF='" . ($post->{link} || "[NO LINK]") . "'>" . "<IMG SRC='" . $post->{picture} . "' STYLE='" . " width: 7em; height: auto; border: 1px solid;" . " float: left;'>" . "</A>" . "<DIV STYLE='margin-left: 8em;'>" . "<A HREF='" . ($post->{link} || "[NO LINK]") . "'>" . ($post->{name} || "[NO NAME]") . "</A><BR>" . ($post->{caption} || "[NO CAP]") . ($post->{description} || "[NO DESC]") . "</DIV>" . "</DIV>" : "") . ($post->{properties} ? ((sub($) { my ($h) = @_; my $r = ""; $h = JSON::Any->new->jsonToObj($h); foreach my $p (keys %{$h}) { $r .= ($p . ": " . "<A HREF=\"" . $h->{$p}->{href} . "\">" . $h->{$p}->{text} . "</A><BR>"); } return $r; })->($post->{properties})) : "") . ($post->{place} ? "<P>Place: " . $post->{place} : "") . "</DIV><P>\n"); } elsif ($debug_p) { # Convert these to objects for printing. foreach my $f (qw{properties actions privacy}) { $post->{$f} = JSON::Any->new->jsonToObj ($post->{$f}) if ($post->{$f}); } print STDERR "\nWould have posted to $user ($userid):\n"; print STDERR Dumper($post), "\n\n"; return; } return if ($debug_p); $ret = fb_load ("posting", "$user/feed?access_token=$token", $post); error ("post failed") unless $ret; my $post_id = $ret->{id}; error ("no id after post") unless $post_id; $post_id =~ s@_@/posts/@s; $post_id = 'https://www.facebook.com/' . $post_id; print STDERR "$progname: FB post: $post_id\n" if ($verbose); } ############################################################################ # # Read from Twitter. Post to Facebook. Save history state. # ############################################################################ sub copy_twitter_to_facebook($$$$) { my ($tuser, $fuser, $app, $private_p) = @_; my ($consumer, $consumer_secret, $access, $access_secret) = load_twitter_keys ($app); my $nt = Net::Twitter->new ( traits => [qw/OAuth API::RESTv1_1 WrapError/], consumer_key => $consumer, consumer_secret => $consumer_secret, access_token => $access, access_token_secret => $access_secret, ); # If it's more than 4 hours old, don't repost it. No longer timely. my $since = time() - (60 * 60 * 4); $since -= (60 * 60 * 24 * 2) if ($debug_p); my $ret = undef; # Twitter fails often. Retry a few times until we get a response. # my $retries = 10; for (my $i = 0; $i < $retries; $i++) { $ret = $nt->user_timeline ({id => $tuser, since => $since, include_rts => 1}); last if ($ret && @$ret); if ($verbose > 1) { my $err = $nt ? $nt->get_error() : undef; $err = ($err ? $err->{error} : '') || 'null response'; print STDERR "$progname: twitter: timeline: $err (retrying...)\n"; } sleep 5 + $i; } if (! $ret) { my $err = $nt ? $nt->get_error() : undef; $err = ($err ? $err->{error} : '') || 'null response'; error ("twitter: timeline: $err (after $retries tries)"); } # # Lock a mutex, so that only one copy of this script can run at once. # my @hist = (); $history_dir = '/tmp/' if ($debug_p && ! -d $history_dir); my $file = "$history_dir/.$tuser-twithist"; $file =~ s@//+@/@gs; print STDERR "$progname: awaiting lock: $file\n" if ($verbose > 1); my $hist_fd; open ($hist_fd, '+>>', $file) || error ("unable to write $file: $!"); flock ($hist_fd, LOCK_EX) || error ("unable to lock $file: $!"); seek ($hist_fd, 0, 0) || error ("unable to rewind $file: $!"); @hist = <$hist_fd>; print STDERR "$progname: read $file\n" if $verbose; # # Read the history file, to avoid re-posting things we've already posted. # Build up a list of twits to post to Facebook. # my %hist; foreach my $h (@hist) { my ($id, $txt) = split(/\t/, $h); $hist{$id} = $txt; print STDERR "$progname: old: $id: $txt\n" if ($verbose > 3); } my $max = 100; # truncate, omitting really old entries @hist = @hist[0 .. $max] if ($#hist >= $max); my @new = (); foreach my $t (@$ret) { my $id = $t->{id}; if (! $hist{$id}) { my $txt = $t->{text}; $txt = html_unquote ($txt); # If it's a retweet, 'text' might be truncated at 140. # Make a longer-than-140 un-truncated version. # Also stick the URL of the actual twit in there if # there isn't a URL already. # if ($t->{retweeted_status}) { my $u2 = $t->{retweeted_status}->{user}->{screen_name}; my $t2 = $t->{retweeted_status}->{text}; my $url = 'https://twitter.com/' . lc($u2) . '/status/' . $t->{retweeted_status}->{id_str}; $txt = "RT \@$u2: $t2"; $txt .= " $url" unless ($txt =~ m/https?:/s); $txt = html_unquote ($txt); } $txt =~ s/\n/\\n/gs; my $line = "$id\t$txt\n"; print STDERR "$progname: new: $id: $txt\n" if ($verbose > 3); unshift @new, $line; # Post in chronological order. } } unshift @hist, @new; # # Post the new twits to Facebook. # foreach my $t (@new) { my ($id, $txt) = split(/\t/, $t); $txt =~ s/\\n/\n/gs; fb_post ($fuser, $app, $private_p, $txt); } # # Save the new history file, and unlock the mutex. # if ($#new < 0) { print STDERR "$progname: $file unchanged\n" if ($verbose > 1); } elsif ($debug_p) { print STDERR "$progname: not writing $file\n" if ($verbose); print STDERR join('', @hist) . "\n" if ($verbose > 2); } else { print STDERR "$progname: writing $file\n" if $verbose; truncate ($hist_fd, 0) || error ("unable to truncate $file: $!"); seek ($hist_fd, 0, 0) || error ("unable to rewind $file: $!"); print $hist_fd join('', @hist); } flock ($hist_fd, LOCK_UN) || error ("unable to unlock $file: $!"); close ($hist_fd); } sub error($) { my ($err) = @_; print STDERR "$progname: $err\n"; exit 1; } sub usage() { print STDERR "usage: $progname [--verbose] " . "[--twitter-user u] [--facebook-user u] [--app u]\n" . "\t\t [--debug [text]] [--private]\n"; exit 1; } sub main() { my $tuser = undef; my $fuser = undef; my $app = 'dnalounge'; my $debugtxt; my $private_p = 0; while ($#ARGV >= 0) { $_ = shift @ARGV; if (m/^--?verbose$/) { $verbose++; } elsif (m/^--?debug$/) { $debug_p++; } elsif (m/^-v+$/) { $verbose += length($_)-1; } elsif (m/^--?user$/) { $tuser = shift @ARGV; $fuser = $tuser; } elsif (m/^--?(fb|facebook)-user$/) { $fuser = shift @ARGV; } elsif (m/^--?twitter-user$/) { $tuser = shift @ARGV; } elsif (m/^--?app$/) { $app = shift @ARGV; } elsif (m/^--?private$/) { $private_p++; } elsif (m/^-./) { usage; } elsif ($debug_p && !$debugtxt) { $debugtxt = $_; } else { usage; } } $tuser = 'dnalounge' unless (defined($tuser) && defined($fuser)); $tuser = $fuser unless $tuser; $fuser = $tuser unless $fuser; if ($app eq 'jwz') { #### Kludge $dummy_flyer = undef; $history_dir = (-d '/home/jwz' ? '/home/jwz' : '/Users/jwz'); } if ($debugtxt) { fb_post ($fuser, $app, $private_p, $debugtxt); } else { copy_twitter_to_facebook ($tuser, $fuser, $app, $private_p); } } main(); exit 0;