Der nachfolgende Code schreibt das in eine Datei presets.xml für Bose-Boxen um. Kann leicht angepasst werden für andere Zwecke.
#!/usr/bin/env perl
use strict;
use warnings;
use utf8;
use Getopt::Long qw(GetOptions);
use LWP::UserAgent;
use URI;
use XML::LibXML;
use XML::Writer;
use IO::File;
# ---------------- CLI ----------------
my $location = undef; # Pflicht, z.B. http://192.168.0.254:49000/MediaServerDevDesc.xml
my $out_file = "presets.xml";
my $start_id = 1;
my $max_presets = 99;
my $timeout_s = 12;
my $debug = 0;
GetOptions(
"location=s" => \$location,
"out=s" => \$out_file,
"start=i" => \$start_id,
"max=i" => \$max_presets,
"timeout=i" => \$timeout_s,
"debug!" => \$debug,
) or die "Usage: $0 --location <URL> [--out presets.xml] [--start 1] [--max 99] [--timeout 12] [--debug]\n";
die "Fehlt: --location (z.B. http://192.168.0.254:49000/MediaServerDevDesc.xml)\n"
if !$location;
# ---------------- Helpers ----------------
sub norm { my $s = shift // ""; $s =~ s/^\s+|\s+$//g; return $s; }
sub lc_norm { return lc(norm(shift)); }
# ---------------- HTTP Client ----------------
my $ua = LWP::UserAgent->new(
agent => "fritz-favs-to-presets/1.0",
timeout => $timeout_s,
);
$ua->env_proxy;
# ---------------- 1) Device Description holen ----------------
my $desc_res = $ua->get($location);
die "GET DeviceDesc fehlgeschlagen: " . $desc_res->status_line . "\n"
if !$desc_res->is_success;
my $desc_xml = $desc_res->decoded_content;
my $desc_doc = XML::LibXML->load_xml(string => $desc_xml);
# Base-URL für relative controlURL
my $loc_uri = URI->new($location);
my $base = $loc_uri->scheme . "://" . $loc_uri->host_port;
# UDN (ohne uuid:)
my ($udn_node) = $desc_doc->findnodes('//*[local-name()="UDN"]');
my $udn = $udn_node ? norm($udn_node->textContent) : "";
$udn =~ s/^uuid://i;
die "Konnte UDN nicht aus DeviceDesc lesen.\n" if !$udn;
# ContentDirectory Service finden -> controlURL
my ($cd_service) = $desc_doc->findnodes(
'//*[local-name()="service"]/*[local-name()="serviceType" and contains(., "ContentDirectory:1")]/..'
);
die "Kein ContentDirectory:1 Service in DeviceDesc gefunden.\n" if !$cd_service;
my ($control_node) = $cd_service->findnodes('./*[local-name()="controlURL"]');
die "Kein controlURL im ContentDirectory Service.\n" if !$control_node;
my $control_url = norm($control_node->textContent);
$control_url = $base . $control_url if $control_url =~ m{^/};
print "Using FRITZ!Box ContentDirectory controlURL: $control_url\n" if $debug;
print "sourceAccount: $udn/0\n" if $debug;
# ---------------- 2) SOAP Browse ----------------
sub soap_browse {
my (%p) = @_;
my $object_id = $p{ObjectID} // "0";
my $flag = $p{BrowseFlag} // "BrowseDirectChildren";
my $body =
qq{<?xml version="1.0" encoding="utf-8"?>\n}
. qq{<s:Envelope xmlns:s="http://schemas.xmlsoap.org/soap/envelope/" s:encodingStyle="http://schemas.xmlsoap.org/soap/encoding/">\n}
. qq{ <s:Body>\n}
. qq{ <u:Browse xmlns:u="urn:schemas-upnp-org:service:ContentDirectory:1">\n}
. qq{ <ObjectID>$object_id</ObjectID>\n}
. qq{ <BrowseFlag>$flag</BrowseFlag>\n}
. qq{ <Filter>*</Filter>\n}
. qq{ <StartingIndex>0</StartingIndex>\n}
. qq{ <RequestedCount>0</RequestedCount>\n}
. qq{ <SortCriteria></SortCriteria>\n}
. qq{ </u:Browse>\n}
. qq{ </s:Body>\n}
. qq{</s:Envelope>\n};
my $req = HTTP::Request->new(POST => $control_url);
$req->header('Content-Type' => 'text/xml; charset="utf-8"');
$req->header('SOAPACTION' => '"urn:schemas-upnp-org:service:ContentDirectory:1#Browse"');
$req->content($body);
my $res = $ua->request($req);
if (!$res->is_success) {
die "SOAP Browse fehlgeschlagen (ObjectID=$object_id): " . $res->status_line . "\n"
. $res->decoded_content . "\n";
}
my $soap = XML::LibXML->load_xml(string => $res->decoded_content);
# <Result> enthält DIDL-Lite als escaped XML
my ($result_node) = $soap->findnodes('//*[local-name()="Result"]');
my $result = $result_node ? $result_node->textContent : "";
$result = norm($result);
return $result;
}
# ---------------- 3) DIDL-Lite parsen ----------------
sub parse_didl {
my ($didl_str) = @_;
return ([], []) if !$didl_str;
my $didl_doc = XML::LibXML->load_xml(string => $didl_str);
my @containers;
for my $c ($didl_doc->findnodes('//*[local-name()="container"]')) {
my $id = $c->getAttribute("id") // "";
my ($t) = $c->findnodes('./*[local-name()="title"]');
my $title = $t ? norm($t->textContent) : "";
push @containers, { id => norm($id), title => $title };
}
my @items;
for my $it ($didl_doc->findnodes('//*[local-name()="item"]')) {
my $id = $it->getAttribute("id") // "";
my ($t) = $it->findnodes('./*[local-name()="title"]');
my $title = $t ? norm($t->textContent) : "";
my ($art) = $it->findnodes('.//*[local-name()="albumArtURI"]');
my $albumart = $art ? norm($art->textContent) : "";
push @items, { id => norm($id), title => $title, art => $albumart };
}
return (\@containers, \@items);
}
# ---------------- 4) Debug: Container/Items auflisten ----------------
sub dump_children_one_level {
my ($parent_id, $limit_items) = @_;
$limit_items //= 15;
my $didl = soap_browse(ObjectID => $parent_id, BrowseFlag => "BrowseDirectChildren");
my ($containers, $items) = parse_didl($didl);
print "\n== Children of $parent_id ==\n";
print "Containers: " . scalar(@$containers) . "\n";
for my $c (@$containers) {
printf " [C] %-45s id=%s\n", ($c->{title} // ""), ($c->{id} // "");
}
print "Items: " . scalar(@$items) . "\n";
my $max = @$items < $limit_items ? @$items : $limit_items;
for (my $i=0; $i<$max; $i++) {
my $it = $items->[$i];
printf " [I] %-45s id=%s\n", ($it->{title} // ""), ($it->{id} // "");
}
}
# ---------------- 5) BFS: Container per Titel finden ----------------
sub find_container_bfs {
my (%p) = @_;
my $root = $p{root} // "0";
my $want_re = $p{want_re}; # regex auf lowercased title
my $max_nodes = $p{max_nodes} // 12000;
my @q = ($root);
my %seen;
my $visited = 0;
while (@q) {
my $cur = shift @q;
next if $seen{$cur}++;
last if ++$visited > $max_nodes;
my $didl = soap_browse(ObjectID => $cur, BrowseFlag => "BrowseDirectChildren");
my ($containers, undef) = parse_didl($didl);
for my $c (@$containers) {
my $t = lc_norm($c->{title});
return $c->{id} if defined($want_re) && $t =~ $want_re;
push @q, $c->{id};
}
}
return undef;
}
# ---------------- 6) Fallback: "beste Senderliste" finden ----------------
# Heuristik: Container mit vielen Items und wenigen Subcontainern
sub find_best_station_list_container {
my (%p) = @_;
my $root = $p{root} // "0";
my $max_nodes = $p{max_nodes} // 20000;
my @q = ($root);
my %seen;
my $visited = 0;
my $best_id = undef;
my $best_score = -1;
my $best_items = 0;
my $best_conts = 0;
while (@q) {
my $cur = shift @q;
next if $seen{$cur}++;
last if ++$visited > $max_nodes;
my $didl = soap_browse(ObjectID => $cur, BrowseFlag => "BrowseDirectChildren");
my ($containers, $items) = parse_didl($didl);
my $num_items = scalar(@$items);
my $num_conts = scalar(@$containers);
# Favoritenlisten sind oft: viele Items, wenig Untercontainer
my $score = $num_items * 10 - $num_conts;
if ($num_items > 0 && $score > $best_score) {
$best_score = $score;
$best_id = $cur;
$best_items = $num_items;
$best_conts = $num_conts;
}
# weiter runter
for my $c (@$containers) {
push @q, $c->{id};
}
}
print "Fallback best container: $best_id (items=$best_items containers=$best_conts score=$best_score)\n"
if $debug && defined $best_id;
return $best_id;
}
# ---------------- 7) MAIN: Radio -> Favoriten -> Items ----------------
# 7.1: Radio/Internetradio Container finden (global)
my $radio_id = find_container_bfs(
root => "0",
want_re => qr/(internet\s*radio|internetradio|radio)/,
max_nodes => 20000
) or die "Konnte keinen Container 'Internetradio/Radio' finden.\n";
print "Radio container found: $radio_id\n" if $debug;
dump_children_one_level($radio_id) if $debug;
# 7.2: Favoriten darunter finden (per Titel), sonst Fallback (beste Liste)
my $fav_id = find_container_bfs(
root => $radio_id,
want_re => qr/(favorit|favorite|lieblings|favourites)/,
max_nodes => 20000
);
if (!$fav_id) {
print "Kein Favoriten-Container per Titel gefunden – nutze Fallback (Container mit den meisten Sender-Items)...\n"
if $debug;
$fav_id = find_best_station_list_container(root => $radio_id, max_nodes => 30000);
}
die "Konnte keine Senderliste unterhalb von '$radio_id' finden.\n" if !$fav_id;
print "Station list container: $fav_id\n" if $debug;
dump_children_one_level($fav_id) if $debug;
# 7.3: Items (Sender) direkt aus Favoritencontainer lesen
my $fav_didl = soap_browse(ObjectID => $fav_id, BrowseFlag => "BrowseDirectChildren");
my (undef, $items) = parse_didl($fav_didl);
die "Keine Sender-Items im Container ($fav_id) gefunden.\n" if !@$items;
# ---------------- 8) presets.xml schreiben ----------------
my $fh = IO::File->new(">$out_file") or die "Kann $out_file nicht schreiben: $!\n";
binmode($fh, ":utf8");
my $w = XML::Writer->new(OUTPUT => $fh, DATA_MODE => 1, DATA_INDENT => 2, ENCODING => "UTF-8");
my $now = time();
$w->xmlDecl("UTF-8");
$w->startTag("presets");
my $pid = int($start_id);
my $count = 0;
for my $st (@$items) {
last if $count >= $max_presets;
my $name = $st->{title} || "Unbenannt";
my $oid = $st->{id};
next if !$oid;
$w->startTag("preset", id => $pid, createdOn => $now, updatedOn => $now);
$w->startTag("ContentItem",
source => "STORED_MUSIC",
location => $oid,
sourceAccount => $udn . "/0",
isPresetable => "true",
);
$w->dataElement("itemName", $name);
$w->dataElement("containerArt", $st->{art}) if $st->{art};
$w->endTag("ContentItem");
$w->endTag("preset");
$pid++;
$count++;
}
$w->endTag("presets");
$w->end();
$fh->close();
print "OK: $count Sender nach $out_file geschrieben.\n";
exit 0;
Ich habe den Code jetzt noch einmal geändert. Für jeden auf der FB gefundenen Stream wird abgefragt, welche Kanalnummer auf einer Bose-Box man haben möchte (1..20). Wenn diese 1..6 beträgt, wird eine xml-Datei für das Senden an die Box erstellt, wenn diese >6 ist, wird eine Attributdefinition für das BOSEST-Modul geschrieben.
#!/usr/bin/env perl
use strict;
use warnings;
use utf8;
use open ':std', ':encoding(UTF-8)';
use Getopt::Long qw(GetOptions);
use LWP::UserAgent;
use HTTP::Request::Common qw(POST GET);
use URI;
use XML::LibXML;
# ------------------------------------------------------------
# CLI options
# ------------------------------------------------------------
my $desc_url = '';
my $host = '';
my $port = 49000;
my $timeout = 10;
my $maxdepth = 50;
my $debug = 0;
GetOptions(
'desc=s' => \$desc_url, # full URL to MediaServerDevDesc.xml
'host=s' => \$host, # host/IP of fritzbox
'port=i' => \$port,
'timeout=i' => \$timeout,
'maxdepth=i' => \$maxdepth,
'debug!' => \$debug,
) or die usage();
if (!$desc_url) {
$host or die usage();
$desc_url = "http://$host:$port/MediaServerDevDesc.xml";
}
my $ua = LWP::UserAgent->new(
timeout => $timeout,
agent => "fritz_interactive_channels_and_presets/1.0",
);
# ------------------------------------------------------------
# Discover ContentDirectory + UDN
# ------------------------------------------------------------
my ($base_url, $control_url, $service_type, $udn) = get_contentdirectory_control_and_udn($ua, $desc_url);
my $source_account = normalize_udn($udn) . "/0";
print "Device description: $desc_url\n" if $debug;
print "Base URL: $base_url\n" if $debug;
print "Control URL: $control_url\n"if $debug;
print "ServiceType: $service_type\n"if $debug;
print "UDN raw: $udn\n" if $debug;
print "sourceAccount: $source_account\n" if $debug;
# ------------------------------------------------------------
# Ask FHEM device name (needed for boseattr.txt output)
# ------------------------------------------------------------
print "\nFHEM Device-Name für boseattr.txt (z.B. WohnzimmerBose): ";
chomp(my $fhem_dev = <STDIN>);
$fhem_dev ||= "BoseDevice";
# Output files
my $file_presets = "payload_storepreset.xml";
my $file_attrs = "boseattr.txt";
open my $fh_preset, ">:encoding(UTF-8)", $file_presets
or die "Cannot write $file_presets: $!\n";
open my $fh_attr, ">:encoding(UTF-8)", $file_attrs
or die "Cannot write $file_attrs: $!\n";
print "\nSchreibe Preset-Payload nach: $file_presets\n";
print "Schreibe FHEM attrs nach: $file_attrs\n";
print "\nEingabe pro Item: 1..6 = Preset-ID, >=10 = channel_xx, n = skip, q = quit\n\n";
# Keep track of assigned presets 1..6
my %preset_used;
my %seen_containers;
my $quit = 0;
interactive_crawl(
ua => $ua,
base_url => $base_url,
control_url => $control_url,
service_type => $service_type,
container_id => '0',
depth => 0,
maxdepth => $maxdepth,
seen => \%seen_containers,
debug => $debug,
quit_ref => \$quit,
fh_preset => $fh_preset,
fh_attr => $fh_attr,
fhem_dev => $fhem_dev,
source_account=> $source_account,
preset_used => \%preset_used,
);
close $fh_preset;
close $fh_attr;
print "\nFertig.\n";
print " - $file_presets (Preset-Payload, max 6 Einträge)\n";
print " - $file_attrs (FHEM attr Zeilen)\n";
exit 0;
# ============================================================
# Helpers
# ============================================================
sub usage {
return <<"TXT";
Usage:
$0 --host <ip|fritz.box> [--port 49000] [--timeout 10] [--maxdepth 50] [--debug]
$0 --desc <url_to_MediaServerDevDesc.xml> [--timeout 10] [--maxdepth 50] [--debug]
Example:
$0 --host 192.168.0.254 --debug
TXT
}
sub normalize_udn {
my ($udn) = @_;
$udn //= '';
$udn =~ s/^\s+|\s+$//g;
$udn =~ s/^uuid://i; # deine Bose/FHEM Beispiele sind ohne "uuid:"
return $udn || 'UNKNOWN';
}
sub get_contentdirectory_control_and_udn {
my ($ua, $desc_url) = @_;
my $res = $ua->request(GET($desc_url));
die "GET $desc_url failed: " . $res->status_line . "\n" if !$res->is_success;
my $xml = XML::LibXML->load_xml(string => $res->decoded_content);
my $root = $xml->documentElement();
my $u = URI->new($desc_url);
my $base_url = $u->scheme . "://" . $u->host;
$base_url .= ":" . $u->port if defined $u->port;
my $udn = '';
my ($udn_node) = $root->findnodes('//*[local-name()="UDN"]/text()');
if ($udn_node) {
$udn = $udn_node->data;
$udn =~ s/^\s+|\s+$//g;
}
$udn ||= 'uuid:UNKNOWN';
my ($service_type, $control_url);
for my $svc ($root->findnodes('//*[local-name()="serviceList"]/*[local-name()="service"]')) {
my ($st) = $svc->findnodes('./*[local-name()="serviceType"]/text()');
next if !$st;
my $stval = $st->data;
next if $stval !~ /ContentDirectory/i;
my ($cu) = $svc->findnodes('./*[local-name()="controlURL"]/text()');
$control_url = $cu ? $cu->data : undef;
$service_type = $stval;
last;
}
die "No ContentDirectory service in description.\n" if !$control_url || !$service_type;
my $control_abs = URI->new_abs($control_url, $base_url)->as_string;
return ($base_url, $control_abs, $service_type, $udn);
}
sub interactive_crawl {
my %a = @_;
my $ua = $a{ua};
my $base_url = $a{base_url};
my $control_url = $a{control_url};
my $service_type = $a{service_type};
my $container_id = $a{container_id}; # << current container (this is what we need for location)
my $depth = $a{depth};
my $maxdepth = $a{maxdepth};
my $seen = $a{seen};
my $dbg = $a{debug};
my $quit_ref = $a{quit_ref};
return if $$quit_ref;
return if $depth > $maxdepth;
return if $seen->{$container_id}++;
print "Browse container id=$container_id depth=$depth\n" if $dbg;
my $start = 0;
my $count = 200;
while (1) {
return if $$quit_ref;
my $r = soap_browse(
ua => $ua,
control_url => $control_url,
service_type => $service_type,
object_id => $container_id,
starting => $start,
requested => $count,
);
my $entries = parse_didl($r->{Result}, $base_url);
my $returned = $r->{NumberReturned} // 0;
my $total = $r->{TotalMatches} // 0;
for my $e (@$entries) {
return if $$quit_ref;
if ($e->{type} eq 'container') {
interactive_crawl(
%a,
container_id => $e->{id},
depth => $depth + 1,
);
}
elsif ($e->{type} eq 'item') {
# Show metadata and ask for channel number
show_item_with_container($e, $container_id);
my $ans = ask_channel();
if ($ans eq 'n') {
print "-> übersprungen.\n\n";
next;
}
if ($ans eq 'q') {
$$quit_ref = 1;
print "-> beendet.\n\n";
return;
}
# numeric channel
my $x = int($ans);
if ($x >= 1 && $x <= 6) {
# Preset: MUST use container location starting with "4"
if ($container_id !~ /^4:/) {
print "!! Abgelehnt: Für Preset 1..6 muss location ein Container sein, der mit '4:' beginnt.\n";
print " Aktueller Container: $container_id\n\n";
next;
}
if ($a{preset_used}{$x}) {
print "!! Abgelehnt: Preset-ID $x ist schon vergeben. (Nur 1..6, keine Duplikate)\n\n";
next;
}
my $epoch = time();
my $title = $e->{title} // '';
my $logo = $e->{logo} // '';
print {$a{fh_preset}} build_preset_xml(
preset_id => $x,
epoch => $epoch,
location => $container_id, # << EXACTLY container id
source_account => $a{source_account},
item_name => $title,
container_art => $logo,
);
$a{preset_used}{$x} = 1;
print "-> Preset $x geschrieben.\n\n";
next;
}
if ($x >= 10) {
# FHEM attr: channel_xx
my $title = $e->{title} // '';
$title =~ s/\r|\n/ /g;
my $logo = $e->{logo} // ''; # can be empty
my $val = join('|',
'', # we will inject " Stream" after title, and keep "||" structure below
);
# EXACT requested format:
# attr <device> channel_{x} 80er Hits Stream||4:cont2:...|STORED_MUSIC|<sourceAccount>
my $line = "attr $a{fhem_dev} channel_$x $title Stream||$container_id|STORED_MUSIC|$a{source_account}\n";
print {$a{fh_attr}} $line;
print "-> channel_$x geschrieben.\n\n";
next;
}
# any other numeric
print "!! Hinweis: Erlaubt sind Preset 1..6 oder channel >= 10. Eingabe '$x' wird ignoriert.\n\n";
}
}
last if $returned <= 0;
$start += $returned;
last if $start >= $total;
}
}
sub ask_channel {
while (1) {
print "Kanalnr (1..6 Preset, >=10 channel_xx) oder n/q: ";
chomp(my $ans = <STDIN>);
$ans = lc($ans // '');
$ans =~ s/^\s+|\s+$//g;
return 'n' if $ans eq 'n';
return 'q' if $ans eq 'q';
if ($ans =~ /^\d+$/) {
return $ans;
}
print "Ungültig. Bitte Zahl, n oder q.\n";
}
}
sub show_item_with_container {
my ($e, $container_id) = @_;
my $title = $e->{title} // '';
my $id = $e->{id} // '';
my $class = $e->{class} // '';
my $res = $e->{res} // '';
my $logo = $e->{logo} // '';
print "----------------------------------------\n";
print "Title: $title\n";
print "Item ID: $id\n" if $id ne '';
print "Class: $class\n" if $class ne '';
print "res: $res\n" if $res ne '';
print "Logo: $logo\n" if $logo ne '';
print "Container: $container_id\n";
print "----------------------------------------\n";
}
sub xml_escape {
my ($s) = @_;
$s //= '';
$s =~ s/&/&/g;
$s =~ s/</</g;
$s =~ s/>/>/g;
$s =~ s/"/"/g;
$s =~ s/'/'/g;
return $s;
}
sub build_preset_xml {
my %p = @_;
my $pid = $p{preset_id};
my $epoch = $p{epoch};
my $loc = $p{location};
my $sa = $p{source_account};
my $name = $p{item_name} // '';
my $art = $p{container_art} // '';
$name = xml_escape($name);
$loc = xml_escape($loc);
$sa = xml_escape($sa);
my $xml = qq{<preset id="$pid" createdOn="$epoch" updatedOn="$epoch">\n}
. qq{ <ContentItem source="STORED_MUSIC" location="$loc"\n}
. qq{ sourceAccount="$sa" isPresetable="true">\n}
. qq{ <itemName>$name</itemName>\n};
if ($art ne '') {
$art = xml_escape($art);
$xml .= qq{ <containerArt>\n$art\n </containerArt>\n};
}
$xml .= qq{ </ContentItem>\n}
. qq{</preset>\n};
return $xml;
}
sub soap_browse {
my %a = @_;
my $ua = $a{ua};
my $control_url = $a{control_url};
my $service_type = $a{service_type};
my $object_id = $a{object_id};
my $starting = $a{starting} // 0;
my $requested = $a{requested} // 200;
my $soap = qq{<?xml version="1.0" encoding="utf-8"?>
<s:Envelope xmlns:s="http://schemas.xmlsoap.org/soap/envelope/" s:encodingStyle="http://schemas.xmlsoap.org/soap/encoding/">
<s:Body>
<u:Browse xmlns:u="$service_type">
<ObjectID>$object_id</ObjectID>
<BrowseFlag>BrowseDirectChildren</BrowseFlag>
<Filter>*</Filter>
<StartingIndex>$starting</StartingIndex>
<RequestedCount>$requested</RequestedCount>
<SortCriteria></SortCriteria>
</u:Browse>
</s:Body>
</s:Envelope>};
my $req = POST($control_url,
Content_Type => 'text/xml; charset="utf-8"',
Content => $soap,
);
$req->header('SOAPACTION' => qq{"$service_type#Browse"});
my $res = $ua->request($req);
die "SOAP Browse failed ($control_url): " . $res->status_line . "\n" if !$res->is_success;
my $xml = XML::LibXML->load_xml(string => $res->decoded_content);
my ($result) = $xml->findnodes('//*[local-name()="BrowseResponse"]/*[local-name()="Result"]/text()');
my ($nr) = $xml->findnodes('//*[local-name()="BrowseResponse"]/*[local-name()="NumberReturned"]/text()');
my ($tm) = $xml->findnodes('//*[local-name()="BrowseResponse"]/*[local-name()="TotalMatches"]/text()');
return {
Result => $result ? $result->data : '',
NumberReturned => $nr ? int($nr->data) : 0,
TotalMatches => $tm ? int($tm->data) : 0,
};
}
sub parse_didl {
my ($didl_escaped, $base_url) = @_;
return [] if !$didl_escaped;
my $didl = $didl_escaped;
# Sometimes escaped inside SOAP Result
if ($didl =~ /<DIDL-Lite/i) {
$didl =~ s/</</g;
$didl =~ s/>/>/g;
$didl =~ s/"/"/g;
$didl =~ s/&/&/g;
}
my $doc;
eval { $doc = XML::LibXML->load_xml(string => $didl); 1 } or return [];
my @out;
for my $c ($doc->findnodes('//*[local-name()="container"]')) {
my $id = $c->getAttribute('id') // '';
push @out, { type => 'container', id => $id };
}
for my $i ($doc->findnodes('//*[local-name()="item"]')) {
my $id = $i->getAttribute('id') // '';
my ($title) = $i->findnodes('./*[local-name()="title"]/text()');
my ($class) = $i->findnodes('./*[local-name()="class"]/text()');
my ($res) = $i->findnodes('./*[local-name()="res"]/text()');
my $logo = '';
my ($art) = $i->findnodes('.//*[local-name()="albumArtURI"]/text()');
if ($art) {
$logo = $art->data;
$logo =~ s/^\s+|\s+$//g;
if ($logo && $logo !~ m{^https?://}i) {
$logo = URI->new_abs($logo, $base_url)->as_string;
}
}
push @out, {
type => 'item',
id => $id,
title => $title ? $title->data : '',
class => $class ? $class->data : '',
res => $res ? $res->data : '',
logo => $logo,
};
}
return \@out;
}