mirror of
https://github.com/fhem/fhem-mirror.git
synced 2025-01-31 06:39:11 +00:00
- time and internet helper routines added to fhem.pl
- 57_Calendar.pm updated (got rid of Time::Local, verbose STATE, allow almost literal copy of Google ICAL URL) git-svn-id: https://svn.fhem.de/fhem/trunk@1625 2b470e98-0d58-463d-a4d8-8e2adae1ed80
This commit is contained in:
borisneubert
parent
ed0d76f444
commit
7d22c1ae61
@ -39,12 +39,12 @@
|
||||
new global attribute <backupcmd> added
|
||||
new global attribute <backup_before_update> added
|
||||
- feature: new module 57_Calendar.pm (Boris)
|
||||
- feature: new module 57_Calendar.pm (Boris)
|
||||
- feature: new parameter <changed> for updatefhem added (M. Fischer)
|
||||
new global attribute <exclude_from_update> added (M. Fischer)
|
||||
- feature: optional telnet password added / telnet port is optional
|
||||
- feature: holiday returns all matches, not only the first.
|
||||
- change: CULflash separated from updatefhem to a new module (M. Fischer)
|
||||
- feature: time and internet helper routines added to fhem.pl (Boris)
|
||||
|
||||
- 2011-12-31 (5.2)
|
||||
- bugfix: applying smallscreen attributes to firefox/opera
|
||||
|
||||
@ -8,10 +8,12 @@
|
||||
##############################################
|
||||
# $Id $
|
||||
|
||||
# Todos:
|
||||
# Support recurring events
|
||||
# update documentation (get MyCalendar full all, use URL-encoded URLs for Google Calendar
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
use Time::Local;
|
||||
|
||||
|
||||
##############################################
|
||||
@ -88,7 +90,7 @@ sub parseSub {
|
||||
last if($line =~ m/^END:.*$/);
|
||||
if($line =~ m/^BEGIN:(.*)$/) {
|
||||
my $entry= ICal::Entry->new($1);
|
||||
push $self->{entries}, $entry;
|
||||
push @{$self->{entries}}, $entry;
|
||||
$ln= $entry->parseSub($ln,@ical);
|
||||
} else {
|
||||
$self->addproperty($line);
|
||||
@ -159,7 +161,7 @@ sub setMode {
|
||||
my ($self,$mode)= @_;
|
||||
$self->{_previousMode}= $self->{_mode};
|
||||
$self->{_mode}= $mode;
|
||||
main::debug "After setMode $mode: Modes(" . $self->uid() . ") " . $self->{_previousMode} . " -> " . $self->{_mode};
|
||||
#main::debug "After setMode $mode: Modes(" . $self->uid() . ") " . $self->{_previousMode} . " -> " . $self->{_mode};
|
||||
return $mode;
|
||||
}
|
||||
|
||||
@ -231,14 +233,14 @@ sub modeChanged {
|
||||
# 20120520: a date string has no time zone associated
|
||||
sub tm {
|
||||
my ($t)= @_;
|
||||
#debug "convert $t";
|
||||
#main::debug "convert $t";
|
||||
my ($year,$month,$day)= (substr($t,0,4), substr($t,4,2),substr($t,6,2));
|
||||
if(length($t)>8) {
|
||||
my ($hour,$minute,$second)= (substr($t,9,2), substr($t,11,2),substr($t,13,2));
|
||||
return Time::Local::timegm($second,$minute,$hour,$day,$month-1,$year-1900);
|
||||
return main::fhemTimeGm($second,$minute,$hour,$day,$month-1,$year-1900);
|
||||
} else {
|
||||
#debug "$day $month $year";
|
||||
return Time::Local::timelocal(0,0,0,$day,$month-1,$year-1900);
|
||||
#main::debug "$day $month $year";
|
||||
return main::fhemTimeLocal(0,0,0,$day,$month-1,$year-1900);
|
||||
}
|
||||
}
|
||||
|
||||
@ -257,7 +259,7 @@ sub tm {
|
||||
sub d {
|
||||
my ($d)= @_;
|
||||
|
||||
main::debug "Duration $d";
|
||||
#main::debug "Duration $d";
|
||||
|
||||
my $sign= 1;
|
||||
my $t= 0;
|
||||
@ -266,6 +268,7 @@ sub d {
|
||||
$sign= -1 if($c[0] eq "-");
|
||||
shift @c if($c[0] =~ m/[\+\-]/);
|
||||
my ($dw,$dt)= split("T", $c[0]);
|
||||
$dt="" unless defined($dt);
|
||||
if($dw =~ m/(\d+)D$/) {
|
||||
$t+= 86400*$1; # days
|
||||
} elsif($dw =~ m/(\d+)W$/) {
|
||||
@ -281,7 +284,7 @@ sub d {
|
||||
|
||||
sub dt {
|
||||
my ($t0,$value,$parts)= @_;
|
||||
main::debug "t0= $t0 parts= $parts value= $value";
|
||||
#main::debug "t0= $t0 parts= $parts value= $value";
|
||||
if(defined($parts) && $parts =~ m/VALUE=DATE/) {
|
||||
return tm($value);
|
||||
} else {
|
||||
@ -416,12 +419,12 @@ sub new {
|
||||
|
||||
sub uids {
|
||||
my ($self)= @_;
|
||||
return keys $self->{events};
|
||||
return keys %{$self->{events}};
|
||||
}
|
||||
|
||||
sub events {
|
||||
my ($self)= @_;
|
||||
return values $self->{events};
|
||||
return values %{$self->{events}};
|
||||
}
|
||||
|
||||
sub event {
|
||||
@ -503,6 +506,7 @@ sub updateFromCalendar {
|
||||
package main;
|
||||
|
||||
|
||||
|
||||
#####################################
|
||||
sub Calendar_Initialize($) {
|
||||
|
||||
@ -556,7 +560,7 @@ sub Calendar_CheckTimes($) {
|
||||
my @endedevents= grep { $_->isEnded($t) } @allevents;
|
||||
|
||||
my $event;
|
||||
main::debug "Updating modes...";
|
||||
#main::debug "Updating modes...";
|
||||
foreach $event (@upcomingevents) { $event->setMode("upcoming"); }
|
||||
foreach $event (@alarmedevents) { $event->setMode("alarm"); }
|
||||
foreach $event (@startedevents) { $event->setMode("start"); }
|
||||
@ -595,16 +599,11 @@ sub Calendar_GetUpdate($) {
|
||||
|
||||
my $url= $hash->{fhem}{url};
|
||||
|
||||
# split into hostname and filename, TODO: enable https
|
||||
if($url =~ m,^http://(.+?)(/.+)$,) {
|
||||
# well-formed, host now in $1, filename now in $2
|
||||
#main::debug "Get $url";
|
||||
} else {
|
||||
Log 1, "Calendar " . $hash->{NAME} . ": $url is not a valid URL.";
|
||||
my $ics= GetFileFromURL($url);
|
||||
if(!defined($ics)) {
|
||||
Log 1, "Calendar " . $hash->{NAME} . ": Could not retrieve $url";
|
||||
return 0;
|
||||
}
|
||||
my $ics= GetHttpFile("$1:80",$2);
|
||||
return 0 if($ics eq "");
|
||||
|
||||
# we parse the calendar into a recursive ICal::Entry structure
|
||||
my $ical= ICal::Entry->new("root");
|
||||
@ -612,6 +611,15 @@ sub Calendar_GetUpdate($) {
|
||||
#main::debug "*** Result:\n";
|
||||
#main::debug $ical->asString();
|
||||
|
||||
my @entries= @{$ical->{entries}};
|
||||
if($#entries<0) {
|
||||
Log 1, "Calendar " . $hash->{NAME} . ": Not an ical file at $url";
|
||||
$hash->{STATE}= "Not an ical file at URL";
|
||||
return 0;
|
||||
} else {
|
||||
$hash->{STATE}= "Active";
|
||||
}
|
||||
|
||||
# we now create the events from it
|
||||
#main::debug "Creating events...";
|
||||
my $eventsObj= $hash->{fhem}{events};
|
||||
@ -706,7 +714,6 @@ sub Calendar_Get($@) {
|
||||
|
||||
}
|
||||
|
||||
|
||||
#####################################
|
||||
sub Calendar_Define($$) {
|
||||
|
||||
|
||||
@ -1405,13 +1405,16 @@ A line ending with \ will be concatenated with the next one, so long lines
|
||||
start with <code>http://</code>, not <code>https://</code>, and the file at the given URL
|
||||
must be in ICal format.<br><br>
|
||||
|
||||
Note for users of Google Calendar: You can literally use the private ICAL URL from your Google Calendar with the
|
||||
<code>https://</code> replaced by <code>http://</code>.<br><br>
|
||||
|
||||
The optional parameter <code>interval</code> is the time between subsequent updates
|
||||
in seconds. It defaults to 3600 (1 hour).<br><br>
|
||||
|
||||
Examples:
|
||||
<pre>
|
||||
define MyCalendar Calendar ical url http://www.google.com/calendar/ical/john.doe@example.com/private-foo4711/basic.ics
|
||||
define YourCalendar Calendar ical url http://www.google.com/calendar/ical/jane.doe@example.com/private-bar0815/basic.ics 86400
|
||||
define MyCalendar Calendar ical url http://www.google.com/calendar/ical/john.doe%40example.com/private-foo4711/basic.ics
|
||||
define YourCalendar Calendar ical url http://www.google.com/calendar/ical/jane.doe%40example.com/private-bar0815/basic.ics 86400
|
||||
</pre>
|
||||
</ul>
|
||||
<br>
|
||||
|
||||
132
fhem/fhem.pl
132
fhem/fhem.pl
@ -3005,7 +3005,55 @@ readingsUpdate($$$) {
|
||||
return $rv;
|
||||
}
|
||||
|
||||
##################
|
||||
###############################################################################
|
||||
#
|
||||
# date and time routines
|
||||
#
|
||||
##############################################################################
|
||||
|
||||
sub
|
||||
fhemTzOffset($) {
|
||||
# see http://stackoverflow.com/questions/2143528/whats-the-best-way-to-get-the-utc-offset-in-perl
|
||||
my $t = shift;
|
||||
my @l = localtime($t);
|
||||
my @g = gmtime($t);
|
||||
|
||||
# the offset is positive if the local timezone is ahead of GMT, e.g. we get 2*3600 seconds for CET DST vs GMT
|
||||
return 60*(($l[2] - $g[2] + ((($l[5]<<9)|$l[7]) <=> (($g[5]<<9)|$g[7])) * 24) * 60 + $l[1] - $g[1]);
|
||||
}
|
||||
|
||||
sub
|
||||
fhemTimeGm($$$$$$) {
|
||||
# see http://de.wikipedia.org/wiki/Unixzeit
|
||||
my ($sec,$min,$hour,$mday,$month,$year) = @_;
|
||||
|
||||
# $mday= 1..
|
||||
# $month= 0..11
|
||||
# $year is year-1900
|
||||
|
||||
$year+= 1900;
|
||||
my $isleapyear= $year % 4 ? 0 : $year % 100 ? 1 : $year % 400 ? 0 : 1;
|
||||
my $leapyears= int((($year-1)-1968)/4 - (($year-1)-1900)/100 + (($year-1)-1600)/400);
|
||||
#Debug sprintf("%02d.%02d.%04d %02d:%02d:%02d", $mday,$month+1,$year,$hour,$min,$sec);
|
||||
|
||||
if ( $^O eq 'MacOS' ) {
|
||||
$year-= 1904;
|
||||
} else {
|
||||
$year-= 1970; # the Unix Epoch
|
||||
}
|
||||
|
||||
my @d= (0,31,59,90,120,151,181,212,243,273,304,334); # no leap day
|
||||
# add one day in leap years if month is later than February
|
||||
$mday++ if($month>1 && $isleapyear);
|
||||
return $sec+60*($min+60*($hour+24*($d[$month]+$mday-1+365*$year+$leapyears)));
|
||||
}
|
||||
|
||||
sub
|
||||
fhemTimeLocal($$$$$$) {
|
||||
my $t= fhemTimeGm($_[0],$_[1],$_[2],$_[3],$_[4],$_[5]);
|
||||
return $t-fhemTzOffset($t);
|
||||
}
|
||||
|
||||
sub
|
||||
secSince2000()
|
||||
{
|
||||
@ -3013,9 +3061,87 @@ secSince2000()
|
||||
my $t = time();
|
||||
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($t);
|
||||
$t -= 946684800; # seconds between 01.01.2000, 00:00 and THE EPOCH (1970)
|
||||
$t -= 1*3600; # Timezone offset from UTC * 3600 (MEZ=1). FIXME/HARDCODED
|
||||
$t += 3600 if $isdst;
|
||||
$t -= fhemTzOffset($t);
|
||||
return $t;
|
||||
}
|
||||
|
||||
###############################################################################
|
||||
#
|
||||
# internet stuff
|
||||
#
|
||||
##############################################################################
|
||||
|
||||
sub
|
||||
urlEncode($) {
|
||||
$_= $_[0];
|
||||
s/([\x00-\x2F,\x3A-\x40,\x5B-\x60,\x7B-\xFF])/sprintf("%%%02x",ord($1))/eg;
|
||||
return $_;
|
||||
}
|
||||
|
||||
sub
|
||||
GetFileFromURL($@)
|
||||
{
|
||||
my ($url,$timeout)= @_;
|
||||
$timeout = 2.0 if(!defined($timeout));
|
||||
|
||||
if($url !~ /^(http):\/\/([^:\/]+)(:\d+)?(\/.*)$/) {
|
||||
Log 1, "GetFileFromURL $url: malformed URL";
|
||||
return undef;
|
||||
}
|
||||
|
||||
my ($protocol,$host,$port,$path)= ($1,$2,$3,$4);
|
||||
#Debug "Protocol $protocol, host $host port $port, path $path";
|
||||
|
||||
if(defined($port)) {
|
||||
$port=~ s/^://;
|
||||
} else {
|
||||
$port= 80;
|
||||
}
|
||||
$path= '/' unless defined($path);
|
||||
my $hostport= "$host:$port";
|
||||
|
||||
#Debug "Protocol $protocol, host:port $hostport, path $path";
|
||||
|
||||
|
||||
if($protocol ne "http") {
|
||||
Log 1, "GetFileFromURL $url: invalid protocol";
|
||||
return undef;
|
||||
}
|
||||
|
||||
my $conn = IO::Socket::INET->new(PeerAddr => "$hostport");
|
||||
if(!$conn) {
|
||||
Log 1, "GetFileFromURL $url: Can't connect to $hostport\n";
|
||||
undef $conn;
|
||||
return undef;
|
||||
}
|
||||
my $req = "GET $path HTTP/1.0\r\nHost: $hostport\r\n\r\n\r\n";
|
||||
syswrite $conn, $req;
|
||||
shutdown $conn, 1; # stopped writing data
|
||||
my ($buf, $ret) = ("", "");
|
||||
|
||||
$conn->timeout($timeout);
|
||||
for(;;) {
|
||||
my ($rout, $rin) = ('', '');
|
||||
vec($rin, $conn->fileno(), 1) = 1;
|
||||
my $nfound = select($rout=$rin, undef, undef, $timeout);
|
||||
if($nfound <= 0) {
|
||||
Log 1, "GetFileFromURL $url: Select timeout/error: $!";
|
||||
undef $conn;
|
||||
return undef;
|
||||
}
|
||||
|
||||
my $len = sysread($conn,$buf,65536);
|
||||
last if(!defined($len) || $len <= 0);
|
||||
$ret .= $buf;
|
||||
}
|
||||
|
||||
$ret=~ s/(.*?)\r\n\r\n//s; # Not greedy: switch off the header.
|
||||
Log 4, "GetFileFromURL $url: Got file, length: ".length($ret);
|
||||
undef $conn;
|
||||
return $ret;
|
||||
}
|
||||
|
||||
|
||||
##############################################################################
|
||||
|
||||
1;
|
||||
|
||||
Loading…
Reference in New Issue
Block a user