Created

Embed URL

HTTPS clone URL

SSH clone URL

You can clone with HTTPS or SSH.

Download Gist

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.)

View xml2text.pl
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48
#!/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
Something went wrong with that request. Please try again.