#!/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