- #!/usr/bin/perl
- use v5.36;
- use utf8;
- use open qw(:std :encoding(UTF-8));
- use Feature::Compat::Try;
- use FindBin qw($Bin);
- use lib "$Bin/../lib";
- use Getopt::Complete (
- 'quiet!' => undef,
- 'verbose!' => undef,
- 'debug!' => undef,
- 'trace!' => undef,
- 'output' => undef,
- 'skeldir' => 'directories',
- 'username' => undef,
- 'password' => undef,
- 'locale' => undef,
- 'timezone' => undef,
- '<>' => undef,
- );
- use IO::Interactive::Tiny;
- use Log::Any qw($log);
- use Log::Any::Adapter;
- use URI;
- use DateTime;
- use Path::Tiny;
- use Text::Xslate;
- use POSIX qw(locale_h); # resolve LC_TIME
- use locale;
- use DateTime::TimeZone;
- use Object::Groupware::DAV;
- use Object::Groupware::Calendar;
- # collect settings from command-line options and defaults
- my $SKELDIR = $ARGS{skeldir} || $ENV{SKELDIR} || "$Bin/../templates";
- my $BASE_URI = $ARGS{'<>'}[0] || $ENV{CAL_DAV_URL_BASE};
- my $CALENDAR_URI = $ARGS{'<>'}[1] || $ENV{CAL_DAV_URL_CALENDAR};
- my $USERNAME = $ARGS{username} || $ENV{CAL_DAV_USER};
- my $PASSWORD = $ARGS{password} || $ENV{CAL_DAV_PASS};
- my $LOCALE = $ARGS{locale} || $ENV{CAL_LANG};
- my $TIME_ZONE = $ARGS{timezone};
- my $OUTPUT_FILE = $ARGS{output};
- # init logging
- my $LOGLEVEL = 'warning';
- $LOGLEVEL = 'critical' if $ARGS{quiet};
- $LOGLEVEL = 'warning' if defined $ARGS{verbose} and !$ARGS{verbose};
- $LOGLEVEL = 'info' if $ARGS{verbose};
- $LOGLEVEL = 'debug' if $ARGS{debug};
- $LOGLEVEL = 'trace' if $ARGS{trace};
- if ( IO::Interactive::Tiny::is_interactive() ) {
- Log::Any::Adapter->set( 'Screen', default_level => $LOGLEVEL );
- }
- else {
- use Log::Any::Adapter ( 'Stderr', default_level => $LOGLEVEL );
- }
- # extend DateTime locale with form LONGER
- # * omit year and second
- # * unabbreviate weekday and month
- # * interpose time preposition in combined date and time, where known
- my %at = (
- C => " 'at' ",
- ar => " 'في' ",
- da => " 'kl.' ",
- de => " 'um' ",
- en => " 'at' ",
- es => " 'a las' ",
- fr => " 'à' ",
- he => " 'בשעה' ",
- it => " 'alle' ",
- ja => "'に'",
- no => " 'kl.' ",
- ru => " 'в' ",
- zh => "'在'",
- );
- my $dt_locale = DateTime::Locale->load( $LOCALE || setlocale(LC_TIME) );
- my ( $locale, $lang ) = $dt_locale->code =~ /^((\w+)(?:-\w+)?)/;
- my $dt = DateTime->now( locale => $dt_locale );
- my %dt_locale_data = $dt_locale->locale_data;
- $dt_locale_data{code} = "${locale}-LONGER";
- $dt_locale_data{name} .= ' nouns unabbreviated';
- $dt_locale_data{date_format_medium} = $dt->locale->format_for('MMMMEd');
- $dt_locale_data{date_format_medium} ||= $dt->locale->format_for('MMMEd');
- $dt_locale_data{date_format_medium} =~ s/\bMMM\b/MMMM/;
- $dt_locale_data{date_format_medium} =~ s/\bMMM\b/MMMM/;
- $dt_locale_data{date_format_medium} =~ s/\bE\b/EEEE/;
- $dt_locale_data{time_format_medium} = $dt->locale->format_for('Hm');
- $dt_locale_data{datetime_format_medium}
- =~ s/^\{1\}\K,? (?=\{0\}$)/$at{$lang}/
- if $at{$lang};
- # init groupware settings
- my %GROUPWARE_OPTIONS = (
- dt_locale => DateTime::Locale::FromData->new( \%dt_locale_data ),
- dt_time_zone => DateTime::TimeZone->new(
- name => ( $ARGS{timezone} || 'local' ),
- ),
- );
- $log->infof(
- 'Will use locale %s and time zone %s',
- $GROUPWARE_OPTIONS{dt_locale}->code,
- $GROUPWARE_OPTIONS{dt_time_zone}->name,
- );
- # init calendar URIs
- $BASE_URI = URI->new($BASE_URI)
- or $log->fatal('failed to parse required base URI') && exit 2;
- $BASE_URI->scheme
- or $BASE_URI->scheme('file');
- # get calendar
- my $calendar;
- if ( $BASE_URI->scheme eq 'http' or $BASE_URI->scheme eq 'https' ) {
- $log->infof( 'will use base URI %s', $BASE_URI );
- $CALENDAR_URI = URI->new( $CALENDAR_URI || $BASE_URI );
- $CALENDAR_URI and $CALENDAR_URI->authority
- or $log->fatal('bad calendar URI: must be an internet URI') && exit 2;
- $BASE_URI->eq($CALENDAR_URI) and $CALENDAR_URI = undef
- or $log->infof( 'will use calendar URI %s', $CALENDAR_URI );
- my $session = Object::Groupware::DAV->new(
- user => $USERNAME,
- pass => $PASSWORD,
- uri => $BASE_URI,
- %GROUPWARE_OPTIONS,
- );
- $calendar = $session->get($CALENDAR_URI);
- }
- elsif ( $BASE_URI->scheme eq 'file' ) {
- defined $BASE_URI->file
- or $log->fatal('bad base URI: cannot open file') && exit 2;
- $log->infof( 'will use base URI %s', $BASE_URI );
- # parse local calendar data
- $log->debug('parse local calendar data...');
- my $path = path( $BASE_URI->file );
- if ( $path->is_file ) {
- $calendar = Object::Groupware::Calendar->new(
- filename => "$path",
- %GROUPWARE_OPTIONS,
- );
- }
- else {
- my $data;
- $path->visit( sub { $data .= $_->slurp_raw if $_->is_file } );
- $calendar = Object::Groupware::Calendar->new(
- data => $data,
- %GROUPWARE_OPTIONS,
- );
- }
- }
- # select subset of calendar events
- $log->debug('serialize calendar events...');
- my $start;
- if ( $ENV{CAL_DAV_NOW} ) {
- try { require DateTimeX::Easy }
- catch ($e) {
- $log->fatalf( 'failed parsing CAL_DAV_NOW: %s', $e ) && exit 2
- }
- $start = DateTimeX::Easy->new( $ENV{CAL_DAV_NOW} );
- $log->fatalf(
- 'failed parsing CAL_DAV_NOW: unknown start time "%s"',
- $ENV{CAL_DAV_NOW}
- )
- && exit 2
- unless defined $start;
- }
- $start ||= DateTime->now;
- my $end = $start->clone->add( months => 6 );
- my $span = DateTime::Span->from_datetimes( start => $start, end => $end );
- my @events = $calendar->events($span);
- # serialize calendar view
- if ($OUTPUT_FILE) {
- $OUTPUT_FILE = path($OUTPUT_FILE);
- $OUTPUT_FILE->parent->mkpath;
- $OUTPUT_FILE->remove;
- }
- my %vars;
- for (@events) {
- next unless $_->summary;
- push @{ $vars{events} }, $_;
- }
- my %tmpl;
- $tmpl{list} = path($SKELDIR)->child('list.md')->slurp_utf8;
- my $template = Text::Xslate->new(
- path => \%tmpl,
- syntax => 'TTerse',
- type => 'text',
- );
- my $content = $template->render( 'list', \%vars );
- if ($OUTPUT_FILE) {
- $OUTPUT_FILE->append_utf8($content);
- }
- else {
- print $content;
- }
- 1;
|