#!perl
use strict;
use warnings;
use 5.020;
use experimental 'postderef';
use Net::Twitter;
use Path::Tiny;
use JSON;
use Try::Tiny;
use Safe::Isa;
use open ':std',':locale';
use Data::Printer;
=head1 NAME
twitlist - create & update Twitter lists
=head1 SYNOPSIS
$ twitlist > lists.txt
$ edit lists.txt
$ twitlist lists.txt
=head1 DESCRIPTION
This program makes it a bit easier to create Twitter lists, and manage the people in them.
Before you use this program, you need to create a JSON file in this same directory, containing your access credentials.
It should look like this:
{
"consumer_key": "1234",
"consumer_secret": "5678",
"access_token": "9abc",
"access_token_secret": "def0"
}
You can get the correct values by registering an application at
L.
Once you've done that, run this script with no arguments:
$ twitlist > lists.txt
This will produce, on standard output, a text file with one Twitter account per line, and the lists they belong to.
It will look like this:
@name The Full Name : list_one, list_two
You can then edit that file, adding or removing list names after the colon.
If you add the name of a list that doesn't exist, it will be created.
To apply your changes to your Twitter lists, re-run the script passing the text file as argument:
$ twitlist lists.txt
I: this script will not actually write to Twitter unles you set the C environment variable to a true value.
=cut
my $WRITING=$ENV{TWITTER_WRITE} // 0;
# create a Net::Twitter object with out tokens
sub get_twitter {
my $config_file = path(__FILE__)->basename('.pl') . '.json';
my $conf = decode_json(path($config_file)->slurp_raw);
return Net::Twitter->new(traits=>[
'API::RESTv1_1',
'AutoCursor',
'AutoCursor' => {
max_calls => 15,
force_cursor => 1,
array_accessor => 'users',
methods => [qw(friends followers)],
},
],%$conf);
}
# returns a hashref shaped like:
# {
# $list_id => {
# name => $list_name,
# members => { $user_screen_name => 1, ... },
# }, ...
# }
sub fetch_lists_info {
my ($tw) = @_;
my $lists = $tw->list_ownerships({
count => 200,
});
my %lists_info = map {
$_->{id} => {
$_->%{qw(name)},
},
} $lists->{lists}->@*;
for my $list_id (sort keys %lists_info) {
my $members = $tw->list_members({
list_id => $list_id,
count => 2000,
skip_status => 1,
include_entities => 0,
});
$lists_info{$list_id}->{members}={
map { $_->{screen_name} => 1 } $members->{users}->@*,
};
}
return \%lists_info;
}
# returns a hashref shaped like:
# {
# $user_id => {
# name => $user_name,
# screen_name => $user_screen_name,
# }, ...
# }
sub fetch_friends_info {
my ($tw) = @_;
my $friends = $tw->friends({
count => 200,
skip_status => 1,
include_user_entities => 0,
});
my %friends_info = map {
$_->{id} => { $_->%{qw(name screen_name)} }
} $friends->@*;
return \%friends_info;
}
sub cache_file { path(__FILE__)->basename('.pl') .'-cache.json' };
sub load_info {
return try { decode_json(path(cache_file)->slurp_raw) };
}
sub save_info {
path(cache_file)->spew_raw(encode_json({
lists=>$_[0],
friends=>$_[1],
}));
return;
}
# from { $id => { name => $n, ...}, ... }
# to ( { id => $id, name => $n, ...}, ... )
# sorted by name
sub to_list {
sort {
$a->{name} cmp $b->{name}
} map {
{ id => $_, $_[0]->{$_}->%* }
} keys $_[0]->%*
}
# sets the ->{dn} slot to the name, or the screen name + name
# returns the maximum length of the dns set
sub set_display_name {
my $max=0;
for my $e ($_[0]->@*) {
$e->{dn} = $e->{screen_name}
? sprintf '@%s (%s)',$e->@{qw(screen_name name)}
: sprintf '%s',$e->@{qw(name)};
my $l = length($e->{dn});
$max = $l if $max<$l;
}
return $max;
}
# given the output of fetch_lists_info and fetch_friends_info
# prints the text file
sub print_friends_lists_matrix {
my ($li,$fi) = @_;
my @lists = to_list($li);
set_display_name(\@lists);
my @friends = to_list($fi);
my $friend_width = set_display_name(\@friends);
for my $f (@friends) {
printf '%-*s : ',$friend_width,$f->{dn};
print join ', ',
map { $_->{dn} }
grep { $_->{members}->{$f->{screen_name}} }
@lists;
print "\n";
}
}
# given a filename, parses users & lists out of it
sub parse_friends_lists_matrix {
my ($fn) = @_;
my @lines = path($fn)->lines_utf8;
my %lists;
for my $l (@lines) {
# the line should start with a @screen_screen,
# followed by a name in parentheses
$l =~ s{\A\@(\S+)\s+\(.*?\)\s*:}{} or next;
my $friend_name = $1;
# after the colon there should be a comma-separated list of list names
# (the map trims spaces out of each name)
my @lists = map { s{\A\s*(.*?)\s*\z}{$1}r } split ',',$l;
for my $list (@lists) {
# we might get some 0-length strings
# if there's nothing after the colon
next unless $list;
# add the user to the members of the list
my $list_data = $lists{$list}||={};
$list_data->{members}->{$friend_name} = 1;
}
}
return \%lists;
}
# this is the function that does most of the work
sub make_it_so {
my ($tw,$current_lists_by_id,$wanted_lists) = @_;
# we'll need to access the lists by name, let's build that hash
my %current_lists_by_name = map {
$current_lists_by_id->{$_}{name} => {
id => $_,
$current_lists_by_id->{$_}->%*,
};
} keys $current_lists_by_id->%*;
# first, lists to create
for my $list (keys $wanted_lists->%*) {
unless ($current_lists_by_name{$list}) {
warn "creating $list\n";
my $list_data;
if ($WRITING) {
$list_data = $tw->create_list({name=>$list,mode=>'private'});
}
else {
$list_data = { id => int(rand(10000)) };
}
$current_lists_by_name{$list} = {
$list_data->%{id},
members => {},
};
}
}
# then, set members
for my $list (keys $wanted_lists->%*) {
warn "operating on $list\n";
my %current_members = $current_lists_by_name{$list}->{members}->%*;
my %wanted_members = $wanted_lists->{$list}{members}->%*;
my %to_add = %wanted_members; delete @to_add{keys %current_members};
my %to_remove = %current_members; delete @to_remove{keys %wanted_members};
my @to_remove=keys %to_remove;
while (my @these = splice @to_remove,0,100) {
warn "Removing @these from $list\n";
if ($WRITING) {
$tw->remove_list_members({
list_id => $current_lists_by_name{$list}{id},
screen_name => \@these,
});
}
}
my @to_add=keys %to_add;
while (my @these = splice @to_add,0,100) {
warn "Adding @these to $list\n";
if ($WRITING) {
$tw->add_list_members({
list_id => $current_lists_by_name{$list}{id},
screen_name => \@these,
});
}
}
}
}
# main program!
my $tw = get_twitter;
try {
my $lists_info;
my $friends_info;
# try loading from the cache
my $info = load_info();
if ($info) {
($lists_info,$friends_info) = $info->@{qw(lists friends)},
}
else {
# otherwise load from Twitter and save the cache
$lists_info = fetch_lists_info($tw);
$friends_info = fetch_friends_info($tw);
save_info($lists_info,$friends_info);
}
# something to parse?
if (@ARGV) {
# parse it
my $wanted_lists = parse_friends_lists_matrix($ARGV[0]);
# and update Twitter
make_it_so($tw,$lists_info,$wanted_lists);
}
else {
# no, just fetch and print
print_friends_lists_matrix($lists_info,$friends_info);
}
}
catch {
# error handling: is it a Twitter exception?
if ($_->$_isa('Net::Twitter::Error')) {
# print it out
p $_;
# have we reached the rate limit?
if ($_->code == 429 or (
$_->has_twitter_error and $_->twitter_error_code == 88)) {
# retrieve the limits and print them
my $limit = $tw->rate_limit_status;
p $limit;
}
}
# no, just re-throw
else { local $@=$_;die }
};