summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl/lib/Log/Message/Config.pm
blob: fff771bbb8aa75bde01d8a066c20b16868e61697 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
package Log::Message::Config;
use strict;

use Params::Check qw[check];
use Module::Load;
use FileHandle;
use Locale::Maketext::Simple Style => 'gettext';

BEGIN {
    use vars        qw[$VERSION $AUTOLOAD];
    $VERSION    =   0.04;
}

sub new {
    my $class = shift;
    my %hash  = @_;

    ### find out if the user specified a config file to use
    ### and/or a default configuration object
    ### and remove them from the argument hash
    my %special =   map { lc, delete $hash{$_} }
                    grep /^config|default$/i, keys %hash;

    ### allow provided arguments to override the values from the config ###
    my $tmpl = {
        private => { default => undef,  },
        verbose => { default => 1       },
        tag     => { default => 'NONE', },
        level   => { default => 'log',  },
        remove  => { default => 0       },
        chrono  => { default => 1       },
    };

    my %lc_hash = map { lc, $hash{$_} } keys %hash;

    my $file_conf;
    if( $special{config} ) {
        $file_conf = _read_config_file( $special{config} )
                        or ( warn( loc(q[Could not parse config file!]) ), return );
    }

    my $def_conf = \%{ $special{default} || {} };

    ### make sure to only include keys that are actually defined --
    ### the checker will assign even 'undef' if you have provided that
    ### as a value
    ### priorities goes as follows:
    ### 1: arguments passed
    ### 2: any config file passed
    ### 3: any default config passed
    my %to_check =  map     { @$_ }
                    grep    { defined $_->[1] }
                    map     {   [ $_ =>
                                    defined $lc_hash{$_}        ? $lc_hash{$_}      :
                                    defined $file_conf->{$_}    ? $file_conf->{$_}  :
                                    defined $def_conf->{$_}     ? $def_conf->{$_}   :
                                    undef
                                ]
                            } keys %$tmpl;

    my $rv = check( $tmpl, \%to_check, 1 )
                or ( warn( loc(q[Could not validate arguments!]) ), return );

    return bless $rv, $class;
}

sub _read_config_file {
    my $file = shift or return;

    my $conf = {};
    my $FH = new FileHandle;
    $FH->open("$file") or (
                        warn(loc(q[Could not open config file '%1': %2],$file,$!)),
                        return {}
                    );

    while(<$FH>) {
        next if     /\s*#/;
        next unless /\S/;

        chomp; s/^\s*//; s/\s*$//;

        my ($param,$val) = split /\s*=\s*/;

        if( (lc $param) eq 'include' ) {
            load $val;
            next;
        }

        ### add these to the config hash ###
        $conf->{ lc $param } = $val;
    }
    close $FH;

    return $conf;
}

sub AUTOLOAD {
    $AUTOLOAD =~ s/.+:://;

    my $self = shift;

    return $self->{ lc $AUTOLOAD } if exists $self->{ lc $AUTOLOAD };

    die loc(q[No such accessor '%1' for class '%2'], $AUTOLOAD, ref $self);
}

sub DESTROY { 1 }

1;

__END__

=pod

=head1 NAME

Log::Message::Config - Configuration options for Log::Message

=head1 SYNOPSIS

    # This module is implicitly used by Log::Message to create a config
    # which it uses to log messages.
    # For the options you can pass, see the C<Log::Message new()> method.

    # Below is a sample of a config file you could use

    # comments are denoted by a single '#'
    # use a shared stack, or have a private instance?
    # if none provided, set to '0',
    private = 1

    # do not be verbose
    verbose = 0

    # default tag to set on new items
    # if none provided, set to 'NONE'
    tag = SOME TAG

    # default level to handle items
    # if none provided, set to 'log'
    level = carp

    # extra files to include
    # if none provided, no files are auto included
    include = mylib.pl
    include = ../my/other/lib.pl

    # automatically delete items
    # when you retrieve them from the stack?
    # if none provided, set to '0'
    remove = 1

    # retrieve errors in chronological order, or not?
    # if none provided, set to '1'
    chrono = 0

=head1 DESCRIPTION

Log::Message::Config provides a standardized config object for
Log::Message objects.

It can either read options as perl arguments, or as a config file.
See the Log::Message manpage for more information about what arguments
are valid, and see the Synopsis for an example config file you can use

=head1 SEE ALSO

L<Log::Message>, L<Log::Message::Item>, L<Log::Message::Handlers>

=head1 AUTHOR

This module by
Jos Boumans E<lt>kane@cpan.orgE<gt>.

=head1 Acknowledgements

Thanks to Ann Barcomb for her suggestions.

=head1 COPYRIGHT

This module is
copyright (c) 2002 Jos Boumans E<lt>kane@cpan.orgE<gt>.
All rights reserved.

This library is free software;
you may redistribute and/or modify it under the same
terms as Perl itself.

=cut

# Local variables:
# c-indentation-style: bsd
# c-basic-offset: 4
# indent-tabs-mode: nil
# End:
# vim: expandtab shiftwidth=4: