aboutsummaryrefslogtreecommitdiff
path: root/bin/events2md.pl
blob: d0dc9b52f49ed930bd1d9d6facd4e4e8dd72dcf8 (plain)
  1. #!/usr/bin/perl
  2. use v5.36;
  3. use utf8;
  4. use open qw(:std :encoding(UTF-8));
  5. use autodie;
  6. use Feature::Compat::Try;
  7. use FindBin qw($Bin);
  8. use lib "$Bin/../lib";
  9. use POSIX qw(locale_h);
  10. use locale;
  11. use Net::Netrc;
  12. use List::Util qw(first);
  13. use IO::Interactive::Tiny;
  14. use Log::Any qw($log);
  15. use Log::Any::Adapter;
  16. use URI;
  17. use IO::Prompter;
  18. use Cal::DAV;
  19. use DateTime;
  20. use Path::Tiny;
  21. use Text::Xslate;
  22. use Object::Groupware::Calendar;
  23. if ( IO::Interactive::Tiny::is_interactive() ) {
  24. Log::Any::Adapter->set( 'Screen', default_level => 'info' );
  25. }
  26. # set defaults and parse command-line options
  27. my ( $BASE_URI, $CALENDAR_URI, $SKELDIR, $OUTPUT_FILE );
  28. $BASE_URI = $ENV{CAL_DAV_URL_BASE};
  29. $CALENDAR_URI = $ENV{CAL_DAV_URL_CALENDAR};
  30. $SKELDIR = $ENV{SKELDIR} || "$Bin/../templates";
  31. $BASE_URI ||= shift @ARGV
  32. if @ARGV;
  33. $CALENDAR_URI ||= shift @ARGV
  34. if @ARGV;
  35. $OUTPUT_FILE = shift @ARGV
  36. if @ARGV;
  37. # use system locale to format DateTime objects parsed from iCal data
  38. DateTime->DefaultLocale( setlocale(LC_TIME) );
  39. # resolve calendar URIs
  40. my ( $base_uri, $calendar_uri, $calendar );
  41. $base_uri = URI->new($BASE_URI)
  42. if ($BASE_URI);
  43. $base_uri
  44. or $log->fatal('required base URI not provided') && exit 2;
  45. $base_uri->scheme
  46. or $base_uri->scheme('file');
  47. if ( $base_uri->scheme eq 'http' or $base_uri->scheme eq 'https' ) {
  48. $log->infof( 'will use base URI %s', $base_uri );
  49. $calendar_uri = URI->new( $CALENDAR_URI || $base_uri );
  50. $calendar_uri and $calendar_uri->authority
  51. or $log->fatal('bad calendar URI: must be an internet URI') && exit 2;
  52. $base_uri->eq($calendar_uri) and $calendar_uri = undef
  53. or $log->infof( 'will use calendar URI %s', $calendar_uri );
  54. # resolve credentials
  55. $log->debug('resolve credentials...');
  56. my ( $mach, $user, $pass );
  57. ( $user, $pass ) = split ':', $base_uri->userinfo
  58. if $base_uri->userinfo;
  59. $user ||= $ENV{CAL_DAV_USER};
  60. $pass ||= $ENV{CAL_DAV_PASS};
  61. $mach = Net::Netrc->lookup( $base_uri->host, $user )
  62. if !$user or !$pass;
  63. if ($mach) {
  64. $user ||= $mach->login;
  65. $pass ||= $mach->password;
  66. $log->infof(
  67. 'will use .netrc provided credentials for user %s',
  68. $user
  69. );
  70. }
  71. elsif ( IO::Interactive::Tiny::is_interactive() ) {
  72. $log->warn(
  73. 'will ask for missing info - this will fail in headless mode');
  74. $user ||= prompt 'Enter your username';
  75. $pass ||= prompt 'Enter your password', -echo => '*';
  76. }
  77. $log->debugf( 'resolved credentials for user %s', $user );
  78. # fetch and parse CalDAV calendar data
  79. $log->debug('fetch and parse CalDAV calendar data...');
  80. my $session = Cal::DAV->new(
  81. user => $user,
  82. pass => $pass,
  83. url => $base_uri,
  84. );
  85. $session->get($calendar_uri)
  86. if $calendar_uri;
  87. $calendar = Object::Groupware::Calendar->new( data => $session->cal );
  88. }
  89. elsif ( $base_uri->scheme eq 'file' ) {
  90. defined $base_uri->file
  91. or $log->fatal('bad base URI: cannot open file') && exit 2;
  92. $log->infof( 'will use base URI %s', $base_uri );
  93. # parse local calendar data
  94. $log->debug('parse local calendar data...');
  95. my $path = path( $base_uri->file );
  96. if ( $path->is_file ) {
  97. $calendar = Object::Groupware::Calendar->new( filename => "$path" );
  98. }
  99. else {
  100. my $data;
  101. $path->visit( sub { $data .= $_->slurp_raw if $_->is_file } );
  102. $calendar = Object::Groupware::Calendar->new( data => $data );
  103. }
  104. }
  105. if ( $log->is_trace ) {
  106. use DDP;
  107. p $calendar;
  108. }
  109. # TODO: if list is empty and no calendar uri was explicitly supplied,
  110. # warn on stdout with list of abailable collections using this sequence:
  111. # 1. PROPFIND on base-URL for {DAV:}current-user-principal
  112. # 2. PROPFIND for calendar-home-set property in caldav namespace
  113. # 3. PROPFIND with depth: 1
  114. # as documented at <https://stackoverflow.com/a/11673483>
  115. # select subset of calendar events
  116. $log->debug('serialize calendar events...');
  117. my $start;
  118. if ( $ENV{CAL_DAV_NOW} ) {
  119. try { require DateTimeX::Easy }
  120. catch ($e) {
  121. $log->fatalf( 'failed parsing CAL_DAV_NOW: %s', $e ) && exit 2
  122. }
  123. $start = DateTimeX::Easy->new( $ENV{CAL_DAV_NOW} );
  124. $log->fatalf(
  125. 'failed parsing CAL_DAV_NOW: unknown start time "%s"',
  126. $ENV{CAL_DAV_NOW}
  127. )
  128. && exit 2
  129. unless defined $start;
  130. }
  131. $start ||= DateTime->now;
  132. my $end = $start->clone->add( months => 6 );
  133. my $span = DateTime::Span->from_datetimes( start => $start, end => $end );
  134. my @events = $calendar->events($span);
  135. # serialize calendar view
  136. my $output_path;
  137. if ($OUTPUT_FILE) {
  138. $output_path = path($OUTPUT_FILE);
  139. $output_path->parent->mkpath;
  140. $output_path->remove;
  141. }
  142. my %vars;
  143. for (@events) {
  144. next unless $_->summary;
  145. push @{ $vars{events} }, $_;
  146. }
  147. my %tmpl;
  148. $tmpl{list} = path($SKELDIR)->child('list.md')->slurp_utf8;
  149. my $template = Text::Xslate->new(
  150. path => \%tmpl,
  151. syntax => 'TTerse',
  152. type => 'text',
  153. );
  154. my $content = $template->render( 'list', \%vars );
  155. if ($output_path) {
  156. $output_path->append_utf8($content);
  157. }
  158. else {
  159. print $content;
  160. }
  161. 1;