File Coverage

lib/Log/Shiras/Telephone.pm
Criterion Covered Total %
statement 67 80 83.7
branch 11 20 55.0
condition 17 33 51.5
subroutine 16 16 100.0
pod 1 1 100.0
total 112 150 74.6


line stmt bran cond sub pod time code
1             package Log::Shiras::Telephone;
2             our $AUTHORITY = 'cpan:JANDREW';
3 2     2   1051 use version; our $VERSION = version->declare("v0.48.0");
  2         2  
  2         14  
4 2     2   148 use strict;
  2         2  
  2         36  
5 2     2   7 use warnings;
  2         2  
  2         50  
6 2     2   44 use 5.010;
  2         4  
7 2     2   8 use utf8;
  2         3  
  2         16  
8 2     2   44 use lib '../../';
  2         2  
  2         13  
9             #~ use Log::Shiras::Unhide qw( :InternalTelephonE );
10             ###InternalTelephonE warn "You uncovered internal logging statements for Log::Shiras::Telephone-$VERSION" if !@$ENV{hide_warn};
11 2     2   199 use Moose;
  2         2  
  2         14  
12 2     2   8393 use MooseX::StrictConstructor;
  2         3  
  2         14  
13 2     2   3859 use MooseX::HasDefaults::RO;
  2         3  
  2         14  
14 2     2   5915 use MooseX::Types::Moose qw( Bool ArrayRef HashRef Str );
  2         3  
  2         19  
15 2     2   6730 use Carp qw( longmess );
  2         3  
  2         104  
16 2     2   8 use Clone 'clone';
  2         2  
  2         70  
17 2     2   8 use Log::Shiras::Switchboard;
  2         2  
  2         13  
18             my $switchboard = Log::Shiras::Switchboard->instance;
19 2     2   138 use Log::Shiras::Types qw( NameSpace ElevenInt );
  2         2  
  2         13  
