File Coverage

blib/lib/DateTime/Event/Klingon.pm
Criterion Covered Total %
statement 45 47 95.7
branch 8 10 80.0
condition n/a
subroutine 9 9 100.0
pod n/a
total 62 66 93.9


line stmt bran cond sub pod time code
1             # $Id: /svn/DateTime-Event-Klingon/tags/VERSION_1_0_1/lib/DateTime/Event/Klingon.pm 323 2008-04-01T06:37:25.246199Z jaldhar $
2             package DateTime::Event::Klingon;
3              
4 3     3   4346768 use warnings;
  3         9  
  3         112  
5 3     3   18 use strict;
  3         6  
  3         141  
6 3     3   19 use Carp qw/croak/;
  3         6  
  3         198  
7 3     3   9393 use Filter::Util::Call;
  3         4185  
  3         250  
8 3     3   3227 use UNIVERSAL qw/isa/;
  3         43  
  3         17  
9              
10             =head1 NAME
11              
12             DateTime::Event::Klingon - Determine events of Klingon cultural significance
13              
14             =head1 VERSION
15              
16             Version 1.0
17              
18             =cut
19              
20             our $VERSION = '1.0';
21              
22             =head1 SYNOPSIS
23              
24             use DateTime;
25             use DateTime::Event::Klingon qw/Heghlu'meH QaQ jajvam'a'/;
26              
27             my $dt = DateTime->now;
28             print 'Today ', Heghlu'meH QaQ jajvam'a'($dt) ? 'is' : 'is not',
29             " a good day to die!\n";
30              
31             =head1 DESCRIPTION
32              
33             Use this module to determine dates and times with special significance to the
34             Star Trek universe's Klingons.
35              
36             Function names are given in tlhIngan Hol. No functions are exported by default.
37              
38             =head1 FUNCTIONS
39              
40             =cut
41              
42             sub import {
43 2     2   22 my ( $self, @args ) = @_;
44              
45 2         7 my $joinedargs = join q{ }, @args;
46 2 100       22 if ( $joinedargs =~ /Heghlu'meH\ QaQ\ jajvam'a'/mx ) {
47             {
48 3     3   1578 no strict 'refs';
  3         9  
  3         1054  
  1         3  
49 1         4 my $caller = caller;
50              
51 1         19 *{"${caller}::_heghlu_meh_qaq_jajvam_a_"}
  1         3  
52 1         2 = \&{'_heghlu_meh_qaq_jajvam_a_'};
53             }
54              
55             return filter_add(
56             sub {
57 2     2   32853 my $count = 0;
58 2         5 my $status;
59 2         4 my $data = q{};
60 2         19 while ( $status = filter_read() ) {
61 13 50       27 if ( $status < 0 ) {
62 0         0 return $status;
63             }
64 13 50       32 if ( $status == 0 ) {
65 0         0 last;
66             }
67 13         19 $data .= $_;
68 13         20 $count++;
69 13         43 $_ = q{};
70             }
71 2 100       10 if ( $count == 0 ) {
72 1         173452 return 0;
73             }
74 1         3 $_ = $data;
75 1         20 s{ Heghlu'meH\ QaQ\ jajvam'a'(\s*\() }
76             { _heghlu_meh_qaq_jajvam_a_$1 }gmx;
77 1         26 return $count;
78             }
79 1         10 );
80             }
81             }
82              
83             =head2 Heghlu'meH QaQ jajvam'a' ($dt)
84              
85             Is today a good day to die? Given a C object, this function will
86             return true if it is and false if it is not.
87              
88             =cut
89              
90             sub _heghlu_meh_qaq_jajvam_a_ {
91 2     2   458 my ($dt) = @_;
92              
93 2 100       11 if ( !isa( $dt, 'DateTime' ) ) {
94 1         154 croak q{Hab SoSlI' Quch!};
95             }
96 1         8 return 1;
97             }
98              
99             =head1 AUTHOR
100              
101             Jaldhar H. Vyas, C<< >>
102              
103             =head1 BUGS
104              
105             Please report any other bugs or feature requests to C, or through
106             the web interface at L. I will be notified, and then you'll
107             automatically be notified of progress on your bug as I make changes.
108              
109             =head1 SUPPORT
110              
111             You can find documentation for this module with the perldoc command.
112              
113             perldoc DateTime::Event::Klingon
114              
115             You can also look for information at:
116              
117             =over 4
118              
119             =item * RT: CPAN's request tracker
120              
121             L
122              
123             =item * AnnoCPAN: Annotated CPAN documentation
124              
125             L
126              
127             =item * CPAN Ratings
128              
129             L
130              
131             =item * Search CPAN
132              
133             L
134              
135             =back
136              
137             =head1 SEE ALSO
138              
139             L
140              
141             =head1 COPYRIGHT & LICENSE
142              
143             Copyright (C) 2008 Consolidated Braincells Inc., all rights reserved.
144              
145             This program is free software; you can redistribute it and/or modify it
146             under the same terms as Perl itself.
147              
148             =cut
149              
150             1; # End of DateTime::Event::Klingon