use strict;
use warnings;
use DateTime;
use DateTime::Duration;
my $stunden_input = 20000; # Beispiel: 20.000 Stunden
# Erstelle ein Dauer-Objekt aus Stunden
my $dur = DateTime::Duration->new( hours => $stunden_input );
# Umrechnung in Einheiten (normalized)
my ( $y, $m, $d, $h ) = $dur->in_units( 'years', 'months', 'days', 'hours' );
print "$stunden_input Stunden sind: $y Jahre, $m Monate, $d Tage und $h Stunden.\n";
# Ausgabe: 20000 Stunden sind: 2 Jahre, 3 Monate, 3 Tage und 8 Stunden.
<li data-row="2" data-col="1" data-sizey="1" data-sizex="2">
<header>Nachtlicht</header>
<div class="sheet">
<div class="row">
<div class="cell">
<div data-type="dimmer" data-device="deCONZ_HUEDevice2" data-get="onoff" data-get-on="1" data-get-off="0" data-set="" data-set-on="on" data-set-off="off" data-dim="pct" data-min="4" data-timeout="300" class = "large" data-hide="state" data-hide-off="!unreachable" data-hide-on="unreachable"></div>
<div data-type="label"></div>
</div>
<div class="cell">
<div data-type="slider" data-device="deCONZ_HUEDevice2"
data-tickstep="1"
data-get="ctclean"
data-set="ct"
data-min="250"
data-max="454"
data-lock="deCONZ_HUEDevice2:onoff"
data-lock-on="0"
data-lock-off="!0"
data-background-color='#F19A47'
data-color='#B2CAD4'
class="horizontal"
data-hide="state" data-hide-off="!unreachable" data-hide-on="unreachable"
></div>
</div>
</div>
</div>
</li>
).#!/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;
}Zitat von: Ralli am 23 Februar 2026, 14:47:57Oder/und tatsächlich über Nacht ohne Wallbox einfach an der Haushaltssteckdose laden. Damit hast du gar keinen Investitionsaufwand.
ZitatForum-Software
Regeln, Diskussionen, Fragen zu diesem FHEM-Forum selbst. Hier keine Themen zur Hausautomation!
Zitat von: betateilchen am 23 Februar 2026, 14:34:19Ok, das mit der "einseitigen" Belastung habe ich verstanden.
Das bedeutet aber im Umkehrschluß, dass selbst bei einer 22kW Wallbox und einphasigem Laden keine 7,4kW rauskommen, denn das wäre ja auch wieder "einseitig".
ZitatEine Herdanschlussdose mit mehr als 5x2,5qmm Zuleitung ist mir in Privatwohnungen noch nicht untergekommen. Und die sind dann meist auch "nur" mit je 16A abgesichert. Der größere Querschnitt dürfte vermutlich nur der Dauerbelastung geschuldet sein.
ZitatDa bleibt mir wohl als Option nur, auch weiterhin die Schnellladesäule von EnBW hier im Ort zu nutzen.