20              
21             #########1 Public Attributes 3#########4#########5#########6#########7#########8#########9
22              
23             has name_space =>(
24             isa => NameSpace,
25             writer => 'set_name_space',
26             reader => 'get_name_space',
27             default => sub{
28             my $name_space = (caller( 2 ))[3];
29             $name_space //= 'main';
30             return $name_space;
31             },
32             coerce => 1,
33             );
34              
35             has report =>(
36             isa => Str,
37             writer => 'set_report',
38             reader => 'get_report',
39             default => 'log_file',
40             );
41              
42             has level =>(
43             isa => ElevenInt|Str,
44             writer => 'set_level',
45             reader => 'get_level',
46             default => 11,
47             );
48              
49             has message =>(
50             isa => ArrayRef,
51             writer => 'set_shared_message',
52             reader => 'get_shared_message',
53             default => sub{ [ '' ] },# Empty strings are better handled than attempting to join or print undef
54             );
55              
56             has carp_stack =>(
57             isa => Bool,
58             writer => 'set_carp_stack',
59             reader => 'should_carp_longmess',
60             default => 0,
61             );
62              
63             has fail_over =>(
64             isa => Bool,
65             writer => 'set_fail_over',
66             reader => 'should_fail_over',
67             default => 0,
68             );
69              
70             #########1 Public Methods 3#########4#########5#########6#########7#########8#########9
71              
72             sub talk{
73 5     5 1 4635 my ( $self, @passed ) = @_;
74              
75             # Coerce the passed data into a standard format
76 5 100       25 my $test_adjust_1 = scalar( @passed ) % 2 == 0 ? { @passed } : undef;
77 5         9 my $test_adjust_2 = $passed[0];
78 5         9 my( $x, $data_ref )= ( 1, );
79 5         11 for my $attempt ( $test_adjust_1, $test_adjust_2 ){
80             ###InternalTelephonE $switchboard->master_talk( { report => 'log_file', level => 0,
81             ###InternalTelephonE name_space => 'Log::Shiras::Telephone::talk',
82             ###InternalTelephonE message => [ "Testing attempt:", $attempt ], } );
83 6 50 100     31 if( $attempt and is_HashRef( $attempt ) and
      33        
      66        
84             ( exists $attempt->{message} or exists $attempt->{ask} or
85             ( exists $attempt->{level} and $attempt->{level} =~ /fatal/i ) ) ){
86             ###InternalTelephonE $switchboard->master_talk( { report => 'log_file', level => 1,
87             ###InternalTelephonE name_space => 'Log::Shiras::Telephone::talk',
88             ###InternalTelephonE message => [ "Found a compatible ref on try: $x"], } );
89 4         566 $data_ref = $attempt;
90 4         7 last;
91             }
92 2         185 $x++;
93             }
94 5 50 33     22 $data_ref //= (is_ArrayRef( $passed[0] ) and scalar( @passed ) == 1) ? { message => $passed[0] } : { message => [ @passed ] };
      66        
95              
96             # Ensure a message key
97 5   66     200 $data_ref->{message} //= $self->get_shared_message;
98             # Ensure the message is an ArrayRef
99 5 50       18 $data_ref->{message} = is_ArrayRef( $data_ref->{message} ) ? $data_ref->{message} : [ $data_ref->{message} ];
100             ###InternalTelephonE $switchboard->master_talk( { report => 'log_file', level => 2,
101             ###InternalTelephonE name_space => 'Log::Shiras::Telephone::talk',
102             ###InternalTelephonE message => [ 'Resolved Log::Shiras::Telephone::talk to say:', $data_ref ], } );
103              
104             # Ensure a report key
105 5 100       573 if( !$data_ref->{report} ){
106             ###InternalTelephonE $switchboard->master_talk( { report => 'log_file', level => 3,
107             ###InternalTelephonE name_space => 'Log::Shiras::Telephone::talk',
108             ###InternalTelephonE message =>[ "No report destination was defined so the message will be sent to: " . $self->get_report, ]} );
109 1         27 $data_ref->{report} = $self->get_report;
110             }
111              
112             # Ensure a level key
113 5 100       14 if( !$data_ref->{level} ){
114             ###InternalTelephonE $switchboard->master_talk( { report => 'log_file', level => 3,
115             ###InternalTelephonE name_space => 'Log::Shiras::Telephone::level',
116             ###InternalTelephonE message =>[ "No urgency level was defined so the message will be sent at level: " . $self->get_level . " (These go to eleven)", ] } );
117 1         26 $data_ref->{level} = $self->get_level;
118             }
119              
120             # Ensure a name_space key
121 5   33     145 $data_ref->{name_space} //= $self->get_name_space;
122              
123             # Check for carp_stack
124 5   66     124 $data_ref->{carp_stack} //= $self->should_carp_longmess;
125              
126             # Set the source_sub (Fixed for this class)
127 5         10 $data_ref->{source_sub} = 'Log::Shiras::Telephone::talk';
128              
129             # Checking if input is requested ( ask => 1 )
130             ###InternalTelephonE $switchboard->master_talk( { report => 'log_file', level => 1,
131             ###InternalTelephonE name_space => 'Log::Shiras::Telephone::talk',
132             ###InternalTelephonE message => [ "Current urgency -$data_ref->{level}- for destination -" .
133             ###InternalTelephonE $data_ref->{report} . '- from NameSpace: ' . $data_ref->{name_space},
134             ###InternalTelephonE "Checking if input is requested" ], } );
135 5 50       15 if( $data_ref->{ask} ){
136             ###InternalTelephonE $self->master_talk( { report => 'log_file', level => 3,
137             ###InternalTelephonE name_space => 'Log::Shiras::Telephone::talk',
138             ###InternalTelephonE message =>[ "Input request confirmed" ], } );
139 0         0 my $ask_ref = clone( $data_ref->{message} );
140 0         0 unshift @{$ask_ref}, "Adding to message -";
  0         0  
141 0         0 push @$ask_ref, ($data_ref->{name_space} . " asked for input:", $data_ref->{ask});
142 0         0 print STDOUT join "\n", @$ask_ref;
143 0         0 my $input = <>;
144 0         0 chomp $input;
145 0 0 0     0 if( $input and length( $input ) > 0 ){
146 0         0 push @{$data_ref->{message}}, $input;
  0         0  
147             }
148             }
149              
150             # Dispatch the message
151 5         17 my $report_count = $switchboard->master_talk( $data_ref );
152             ###InternalTelephonE $switchboard->master_talk( { report => 'log_file', level => 2,
153             ###InternalTelephonE name_space => 'Log::Shiras::Telephone::talk',
154             ###InternalTelephonE message => [ "Message reported |$report_count| times" ], } );
155              
156             # Handle fail_over
157 4 50 33     114 if( $report_count < 1 and ( $data_ref->{fail_over} or $self->should_fail_over) ){
      66        
158             ###InternalTelephonE $switchboard->master_talk( { report => 'log_file', level => 4,
159             ###InternalTelephonE name_space => 'Log::Shiras::Telephone::talk',
160             ###InternalTelephonE message => [ "Message allowed but found no destination!", $data_ref->{message} ], } );
161 0 0       0 warn longmess( "This message sent to the report -$data_ref->{report}- was approved but found no destination objects to use" ) if !$ENV{hide_warn};
162 0         0 print STDOUT join( "\n\t", @{$data_ref->{message}} ) . "\n";
  0         0  
163             }
164              
165             # Return the result
166 4         30 return $report_count;
167             }
168              
169             #########1 Private Attributes 3#########4#########5#########6#########7#########8#########9
170              
171              
172              
173             #########1 Private Methods 3#########4#########5#########6#########7#########8#########9
174              
175              
176              
177             #########1 Phinish 3#########4#########5#########6#########7#########8#########9
178              
179 2     2   7239 no Moose;
  2         3  
  2         9  
180             __PACKAGE__->meta->make_immutable;
181              
182             1;
183              
184             #########1 Documentation 3#########4#########5#########6#########7#########8#########9
185             __END__
186              
187             =head1 NAME
188              
189             Log::Shiras::Telephone - Send messages with Log::Shiras
190              
191             =head1 SYNOPSIS
192              
193             package MyCoolPackage;
194             use Moose;
195             use lib 'lib', '../lib',;
196             use Log::Shiras::Telephone;
197              
198             sub make_a_noise{
199             my( $self, $message ) = @_;
200             my $phone = Log::Shiras::Telephone->new(
201             name_space => 'TellMeAbout::make_a_noise',
202             fail_over => 1,
203             report => 'spy',
204             );
205             $phone->talk( level => 'debug',
206             message => "Arrived at make_a_noise with the message: $message" );
207             print '!!!!!!!! ' . uc( $message ) . " !!!!!!!!!\n";
208             $phone->talk( level => 'info',
209             message => "Finished printing message" );
210             }
211              
212             package main;
213              
214             use Modern::Perl;
215             use Log::Shiras::Switchboard;
216             use Log::Shiras::Report::Stdout;
217             use MyCoolPackage;
218             $| = 1;
219             my $agitation = MyCoolPackage->new;
220             $agitation->make_a_noise( 'Hello World 1' );#
221             my $operator = Log::Shiras::Switchboard->get_operator(
222             name_space_bounds =>{
223             TellMeAbout =>{
224             make_a_noise =>{
225             UNBLOCK =>{
226             # UNBLOCKing the report (destinations)
227             # at the 'TellMeAbout::make_a_noise' caller name_space and deeper
228             spy => 'info',# for info and more urgent messages
229             },
230             },
231             },
232             },
233             );
234             $agitation->make_a_noise( 'Hello World 2' );#
235             $operator->add_reports(
236             spy =>[ Print::Log->new, ],
237             );
238             $agitation->make_a_noise( 'Hello World 3' );#
239              
240             #######################################################################################
241             # Synopsis Screen Output
242             # 01: !!!!!!!! HELLO WORLD 1 !!!!!!!!!
243             # 02: !!!!!!!! HELLO WORLD 2 !!!!!!!!!
244             # 03: This message sent to the report -spy- was approved but found no destination objects to use at log_shiras_telephone.pl line 16, <DATA> line 1.
245             # 04: MyCoolPackage::make_a_noise(MyCoolPackage=HASH(0x58df970), "Hello World 2") called at log_shiras_telephone.pl line 67
246             # 05: Finished printing message
247             # 06: !!!!!!!! HELLO WORLD 3 !!!!!!!!!
248             # 07: | level - info | name_space - TellMeAbout::make_a_noise
249             # 08: | line - 0016 | file_name - log_shiras_telephone.pl
250             # 09: :( Finished printing message ):
251             #######################################################################################
252              
253             =head2 SYNOPSIS EXPLANATION
254              
255             =head3 Output explanation
256              
257             01: This is the result of
258              
259             $agitation->make_a_noise( 'Hello World 1' );
260              
261             Where the output is processed by the make_a_noise method of the package MyCoolPackage
262              
263             02: Same as line 01
264              
265             03-05: The switchboard actually turned on permissions for some logging from MyCoolPackage
266             prior to the output from line 02 but there was no report destination available so the
267             'fail_over' attribute kicked in and printed the message out with a warning.
268              
269             06: Same as line 01
270              
271             07-09: This time before the output for line 06 was sent an actual report object was
272             registered in the switchboard against the 'spy' report name that MyCoolPackage was
273             sending logging messages to. These lines are the result of that report object
274             L<Log::Shiras::Report::Stdout> with the note that line 09: and line 05: have the same
275             content but ~::Report::Stdout leverages some of the meta-data in the message to create
276             a more informative output set.
277              
278             =head1 DESCRIPTION
279              
280             This is a convenience wrapper for the method
281             L<Log::Shiras::Switchboard/master_talk( $args_ref )>. It also provides some
282             additional function not provided in the leaner and stricter master_talk method. First,
283             the input is more flexible allowing for several ways to compose the message. Second,
284             most of the L<Attributes|/Attributes> of a phone are sent as the key parts of a
285             message ref for to the Switchboard. Each of these attributes has a default allowing for
286             them to be ommited from the phone L<talk|/talk( %args )> method call. Third, the phone has
287             an additional attribute L<fail_over|/fail_over> which can be used to trigger printing the
288             message when it is cleared by the switchboard but a report object isn't built yet. This
289             will allow for development work on writing messages without having to predefine the full
290             output destination. Finally, built into 'talk' is the ability to request input with the
291             'ask' key. This is done without accessing the Switchboard. This creates a range of uses
292             for the 'talk' command. It is possible to call 'talk' with no arguments and only collect
293             the metadata for that script point to be sent to a destination log. Any talk command
294             merges the response into the message.
295              
296             Updating the default $phone attributes are done with the L<attribute methods
297             |/attribute methods>.
298              
299             Please note the effect of calling level => 'fatal' documented in
300             L<Log::Shiras::Switchboard/logging_levels>
301              
302             Please also note that the switchboard will add some meta data to the message before
303             it passes the message on to the report. See the documentation in
304             L<Log::Shiras::Switchboard/master_talk( $args_ref )>
305              
306             This module is meant to work with L<Log::Shiras::Switchboard> at run time. When
307             collecting output from the phone the switchboard must be activated to enable desired
308             messages to get through. For an overview of the package see L<Log::Shiras>.
309              
310             =head2 Attributes
311              
312             Data passed to ->new when creating an instance. For modification of these attributes
313             after the instance is created see the attribute methods.
314              
315             =head3 name_space
316              
317             =over
318              
319             B<Definition:> This is meant to represent the 'from' designation of a Telephone call. This
320             attribute stores the specific point in a hierarchical name-space used by the instance of
321             this class. The name-space position called does not have to be unique. The name-space is
322             identified in a string where levels of the name-space in the string are marked with '::'.
323             If this attribute receives an array ref then it joins the elements of the array ref with '::'.
324              
325             B<Default:> If no name-space is passed then this attribute defaults to the value returned
326             by
327              
328             (caller( 2 ))[3]
329              
330             which is driven by the location where the ->new command is called.
331              
332             B<Range:> L<Log::Shiras::Types/NameSpace>
333              
334             B<attribute methods>
335              
336             =over
337              
338             B<set_name_space>
339              
340             =over
341              
342             B<Description> used to set the attribute
343              
344             =back
345              
346             B<get_name_space>
347              
348             =over
349              
350             B<Description> used to return the current attribute value
351              
352             =back
353              
354             =back
355              
356             =back
357              
358             =head3 report
359              
360             =over
361              
362             B<Definition:> This is meant to represent the 'to' nature of a Telephone call. This
363             attribute stores the specific destination name in a flat name-space for this instance
364             of this class.
365              
366             B<Default:> 'log_file'
367              
368             B<Range:> a string
369              
370             B<attribute methods>
371              
372             =over
373              
374             B<set_report>
375              
376             =over
377              
378             B<Description> used to set the attribute
379              
380             =back
381              
382             B<get_report>
383              
384             =over
385              
386             B<Description> used to return the current attribute value
387              
388             =back
389              
390             =back
391              
392             =back
393              
394             =head3 level
395              
396             =over
397              
398             B<Definition:> This represents the urgency for which the message is sent. A message
399             level of fatal will kill the script if the Switchboard permissions are set to allow
400             it through.
401              
402             B<Default:> 11 = 'eleven' or the very highest setting (urgency)
403              
404             B<Range:> L<Log::Shiras::Types/ElevenInt> or L<Log::Shiras::Switchboard/logging_levels>
405              
406             B<attribute methods>
407              
408             =over
409              
410             B<set_level>
411              
412             =over
413              
414             B<Description> used to set the attribute
415              
416             =back
417              
418             B<get_level>
419              
420             =over
421              
422             B<Description> used to return the current attribute value
423              
424             =back
425              
426             =back
427              
428             =back
429              
430             =head3 message
431              
432             =over
433              
434             B<Definition:> This is a message ref that will be sent to the report.
435              
436             B<Default:> [ '' ]
437              
438             B<Range:> an ArrayRef or a string (which will be used as [ $string ] ) If you wish
439             to send a $hashref send it as [ $hashref ].
440              
441             B<attribute methods>
442              
443             =over
444              
445             B<set_shared_message>
446              
447             =over
448              
449             B<Description> used to set the attribute
450              
451             =back
452              
453             B<get_shared_message>
454              
455             =over
456              
457             B<Description> used to return the current attribute value
458              
459             =back
460              
461             =back
462              
463             =back
464              
465             =head3 carp_stack
466              
467             =over
468              
469             B<Definition:> This is a flag used to append the message with a L<Carp> - longmess
470              
471             B<Default:> 0 = No appended longmess
472              
473             B<Range:> 1 or 0
474              
475             B<attribute methods>
476              
477             =over
478              
479             B<set_carp_stack>
480              
481             =over
482              
483             B<Description> used to set the attribute
484              
485             =back
486              
487             B<should_carp_longmess>
488              
489             =over
490              
491             B<Description> used to return the current attribute value
492              
493             =back
494              
495             =back
496              
497             =back
498              
499             =head3 fail_over
500              
501             =over
502              
503             B<Definition:> This attribute stores a boolean value that acts as a switch to turn off or
504             on an outlet to messages sent via ->talk that are approved based on name_space and urgency
505             but do not find any report objects to interact with. If fail_over is on then the 'message'
506             elements are printed to STDOUT. (joined by "\n\t",) This is a helpfull
507             feature when writing code containing the Telephone but you don't want to set up a
508             report to see what is going on. You can managage a whole script by having a
509             $fail_over variable at the top that is used to set each of the fail_over attributes for
510             new telephones. That way you can turn this on or off for the whole script at once if
511             you want.
512              
513             B<Default:> 0 = off -> unreported succesfull messages die silently
514              
515             B<Range:> a boolean 1 or 0
516              
517             B<attribute methods>
518              
519             =over
520              
521             B<set_fail_over>
522              
523             =over
524              
525             B<Description> used to set the attribute
526              
527             =back
528              
529             B<should_fail_over>
530              
531             =over
532              
533             B<Description> used to return the current attribute value
534              
535             =back
536              
537             =back
538              
539             =back
540              
541             =head2 Methods
542              
543             =head3 new( %args )
544              
545             =over
546              
547             B<Definition:> This creates a new instance of the Telephone class. It is used to talk
548             to L<reports|Log::Shiras::Switchboard/reports> through the switchboard.
549              
550             B<Range:> This is a L<Moose|Moose::Manual> class and new is managed by Moose. It
551             will accept any or none of the L<Attributes|/Attributes>
552              
553             B<Returns:> A phone instance that can be used to 'talk' to reports.
554              
555             =back
556              
557             =head3 talk( %args )
558              
559             =over
560              
561             B<Definition:> This is the method to place a call to a L<reports|Log::Shiras::Switchboard/reports> name.
562             The talk command accepts any of the attributes as arguments as well as an 'ask' key. The
563             ask key set to 1 will cause the telephone to pause for input and append that input to the
564             'message'. Any passed key that matches an attribute will locally implement the passed value
565             without overwriting the default value. The passed %args with attribute keys can either be
566             a Hash or a HashRef. If the passed content does not show either a message key, an ask key,
567             or a level key set to fatal then it is assumed to be the message and 'talk' will re-wrap it
568             with a message key into a hashref. If you want the message to be a HashRef then it has to
569             reside inside of an ArrayRef. ex.
570              
571             [ { ~ my message hash ~ } ],
572              
573             When the message has been coerced into a format that the Switchboard will consume the {ask}
574             key is tested and implemented. After the ask key processing is complete the message is
575             sent to L<Log::Shiras::Switchboard/master_talk( $args_ref )>. The return value from that
576             call is then evaluated against the attribute L<fail_over|/fail_over>. If needed the
577             message is output at that time. It should be noted that the results of the 'master_talk'
578             can fall in the following range.
579              
580             -3 = The call was not allowed by name_space permissions set in the switchboard
581             -2 = The message was buffered rather than sent to a report
582             -1 = You should never get this from a Telephone talk call
583             0 = The call had permissions but found no report implementations to connect with
584             1(and greater) = This indicates how many report instances received the message
585              
586             fail_over is only implemented on a '0' return. Read the L<name_space_bounds
587             |Log::Shiras::Switchboard/name_space_bounds> documentation to understand how the switchboard
588             handles message filtering. I<Note: the switchboard will set the urgency level of a call to
589             0 if a level name is sent but it does not match the L<available log level list
590             |Log::Shiras::Switchboard/logging_levels> for the destination report held by the
591             Switchboard>.
592              
593             B<Returns:> The number of times the message was sent to a report object with 'add_line'
594              
595             =back
596              
597             =head1 GLOBAL VARIABLES
598              
599             =over
600              
601             =item B<$ENV{hide_warn}>
602              
603             The module will warn if debug lines are 'Uhide'n. In the case where the you don't want
604             this notification set this environmental variable to true.
605              
606             =back
607              
608             =head1 SUPPORT
609              
610             =over
611              
612             L<Log-Shiras/issues|https://github.com/jandrew/Log-Shiras/issues>
613              
614             =back
615              
616             =head1 TODO
617              
618             =over
619              
620             B<1.> Nothing L<currently|/SUPPORT>
621              
622             =back
623              
624             =head1 AUTHOR
625              
626             =over
627              
628             =item Jed Lund
629              
630             =item jandrew@cpan.org
631              
632             =back
633              
634             =head1 COPYRIGHT
635              
636             This program is free software; you can redistribute
637             it and/or modify it under the same terms as Perl itself.
638              
639             The full text of the license can be found in the
640             LICENSE file included with this module.
641              
642             =head1 DEPENDENCIES
643              
644             =over
645              
646             L<perl 5.010|perl/5.10.0>
647              
648             L<version>
649              
650             L<Moose>
651              
652             L<MooseX::StrictConstructor>
653              
654             L<MooseX::HasDefaults::RO>
655              
656             L<MooseX::Types::Moose>
657              
658             =back
659              
660             =cut
661              
662             #########1#########2 main pod documentation end 5#########6#########7#########8#########9