jesboat / xml2text.pl

Created March 28, 2013


    
    View xml2text.pl 
  
  
      xml2text.pl
    
    
        Raw
      
    
    File suppressed. Click to show.
  
  
            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();