File Coverage

blib/lib/SQL/Dialects/Role.pm
Criterion Covered Total %
statement 25 25 100.0
branch 4 4 100.0
condition n/a
subroutine 4 4 100.0
pod 1 1 100.0
total 34 34 100.0


line stmt bran cond sub pod time code
1             package SQL::Dialects::Role;
2              
3             #########################################################################
4             #
5             # This module is copyright (c), 2009 by Michael G. Schwern
6             # This module is copyright (c), 2009-2020 by Jens Rehsack.
7             # All rights reserved.
8             #
9             # It may be freely distributed under the same terms as Perl itself.
10             #
11             # See below for help (search for SYNOPSIS)
12             #########################################################################
13              
14 16     16   74200 use strict;
  16         42  
  16         523  
15 16     16   78 use warnings FATAL => "all";
  16         32  
  16         594  
16              
17 16     16   84 use base qw(Exporter);
  16         34  
  16         5994  
18             our @EXPORT = qw(get_config_as_hash);
19             our $VERSION = '1.414';
20              
21             sub get_config_as_hash
22             {
23 18     18 1 134 my $class = $_[0];
24              
25 18         62 my @data = split( m/\n/, $class->get_config() );
26              
27 18         57 my %config;
28             my $feature;
29 18         43 for (@data)
30             {
31 4856         5788 chomp;
32 4856         6605 s/^\s+//;
33 4856         6469 s/\s+$//;
34 4856 100       6989 next unless ($_);
35 4785 100       7215 if (/^\[(.*)\]$/i)
36             {
37 87         224 $feature = lc $1;
38 87         282 $feature =~ s/\s+/_/g;
39 87         162 next;
40             }
41 4698         5960 my $newopt = uc $_;
42 4698         6174 $newopt =~ s/\s+/ /g;
43 4698         9482 $config{$feature}{$newopt} = 1;
44             }
45              
46 18         354 return \%config;
47             }
48              
49             =head1 NAME
50              
51             SQL::Dialects::Role - The role of being a SQL::Dialect
52              
53             =head1 SYNOPSIS
54              
55             package My::SQL::Dialect;
56              
57             use SQL::Dialects::Role;
58              
59             sub get_config {
60             return <
61             [SECTION]
62             item1
63             item2
64              
65             [ANOTHER SECTION]
66             item1
67             item2
68             CONFIG
69             }
70              
71             =head1 DESCRIPTION
72              
73             This adds the role of being a SQL::Dialect to your class.
74              
75             =head2 Requirements
76              
77             You must implement...
78              
79             =head3 get_config
80              
81             my $config = $class->get_config;
82              
83             Returns information about the dialect in an INI-like format.
84              
85             =head2 Implements
86              
87             The role implements...
88              
89             =head3 get_config_as_hash
90              
91             my $config = $class->get_config_as_hash;
92              
93             Returns the data represented in get_config() as a hash ref.
94              
95             Items will be upper-cased, sections will be lower-cased.
96              
97             The example in the SYNOPSIS would come back as...
98              
99             {
100             section => {
101             ITEM1 => 1,
102             ITEM2 => 2,
103             },
104             another_section => {
105             ITEM1 => 1,
106             ITEM2 => 2,
107             }
108             }
109              
110             =head1 AUTHOR & COPYRIGHT
111              
112             This module is
113              
114             copyright (c), 2009 by Michael G. Schwern
115             copyright (c), 2009-2020 by Jens Rehsack.
116              
117             All rights reserved.
118              
119             The module may be freely distributed under the same terms as
120             Perl itself using either the "GPL License" or the "Artistic
121             License" as specified in the Perl README file.
122              
123             Jeff can be reached at: jzuckerATcpan.org
124             Jens can be reached at: rehsackATcpan.org or via dbi-devATperl.org
125              
126             =head1 SEE ALSO
127              
128             L
129              
130             =cut