path: root/twitlist.pl

#!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<https://apps.twitter.com/>.
 
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<NOTE>: this script will not actually write to Twitter unles you set the C<TWITTER_WRITE> 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 }
};