Generated: Mon Aug 29 19:35:00 2016 from shwevents.pl 2015/10/04 15.5 KB. text copy
#!/usr/bin/perl -w # NAME: shwevents.pl # AIM: Read and list events in Rainlendar event file # 04/10/2015 geoff mclane http://geoffair.net/mperl use strict; use warnings; use File::Basename; # split path ($name,$dir,$ext) = fileparse($file [, qr/\.[^.]*/] ) use Time::Local; use Cwd; my $os = $^O; my $perl_dir = '/home/geoff/bin'; my $PATH_SEP = '/'; my $temp_dir = '/tmp'; if ($os =~ /win/i) { $perl_dir = 'C:\GTools\perl'; $temp_dir = $perl_dir; $PATH_SEP = "\\"; } unshift(@INC, $perl_dir); require 'lib_utils.pl' or die "Unable to load 'lib_utils.pl' Check paths in \@INC...\n"; # log file stuff our ($LF); my $pgmname = $0; if ($pgmname =~ /(\\|\/)/) { my @tmpsp = split(/(\\|\/)/,$pgmname); $pgmname = $tmpsp[-1]; } my $outfile = $temp_dir.$PATH_SEP."temp.$pgmname.txt"; open_log($outfile); # user variables my $VERS = "0.0.5 2015-10-04"; my $load_log = 1; my $in_file = ''; my $verbosity = 0; my $out_file = ''; my $show_all_events = 0; my $min_lenght = length("EVENT: Pauline's Birthday RPT:FREQ=YEARLY;BYMONTHDAY=14;BYMONTH=6 2015/06/14 11:00:00 "); # ### DEBUG ### my $debug_on = 1; my $def_file = 'C:\Users\user\.rainlendar2\Default.ics'; ### program variables my @warnings = (); my $cwd = cwd(); sub VERB1() { return $verbosity >= 1; } sub VERB2() { return $verbosity >= 2; } sub VERB5() { return $verbosity >= 5; } sub VERB9() { return $verbosity >= 9; } sub show_warnings($) { my ($val) = @_; if (@warnings) { prt( "\nGot ".scalar @warnings." WARNINGS...\n" ); foreach my $itm (@warnings) { prt("$itm\n"); } prt("\n"); } else { prt( "\nNo warnings issued.\n\n" ) if (VERB9()); } } sub pgm_exit($$) { my ($val,$msg) = @_; if (length($msg)) { $msg .= "\n" if (!($msg =~ /\n$/)); prt($msg); } show_warnings($val); close_log($outfile,$load_log); exit($val); } sub prtw($) { my ($tx) = shift; $tx =~ s/\n$//; prt("$tx\n"); push(@warnings,$tx); } my %bgnend = ( 'VCALENDAR' => 1, 'VEVENT' => 1, 'VALARM' => 1 ); my %freqs = ( 'WEEKLY' => 1, 'MONTHLY' => 1, 'YEARLY' => 1 ); my %raindays = ( 'MO' => 1, 'TU' => 2, 'WE' => 3, 'TH' => 4, 'FR' => 5, 'SA' => 6, 'SU' => 7 ); sub get_next_month_dt($$) { my ($bgn,$now) = @_; my ($year,$mth,$day,$hour,$min,$sec); my ($nyear,$nmth,$nday,$nhour,$nmin,$nsec); my ($ep1,$ep2); $ep1 = -1; if ($bgn =~ /^\s*(\d{4})(\d{2})(\d{2})T(\d{2})(\d{2})(\d{2})Z\s*$/) { $year = $1; $mth = $2; $day = $3; $hour = $4; $min = $5; $sec = $6; $ep1 = timelocal($sec,$min,$hour,$day,$mth-1,$year); if ($now =~ /^\s*(\d{4})(\d{2})(\d{2})T(\d{2})(\d{2})(\d{2})Z\s*$/) { $nyear = $1; $nmth = $2; $nday = $3; $nhour = $4; $nmin = $5; $nsec = $6; $ep2 = timelocal($nsec,$nmin,$nhour,$nday,$nmth-1,$nyear); while ($ep1 < $ep2) { $mth += 1; if ($mth > 12) { $mth = 1; $year += 1; } $ep1 = timelocal($sec,$min,$hour,$day,$mth-1,$year); } } else { prtw("WARNING: $now did not parse correctly\n"); } } else { prtw("WARNING: $bgn did not parse correctly\n"); } return $ep1; } sub get_next_year_dt($$) { my ($bgn,$now) = @_; my ($year,$mth,$day,$hour,$min,$sec); my ($nyear,$nmth,$nday,$nhour,$nmin,$nsec); my ($ep1,$ep2); $ep1 = -1; if ($bgn =~ /^\s*(\d{4})(\d{2})(\d{2})T(\d{2})(\d{2})(\d{2})Z\s*$/) { $year = $1; $mth = $2; $day = $3; $hour = $4; $min = $5; $sec = $6; $ep1 = timelocal($sec,$min,$hour,$day,$mth-1,$year); if ($now =~ /^\s*(\d{4})(\d{2})(\d{2})T(\d{2})(\d{2})(\d{2})Z\s*$/) { $nyear = $1; $nmth = $2; $nday = $3; $nhour = $4; $nmin = $5; $nsec = $6; $ep2 = timelocal($nsec,$nmin,$nhour,$nday,$nmth-1,$nyear); while ($ep1 < $ep2) { $year += 1; $ep1 = timelocal($sec,$min,$hour,$day,$mth-1,$year); } } else { prtw("WARNING: $now did not parse correctly\n"); } } else { prtw("WARNING: $bgn did not parse correctly\n"); } return $ep1; } # DTSTART:20150707T133000Z sub parse_datetime($) { my $dt = shift; my ($year,$mth,$day,$hour,$min,$sec); if ($dt =~ /^\s*(\d{4})(\d{2})(\d{2})T(\d{2})(\d{2})(\d{2})Z\s*$/) { $year = $1; $mth = $2; $day = $3; $hour = $4; $min = $5; $sec = $6; return timelocal($sec,$min,$hour,$day,$mth-1,$year); } prtw("WARNING: $dt failed parsing...\n"); return -1; } sub process_in_file($) { my ($inf) = @_; if (! open INF, "<$inf") { pgm_exit(1,"ERROR: Unable to open file [$inf]\n"); } my @lines = <INF>; close INF; my $lncnt = scalar @lines; prt("Processing $lncnt lines, from [$inf]...\n"); my ($line,$inc,$lnn,$len,$tline,@arr,$cnt,$act,$val,$ok,$last,$prev,$epoch,$date); my (@arr2,$act2,$val2,$epoch2,$date2,$freq2,$bgndate,$tmp,$nxtdate,$msg); my $day_of_week = 0; $lnn = 0; my %acts = (); my @stack = (); my $event = ''; my $gotrpt = 0; my $gotdat = 0; my $expired = 0; my $rptstg = ''; my %repeats = (); my $now = time(); my $nowdate = lu_get_YYYYMMDD_hhmmss($now); $nowdate =~ s/\///g; $nowdate =~ s/://g; $nowdate =~ s/\s/T/g; $nowdate .= 'Z'; $epoch = parse_datetime($nowdate); prt("Now date $nowdate ($epoch) $now\n"); ###pgm_exit(1,"TEMP EXIT\n"); foreach $line (@lines) { chomp $line; $lnn++; $tline = trim_all($line); $len = length($tline); next if ($len == 0); @arr = split(":",$line); $cnt = scalar @arr; if ($cnt == 2) { $act = $arr[0]; $val = $arr[1]; $ok = defined $bgnend{$val}; $acts{$act} = 1; if ($act eq 'BEGIN') { push(@stack,$val); prt("$lnn: BGN $val\n") if (!$ok); } elsif ($act eq 'END') { if (@stack) { $inc = pop @stack; if ($val ne $inc) { prt("$lnn: got END $val but last in stack is $inc\n"); } if ($val eq 'VEVENT') { if (length($event)) { $msg = "EVENT: $event "; $freq2 = ''; $expired = 0; $day_of_week = 0; if ($gotrpt) { @arr = split(";",$rptstg); $cnt = scalar @arr; foreach $inc (@arr) { @arr2 = split("=",$inc); $cnt = scalar @arr2; if ($cnt == 2) { $act2 = $arr2[0]; $val2 = $arr2[1]; if ($act2 eq 'UNTIL') { $date2 = $val2."T230000Z"; $epoch2 = parse_datetime($date2); if ($epoch2 < $now) { $msg .= "EXPIRED "; $expired = 1; } } elsif ($act2 eq 'FREQ') { if (defined $freqs{$val2}) { $freq2 = $val2; } else { pgm_exit(1,"Error: add new FREQ $val2 ($inc) ** FIX ME ***\n"); } } elsif ($act2 eq 'INTERVAL') { # TODO: What is this??? } elsif ($act2 eq 'BYDAY') { if (defined $raindays{$val2}) { $day_of_week = $raindays{$val2}; } else { prtw("WARNING: value $val2 not in raindays! ** FIX ME **\n"); } } elsif ($act2 eq 'BYMONTHDAY') { # seems this is the same as begin date day } elsif ($act2 eq 'BYMONTH') { # seems this is the same as begin date month } else { prtw("WARNING: act2 $act2 NOT handled! $event\n"); } } else { prtw("WARNING:$lnn: item $inc did not split in 2!\n"); } } if (!$expired) { if ($freq2 eq 'WEEKLY') { # FREQ=WEEKLY;UNTIL=20150622;BYDAY=MO } elsif ($freq2 eq 'MONTHLY') { $tmp = get_next_month_dt($bgndate,$nowdate); $nxtdate = lu_get_YYYYMMDD_hhmmss($tmp); $msg .= ' ' while(length($msg) < $min_lenght); $msg .= "NEXT: $nxtdate "; #prt("NEXT: $nxtdate "); #pgm_exit(1,"\nTEMP EXIT\n"); } elsif ($freq2 eq 'YEARLY') { $tmp = get_next_year_dt($bgndate,$nowdate); $nxtdate = lu_get_YYYYMMDD_hhmmss($tmp); $msg .= ' ' while(length($msg) < $min_lenght); $msg .= "NEXT: $nxtdate "; } else { ptrw("WARNING: Unhandled FREQ $freq2 $event\n"); } } } elsif ($gotdat) { if ($epoch < $now) { $msg .= "CLOSED "; $expired = 1; } } prt("$msg\n") if (!$expired || $show_all_events); } $event = ''; $gotrpt = 0; $gotdat = 0; } } else { prt("$lnn: got END $val with no stack\n"); } prt("$lnn: END $val\n") if (!$ok); } elsif ($act eq 'SUMMARY') { prt("$lnn: SUM $val\n") if (VERB9()); $event .= " " if (length($event)); $event .= "$val"; } elsif ($act eq 'RRULE') { prt("$lnn: RPT $val\n") if (VERB9()); $event .= " " if (length($event)); $event .= "RPT:$val"; $gotrpt = 1; $rptstg = $val; $repeats{$val} = 1; } elsif ($act eq 'DTSTART') { $bgndate = $val; $epoch = parse_datetime($val); #$date = lu_get_YYYYMMDD_hhmmss_UTC($epoch); $date = lu_get_YYYYMMDD_hhmmss($epoch); prt("$lnn: DAT $val ($epoch) $date\n") if (VERB9()); $event .= " " if (length($event)); $event .= "$date"; $gotdat = 1; } } else { prtw("WARNING: $lnn: $line did not split in 2! got $cnt!\n"); } } @arr = sort keys %repeats; $cnt = scalar @arr; prt("Got $cnt different repeats...\n"); ##prt( join("\n",@arr)."\n"); @arr = sort keys %acts; $cnt = scalar @arr; prt("Got $cnt different actions...\n"); ##prt( join(" ",@arr)."\n"); } ######################################### ### MAIN ### parse_args(@ARGV); process_in_file($in_file); pgm_exit(0,""); ######################################## sub need_arg { my ($arg,@av) = @_; pgm_exit(1,"ERROR: [$arg] must have a following argument!\n") if (!@av); } sub parse_args { my (@av) = @_; my ($arg,$sarg); my $verb = VERB2(); while (@av) { $arg = $av[0]; if ($arg =~ /^-/) { $sarg = substr($arg,1); $sarg = substr($sarg,1) while ($sarg =~ /^-/); if (($sarg =~ /^h/i)||($sarg eq '?')) { give_help(); pgm_exit(0,"Help exit(0)"); } elsif ($sarg =~ /^v/) { if ($sarg =~ /^v.*(\d+)$/) { $verbosity = $1; } else { while ($sarg =~ /^v/) { $verbosity++; $sarg = substr($sarg,1); } } $verb = VERB2(); prt("Verbosity = $verbosity\n") if ($verb); } elsif ($sarg =~ /^l/) { if ($sarg =~ /^ll/) { $load_log = 2; } else { $load_log = 1; } prt("Set to load log at end. ($load_log)\n") if ($verb); } elsif ($sarg =~ /^o/) { need_arg(@av); shift @av; $sarg = $av[0]; $out_file = $sarg; prt("Set out file to [$out_file].\n") if ($verb); } else { pgm_exit(1,"ERROR: Invalid argument [$arg]! Try -?\n"); } } else { $in_file = $arg; prt("Set input to [$in_file]\n") if ($verb); } shift @av; } if ($debug_on) { prtw("WARNING: DEBUG is ON!\n"); if (length($in_file) == 0) { $in_file = $def_file; prt("Set DEFAULT input to [$in_file]\n"); } } if (length($in_file) == 0) { pgm_exit(1,"ERROR: No input files found in command!\n"); } if (! -f $in_file) { pgm_exit(1,"ERROR: Unable to find in file [$in_file]! Check name, location...\n"); } } sub give_help { prt("$pgmname: version $VERS\n"); prt("Usage: $pgmname [options] in-file\n"); prt("Options:\n"); prt(" --help (-h or -?) = This help, and exit 0.\n"); prt(" --verb[n] (-v) = Bump [or set] verbosity. def=$verbosity\n"); prt(" --load (-l) = Load LOG at end. ($outfile)\n"); prt(" --out <file> (-o) = Write output to this file.\n"); } # eof - template.pl