File Coverage

blib/lib/App/Greple/ical.pm
Criterion Covered Total %
statement 11 41 26.8
branch 0 20 0.0
condition 0 6 0.0
subroutine 4 7 57.1
pod 0 3 0.0
total 15 77 19.4


line stmt bran cond sub pod time code
1             =head1 NAME
2              
3             ical - Module to support Apple macOS Calendar data
4              
5             =head1 SYNOPSIS
6              
7             greple -Mical [ options ]
8              
9             --simple print data in on line
10             --detail print one line data with descrition if available
11              
12             Exported functions
13              
14             &print_ical_simple
15             &print_ical_desc
16             &print_ical_detail
17              
18             =head1 SAMPLES
19              
20             greple -Mical [ -dnf ] ...
21              
22             greple -Mical --simple ...
23              
24             greple -Mical --detail ...
25              
26             greple -Mical --all --print print_desc ...
27              
28             =head1 DESCRIPTION
29              
30             Used without options, it will search all macOS Calendar files under
31             user's home directory.
32              
33             With B<--simple> option, summarize content in single line. Output is
34             not sorted.
35              
36             With B<--detail> option, print summarized line with description data
37             if it is attached. The result is sorted.
38              
39             Sample:
40              
41             BEGIN:VEVENT
42             UID:19970901T130000Z-123401@host.com
43             DTSTAMP:19970901T1300Z
44             DTSTART:19970903T163000Z
45             DTEND:19970903T190000Z
46             SUMMARY:Annual Employee Review
47             CLASS:PRIVATE
48             CATEGORIES:BUSINESS,HUMAN RESOURCES
49             END:VEVENT
50              
51             =head1 TIPS
52              
53             Use C<-dfn> option to observe the command running status.
54              
55             Use C<-ds> option to see statistics information such as how many files
56             were searched.
57              
58             =head1 SEE ALSO
59              
60             RFC2445
61              
62             =head1 AUTHOR
63              
64             Kazumasa Utashiro
65              
66             =head1 LICENSE
67              
68             Copyright 2017-2022 Kazumasa Utashiro.
69              
70             This library is free software; you can redistribute it and/or modify
71             it under the same terms as Perl itself.
72              
73             =cut
74              
75             package App::Greple::ical;
76              
77             our $VERSION = '0.02';
78              
79 1     1   612 use v5.14;
  1         3  
80 1     1   4 use warnings;
  1         2  
  1         21  
81 1     1   4 use Carp;
  1         1  
  1         48  
82 1     1   4 use Exporter 'import';
  1         2  
  1         499  
83              
84             our @EXPORT = qw(&print_simple &print_detail &print_desc);
85              
86             sub print_detail {
87 0     0 0   $_ = &print_simple . &print_desc . "\n";
88 0           s/\n(?=.)/\r/sg;
89 0           $_;
90             }
91              
92             sub print_simple {
93 0     0 0   s/\r//g;
94 0           my $s = '';
95 0           my(@s, @e);
96 0 0         if (@s = /^DTSTART.*(\d{4})(\d\d)(\d\d)(?:T(\d\d)(\d\d))?/m) {
97 0           $s .= "$1/$2/$3";
98 0 0         $s .= " $4:$5" if defined $4;
99             }
100 0 0         if (@e = /^DTEND.*(\d{4})(\d\d)(\d\d)(?:T(\d\d)(\d\d))?/m) {
101 0 0 0       if ($s[0]eq$e[0] and $s[1]eq$e[1] and $s[2]+1>=$e[2]) {
      0        
102 0 0         $s .= "-$4:$5" if defined $4;
103             } else {
104 0           $s .= "-";
105 0 0         $s .= "$1/" if $s[0] ne $e[0];
106 0           $s .= "$2/$3";
107             }
108             }
109 0           $s .= " ";
110 0 0         /^SUMMARY:(.*)/m and $s .= $1;
111 0 0         /^DESCRIPTION:/m and $s .= "*";
112 0 0         /^LOCATION:(.*)/m and $s .= " \@[$1]";
113 0           $s .= "\n";
114 0           $s;
115             }
116              
117             sub print_desc {
118 0     0 0   my $desc = '';
119 0 0         if (/^(DESCRIPTION.*\n(?:\s.*\n)*)/m) {
120 0           $desc = $1;
121 0           for ($desc) {
122 0           s/\n\s+//g;
123 0           s/\\n/\n/g;
124 0           s/\\\\t/\t/g;
125 0           s/\\,/,/g;
126             }
127             }
128 0           $desc;
129             }
130              
131             1;
132              
133             __DATA__