File Coverage

blib/lib/MySQL/Diff/Utils.pm
Criterion Covered Total %
statement 14 26 53.8
branch 1 10 10.0
condition 1 3 33.3
subroutine 5 7 71.4
pod 3 3 100.0
total 24 49 48.9


line stmt bran cond sub pod time code
1             package MySQL::Diff::Utils;
2              
3             =head1 NAME
4              
5             MySQL::Diff::Utils - Supporting functions for MySQL:Diff
6              
7             =head1 SYNOPSIS
8              
9             use MySQL::Diff::Utils qw(debug_level debug);
10              
11             =head1 DESCRIPTION
12              
13             Currently contains the debug message handling routines.
14              
15             =cut
16              
17 4     4   14 use warnings;
  4         16  
  4         115  
18 4     4   17 use strict;
  4         4  
  4         126  
19              
20             our $VERSION = '0.49';
21              
22             # ------------------------------------------------------------------------------
23             # Libraries
24              
25 4     4   785 use IO::File;
  4         8387  
  4         408  
26              
27             # ------------------------------------------------------------------------------
28             # Export Components
29              
30 4     4   23 use base qw(Exporter);
  4         5  
  4         1007  
31             our @EXPORT_OK = qw(debug_file debug_level debug);
32              
33             # ------------------------------------------------------------------------------
34              
35             =head1 FUNCTIONS
36              
37             =head2 Public Functions
38              
39             Fuller documentation will appear here in time :)
40              
41             =over 4
42              
43             =item * debug_file( $file )
44              
45             Accessor to set/get the current debug log file.
46              
47             =item * debug_level( $level )
48              
49             Accessor to set/get the current debug level for messages.
50              
51             Current levels range from 1 to 4, with 1 being very brief processing messages,
52             2 providing high level process flow messages, 3 providing low level process
53             flow messages and 4 providing data dumps, etc where appropriate.
54              
55             =item * debug
56              
57             Writes to debug log file (if specified) and STDERR the given message, provided
58             is equal to or lower than the current debug level.
59              
60             =back
61              
62             =cut
63              
64             {
65             my $debug_file;
66             my $debug_level = 0;
67              
68             sub debug_file {
69 0     0 1 0 my ($new_debug_file) = @_;
70 0 0       0 $debug_file = $new_debug_file if defined $new_debug_file;
71 0         0 return $debug_file;
72             }
73              
74             sub debug_level {
75 0     0 1 0 my ($new_debug_level) = @_;
76 0 0       0 $debug_level = $new_debug_level if defined $new_debug_level;
77 0         0 return $debug_level;
78             }
79              
80             sub debug {
81 19     19 1 15 my $level = shift;
82 19 50 33     43 return unless($debug_level >= $level && @_);
83              
84 0 0         if($debug_file) {
85 0 0         if(my $fh = IO::File->new($debug_file, 'a+')) {
86 0           print $fh @_,"\n";
87 0           $fh->close;
88 0           return;
89             }
90             }
91            
92 0           print STDERR @_,"\n";
93             }
94            
95             }
96              
97             1;
98              
99             __END__