aboutsummaryrefslogtreecommitdiff
path: root/bin/events2md.pl
blob: 4019420b2b863810eb801e2f820e919a870900de (plain)
  1. #!/usr/bin/perl
  2. use v5.36;
  3. use strict;
  4. use utf8;
  5. use open qw(:std :encoding(UTF-8));
  6. use autodie;
  7. use Feature::Compat::Try;
  8. use Feature::Compat::Class 0.07;
  9. use FindBin qw($Bin);
  10. use POSIX qw(locale_h);
  11. use locale;
  12. use Encode qw(decode_utf8); # TODO: modernize CalDAV access instead
  13. use Net::Netrc;
  14. use List::Util qw(first);
  15. use IO::Interactive::Tiny;
  16. use Log::Any qw($log);
  17. use Log::Any::Adapter;
  18. use URI;
  19. use IO::Prompter;
  20. use Cal::DAV;
  21. use Data::ICal::DateTime;
  22. use DateTime;
  23. use Path::Tiny;
  24. use Text::Xslate;
  25. if ( IO::Interactive::Tiny::is_interactive() ) {
  26. Log::Any::Adapter->set( 'Screen', default_level => 'info' );
  27. }
  28. # set defaults and parse command-line options
  29. my ( $BASE_URI, $CALENDAR_URI, $SKELDIR, $OUTPUT_FILE );
  30. $BASE_URI = $ENV{CAL_DAV_URL_BASE};
  31. $CALENDAR_URI = $ENV{CAL_DAV_URL_CALENDAR};
  32. $SKELDIR = $ENV{SKELDIR} || "$Bin/../templates";
  33. $BASE_URI ||= shift @ARGV
  34. if @ARGV;
  35. $CALENDAR_URI ||= shift @ARGV
  36. if @ARGV;
  37. $OUTPUT_FILE = shift @ARGV
  38. if @ARGV;
  39. class Calendar {
  40. field $log = Log::Any->get_logger;
  41. # borrow from Data::ICal::new() signature
  42. field $data : param = undef;
  43. field $filename : param = undef;
  44. ADJUST {
  45. if ($data) {
  46. if ( $data isa Data::ICal ) { }
  47. else { $data = Data::ICal->new( data => $data ) }
  48. }
  49. elsif ($filename) { $data = Data::ICal->new( filename => $filename ) }
  50. if ( $log->is_trace ) {
  51. use DDP;
  52. p $data;
  53. }
  54. }
  55. # mimick Data::ICal::DateTime::events() signature
  56. method events ( $set = undef, $period = undef )
  57. {
  58. $log->infof(
  59. 'will pick events between %s and %s',
  60. $set->start, $set->end
  61. ) if $set;
  62. my @events = sort {
  63. DateTime->compare( $a->begin, $b->begin )
  64. || DateTime->compare( $a->end, $b->end )
  65. || $a->summary cmp $b->summary
  66. } map { Event->new( entry => $_ ) }
  67. $data->events( $set || (), $period || () );
  68. return @events;
  69. }
  70. }
  71. class Event {
  72. use Encode qw(decode_utf8); # TODO: modernize CalDAV access instead
  73. field $log = Log::Any->get_logger;
  74. field $entry : param;
  75. field $begin : reader = $entry->start;
  76. field $date_begin : reader = $begin->strftime('%A %e. %B');
  77. field $time_begin : reader = $begin->strftime('%k.%M');
  78. field $end : reader = $entry->end;
  79. field $date_end : reader;
  80. field $time_end : reader;
  81. field $datespan : reader;
  82. field $timespan : reader;
  83. field $time_brief : reader;
  84. field $summary : reader
  85. = $entry->property('summary')
  86. ? decode_utf8 $entry->property('summary')->[0]->value
  87. : '';
  88. field $description : reader
  89. = $entry->property('description')
  90. ? decode_utf8 $entry->property('description')->[0]->value
  91. : '';
  92. field $location : reader
  93. = $entry->property('location')
  94. ? decode_utf8 $entry->property('location')->[0]->value
  95. : '';
  96. field $price : reader;
  97. field @attendees;
  98. field @attachments;
  99. ADJUST {
  100. if ( defined $end ) {
  101. $date_end = $end->strftime('%A %e. %B');
  102. $time_end = $end->strftime('%k.%M');
  103. }
  104. $datespan
  105. = ( defined $end and $date_end ne $date_begin )
  106. ? ucfirst("$date_begin - $date_end")
  107. : ucfirst("$date_begin");
  108. $timespan
  109. = ( defined $end and not $entry->all_day )
  110. ? ucfirst("$date_begin kl. $time_begin-$time_end")
  111. : undef;
  112. $time_brief
  113. = $entry->all_day
  114. ? $datespan
  115. : ucfirst("$date_begin kl. $time_begin");
  116. $description =~ s/\n\n[Pp]ris:\s*((?!\n).+)\s*\z//m;
  117. $price = $1;
  118. if ( $entry->property('attendee') ) {
  119. for ( @{ $entry->property('attendee') } ) {
  120. push @attendees, decode_utf8 $_->parameters->{'CN'}
  121. || $_->value =~ s/^mailto://r;
  122. }
  123. }
  124. if ( $entry->property('attach') ) {
  125. for ( @{ $entry->property('attach') } ) {
  126. my $uri;
  127. try { $uri = URI->new( $_->value ) }
  128. catch ($e) {
  129. $log->errorf( 'failed to parse URI %s: %s', $uri, $e );
  130. next;
  131. }
  132. $uri->authority and $uri->host
  133. or next;
  134. push @attachments, $uri;
  135. }
  136. }
  137. if ( $log->is_trace ) {
  138. use DDP;
  139. p $entry;
  140. p $begin;
  141. p $end;
  142. }
  143. }
  144. method attendees { !!@attendees ? [@attendees] : undef }
  145. method attachments { !!@attachments ? [@attachments] : undef }
  146. }
  147. # use system locale to format DateTime objects parsed from iCal data
  148. DateTime->DefaultLocale( setlocale(LC_TIME) );
  149. # resolve calendar URIs
  150. my ( $base_uri, $calendar_uri, $calendar );
  151. $base_uri = URI->new($BASE_URI)
  152. if ($BASE_URI);
  153. $base_uri
  154. or $log->fatal('required base URI not provided') && exit 2;
  155. $base_uri->scheme
  156. or $base_uri->scheme('file');
  157. if ( $base_uri->scheme eq 'http' or $base_uri->scheme eq 'https' ) {
  158. $log->infof( 'will use base URI %s', $base_uri );
  159. $calendar_uri = URI->new( $CALENDAR_URI || $base_uri );
  160. $calendar_uri and $calendar_uri->authority
  161. or $log->fatal('bad calendar URI: must be an internet URI') && exit 2;
  162. $base_uri->eq($calendar_uri) and $calendar_uri = undef
  163. or $log->infof( 'will use calendar URI %s', $calendar_uri );
  164. # resolve credentials
  165. $log->debug('resolve credentials...');
  166. my ( $mach, $user, $pass );
  167. ( $user, $pass ) = split ':', $base_uri->userinfo
  168. if $base_uri->userinfo;
  169. $user ||= $ENV{CAL_DAV_USER};
  170. $pass ||= $ENV{CAL_DAV_PASS};
  171. $mach = Net::Netrc->lookup( $base_uri->host, $user )
  172. if !$user or !$pass;
  173. if ($mach) {
  174. $user ||= $mach->login;
  175. $pass ||= $mach->password;
  176. $log->infof(
  177. 'will use .netrc provided credentials for user %s',
  178. $user
  179. );
  180. }
  181. elsif ( IO::Interactive::Tiny::is_interactive() ) {
  182. $log->warn(
  183. 'will ask for missing info - this will fail in headless mode');
  184. $user ||= prompt 'Enter your username';
  185. $pass ||= prompt 'Enter your password', -echo => '*';
  186. }
  187. $log->debugf( 'resolved credentials for user %s', $user );
  188. # fetch and parse CalDAV calendar data
  189. $log->debug('fetch and parse CalDAV calendar data...');
  190. my $session = Cal::DAV->new(
  191. user => $user,
  192. pass => $pass,
  193. url => $base_uri,
  194. );
  195. $session->get($calendar_uri)
  196. if $calendar_uri;
  197. $calendar = Calendar->new( data => $session->cal );
  198. }
  199. elsif ( $base_uri->scheme eq 'file' ) {
  200. defined $base_uri->file
  201. or $log->fatal('bad base URI: cannot open file') && exit 2;
  202. $log->infof( 'will use base URI %s', $base_uri );
  203. # parse local calendar data
  204. $log->debug('parse local calendar data...');
  205. my $path = path( $base_uri->file );
  206. if ( $path->is_file ) {
  207. $calendar = Calendar->new( filename => "$path" );
  208. }
  209. else {
  210. my $data;
  211. $path->visit( sub { $data .= $_->slurp_raw if $_->is_file } );
  212. $calendar = Calendar->new( data => $data );
  213. }
  214. }
  215. if ( $log->is_trace ) {
  216. use DDP;
  217. p $calendar;
  218. }
  219. # TODO: if list is empty and no calendar uri was explicitly supplied,
  220. # warn on stdout with list of abailable collections using this sequence:
  221. # 1. PROPFIND on base-URL for {DAV:}current-user-principal
  222. # 2. PROPFIND for calendar-home-set property in caldav namespace
  223. # 3. PROPFIND with depth: 1
  224. # as documented at <https://stackoverflow.com/a/11673483>
  225. # select subset of calendar events
  226. $log->debug('serialize calendar events...');
  227. my $start;
  228. if ( $ENV{CAL_DAV_NOW} ) {
  229. try { require DateTimeX::Easy }
  230. catch ($e) {
  231. $log->fatalf( 'failed parsing CAL_DAV_NOW: %s', $e ) && exit 2
  232. }
  233. $start = DateTimeX::Easy->new( $ENV{CAL_DAV_NOW} );
  234. $log->fatalf(
  235. 'failed parsing CAL_DAV_NOW: unknown start time "%s"',
  236. $ENV{CAL_DAV_NOW}
  237. )
  238. && exit 2
  239. unless defined $start;
  240. }
  241. $start ||= DateTime->now;
  242. my $end = $start->clone->add( months => 6 );
  243. my $span = DateTime::Span->from_datetimes( start => $start, end => $end );
  244. my @events = $calendar->events($span);
  245. # serialize calendar view
  246. my $output_path;
  247. if ($OUTPUT_FILE) {
  248. $output_path = path($OUTPUT_FILE);
  249. $output_path->parent->mkpath;
  250. $output_path->remove;
  251. }
  252. my %vars;
  253. for (@events) {
  254. next unless $_->summary;
  255. push @{ $vars{events} }, $_;
  256. }
  257. my %tmpl;
  258. $tmpl{list} = path($SKELDIR)->child('list.md')->slurp_utf8;
  259. my $template = Text::Xslate->new(
  260. path => \%tmpl,
  261. syntax => 'TTerse',
  262. type => 'text',
  263. );
  264. my $content = $template->render( 'list', \%vars );
  265. if ($output_path) {
  266. $output_path->append_utf8($content);
  267. }
  268. else {
  269. print $content;
  270. }
  271. 1;