source: xas-model/trunk/lib/XAS/Model/Schema.pm @ 86bc3cc2774d9bff0dc6acf1083ca266d184b9e6

Revision 86bc3cc2774d9bff0dc6acf1083ca266d184b9e6, 7.5 KB checked in by Kevin L. Esteb <kevin@…>, 5 years ago (diff)

Updated documentation

  • Property mode set to 100644
Line 
1package XAS::Model::Schema;
2
3use strict;
4use warnings;
5
6our $VERSION = '0.01';
7
8use Badger::Filesystem 'File';
9use XAS::Lib::Modules::Environment;
10use base 'DBIx::Class::Schema::Config';
11
12BEGIN {
13
14    # ---------------------------------------------------------------------
15    # Define DBIx::Class::Schema::Config configuration file locations
16    #
17    # Format of the configuration file is as follows:
18    #
19    # [progress]             - corresponds to what is given to opendb()
20    # dbname = monitor       - name of the database
21    # dsn = SQLite           - corresponds to the dbd driver
22    # username = username    - the user context to use
23    # password = password    - the password for that context
24    #
25    # When using ODBC with a user level DSN or a dynamic connection, you
26    # should add the following items:
27    #
28    # driver = SQL Server
29    # server = localhost,1234
30    #
31    # When using PostgresSQL (Pg), you can add the following items:
32    #
33    # port = 5432
34    # host = localhost
35    # sslmode = something
36    # options = something
37    #
38    # Or a service name, which is not compatiable with the above.
39    #
40    # service = service name
41    #
42    # There can be multiple stanzas, the first one that matches is used.
43    # ---------------------------------------------------------------------
44
45    my $env = XAS::Lib::Modules::Environment->new();
46    my $path = $env->root;
47
48    # -----------------------------------------------------------------
49    # Defining where our database.ini file could be
50    # -----------------------------------------------------------------
51
52    if ($^O eq "MSWin32") {
53
54        __PACKAGE__->config_paths([(
55            File($path, 'etc', 'database')->path,
56            File($ENV{USERPROFILE}, 'database')->path,
57        )]);
58
59    } else {
60
61        __PACKAGE__->config_paths([(
62            File($path, 'etc', 'xas', 'database')->path,
63            File($ENV{HOME}, '.database')->path,
64        )]);
65
66    }
67
68    # ---------------------------------------------------------------------
69    # Defining our DBIx::Class exception handler
70    # ---------------------------------------------------------------------
71
72    __PACKAGE__->exception_action(\&XAS::Model::Schema::dbix_exceptions);
73
74}
75
76# ---------------------------------------------------------------------
77# Set some default configuration options
78# ---------------------------------------------------------------------
79
80sub filter_loaded_credentials {
81    my $class        = shift;
82    my $config       = shift;
83    my $connect_args = shift;
84
85    $config = {} if ($config eq '');
86
87    $config->{dbi_attr}->{AutoCommit} = 1;
88    $config->{dbi_attr}->{PrintError} = 0;
89    $config->{dbi_attr}->{RaiseError} = 1;
90
91    if ($config->{dsn} eq 'SQLite') {
92
93        $config->{dbi_attr}->{sqlite_use_immediate_transaction} = 1;
94        $config->{dbi_attr}->{sqlite_see_if_its_a_number} = 1;
95        $config->{dbi_attr}->{on_connect_call} = 'use_foreign_keys';
96
97        $config->{dsn} = "dbi:$config->{dsn}:dbname=$config->{dbname}";
98
99    } elsif ($config->{dsn} eq 'ODBC') {
100
101        # http://dolio.lh.net/~apw/doc/HOWTO/HOWTO-Connect_Perl_to_SQL_Server.pdf
102        #
103        # a user level DSN or a dynamic connection needs the following:
104        #
105        # dbi:ODBC:Driver={driver};Server=server;Database=dbname
106        #
107        # a system level DSN needs the following:
108        #
109        # dbi:ODBC:dbname
110        #
111
112        if (defined($config->{driver})) {
113
114            $config->{dsn} = sprintf(
115                "dbi:%s:Driver={%s};Database=%s;Server=%s",
116                $config->{dsn}, $config->{driver},
117                $config->{dbname}, $config->{server}
118            );
119
120        } else {
121
122            $config->{dsn} = "dbi:$config->{dsn}:$config->{dbname}";
123   
124        }
125
126    } elsif ($config->{dsn} eq 'Pg') {
127
128        unless (defined($config->{service})) {
129
130            $config->{dsn}  = "dbi:$config->{dsn}:dbname=$config->{dbname}";
131            $config->{dsn} .= ";host=$config->{host}" if (defined($config->{host}));
132            $config->{dsn} .= ";port=$config->{port}" if (defined($config->{port}));
133            $config->{dsn} .= ";options=$config->{options}" if (defined($config->{options}));
134            $config->{dsn} .= ";sslnode=$config->{sslmode}" if (defined($config->{sslmode}));
135
136        } else {
137
138            $config->{dsn} = "dbi:$config->{dsn}:service=$config->{service}";
139
140        }
141
142    } else {
143
144        $config->{dsn} = "dbi:$config->{dsn}:dbname=$config->{dbname}";
145
146    }
147
148    return $config;
149
150}
151
152sub dbix_exceptions {
153    my $error = shift;
154
155    $error =~ s/dbix.class error - //;
156
157    my $ex = XAS::Exception->new(
158        type => 'dbix.class',
159        info => sprintf("%s", $error)
160    );
161
162    $ex->throw;
163
164}
165
166sub opendb {
167    my $class = shift;
168
169    return $class->connect(@_);
170
171}
172
1731;
174
175__END__
176
177=head1 NAME
178
179XAS::Model::Schema - A class for the XAS environment
180
181=head1 SYNOPSIS
182
183 use XAS::Model::Schema;
184 use XAS::Mode::Database;
185
186 XAS::Model::Database->schema('XAS::Model::Database::Testing');
187 my $schema = XAS::Model::Schema->opendb('testing');
188
189=head1 DESCRIPTION
190
191This module loads database connection information from a file. This
192file may be located in the users home directory or in the XAS config directory.
193With the usual convention of the user specific file will override the global
194generic file. This file is named database.ini.
195
196Format of the configuration file is as follows:
197
198 [progress]             - corresponds to what is given to opendb()
199 dbname = monitor       - name of the database
200 dsn = SQLite           - corresponds to the dbd driver
201 user = username        - the user context to use
202 password = password    - the password for that context
203
204When using ODBC with a user level DSN or a dynamic connection, you
205should add the following items:
206
207 driver = SQL Server
208 server = localhost,1234 - (host,port)
209
210When using PostgresSQL (Pg), you can add the following items:
211
212 port = 5432
213 host = localhost
214 sslmode = something
215 options = something
216
217Or a service name, which is not compatible with the above.
218
219 service = service name
220
221There can be multiple stanzas, the first one that matches is used.
222
223=head1 METHODS
224
225=head2 opendb($database)
226
227This method makes the connection to the database. It takes these parameters:
228
229=over 4
230
231=item B<$database>
232
233The name of the database. This is defined in the database.ini file.
234
235=back
236
237=head2 dbix_exceptions($error)
238
239This method converts the internal DBIx::Class exceptions into a XAS exception.
240It takes these parameters:
241
242=over 4
243
244=item B<$error>
245
246The error string supplied by DBIx::Class
247
248=back
249
250=head2 filter_loaded_credentials($class, $config, $connect_args)
251
252This method is an override for the one provided by L<DBIx::Class::Schema::Config|https://metacpan.org/pod/DBIx::Class::Schema::Config>.
253It sets various defaults to be used when connecting to certain databases.
254There are defaults for SQLite, PostgreSQL and ODBC connections. The following
255parameters are supplied from DBIx::Class::Schema::Config.
256
257=over 4
258
259=item B<$class>
260
261=item B<$config>
262
263=item B<$connecti_args>
264
265=back
266
267=head1 SEE ALSO
268
269=over 4
270
271=item L<XAS|XAS>
272
273=item L<DBIx::Class::Schema::Config|https://metacpan.org/pod/DBIx::Class::Schema::Config>
274
275=back
276
277=head1 AUTHOR
278
279Kevin L. Esteb, E<lt>kevin@kesteb.usE<gt>
280
281=head1 COPYRIGHT AND LICENSE
282
283Copyright (c) 2014 Kevin L. Esteb
284
285This library is free software; you can redistribute it and/or modify
286it under the same terms as Perl itself, either Perl version 5.8.8 or,
287at your option, any later version of Perl 5 you may have available.
288
289See L<http://dev.perl.org/licenses/> for more information.
290
291=cut
292
Note: See TracBrowser for help on using the repository browser.