Created
March 28, 2013 22:25
-
-
Save jesboat/5267337 to your computer and use it in GitHub Desktop.
Parse a libpurple buddy list XML file, and print in a simple one-per-line text format. Include whether the buddy lives on the same server as your account. (Assumes all buddies/accounts have user@domain style IDs, for example, XMPP.)
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
#!/usr/bin/perl | |
use strict; | |
use warnings; | |
use 5.012; | |
use XML::XPath; | |
my $xp = XML::XPath->new(filename => 'blist.xml'); | |
sub print_buddies { | |
my $ns_buddies = $xp->find('//buddy'); | |
for my $buddy ($ns_buddies->get_nodelist) { | |
my $acct = want_one('./@account', $buddy) | |
// die "No account on buddy '$buddy'\n"; | |
my $name = want_one('./name/child::node()', $buddy) | |
// die "No name on buddy '$buddy'\n"; | |
my $alias = want_one('./alias/child::node()', $buddy); | |
my $dom_us = domain($acct); | |
my $dom_them = domain($name); | |
printf "%s %s %s%s\n", | |
($dom_us eq $dom_them ? '+' : '-'), | |
$acct, $name, (defined $alias ? " $alias" : ""); | |
} | |
} | |
sub want_one { | |
my ($query, $ctx) = @_; | |
my $ns = $xp->find($query, $ctx); | |
if ($ns->size == 1) { | |
return $ns->pop->getData; | |
} elsif ($ns->size > 1) { | |
die "Query '$query' on '$ctx' returned > 1 node.\n"; | |
} else { | |
return undef; | |
} | |
} | |
sub domain { | |
my ($str) = @_; | |
if ($str =~ m{^ \S+ @ (\S+?) (/ \S*)? $}x) { | |
return $1; | |
} else { | |
die "Can't get domain from '$str'.\n"; | |
} | |
} | |
print_buddies(); |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment