File Coverage

lib/Log/Shiras/Telephone.pm
Criterion Covered Total %
statement 61 74 82.4
branch 11 20 55.0
condition 17 33 51.5
subroutine 14 14 100.0
pod 1 1 100.0
total 104 142 73.2


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