source: xas-model/trunk/lib/XAS/Model/Database.pm @ 8f14efda2486086620dae33eba4e05b4cdfa98e1

Revision 8f14efda2486086620dae33eba4e05b4cdfa98e1, 5.9 KB checked in by Kevin L. Esteb <kevin@…>, 6 years ago (diff)

Wokring on database loading. Changed over to the recommended directory
structure for DBIx::Class (sorta)

  • Property mode set to 100644
Line 
1package XAS::Model::Database;
2
3our $VERSION = '0.01';
4
5use Class::Inspector;
6use XAS::Model::Schema;
7
8use XAS::Class
9  debug      => 0,
10  version    => $VERSION,
11  base       => 'XAS::Base',
12  constants  => 'DELIMITER PKG REFS ONCE HASH ARRAY',
13  filesystem => 'File',
14  exports => {
15    hooks => {
16      schema => [ \&_schema, 1 ],
17      table  => [ \&_tables, 1 ],
18      tables => [ \&_tables, 1 ],
19    }
20  },
21;
22
23our $KEYS;
24 
25use Data::Dumper;
26
27# ---------------------------------------------------------------------
28# Hooks
29# ---------------------------------------------------------------------
30
31sub _tables {
32    my $self   = shift;
33    my $target = shift;
34    my $symbol = shift;
35    my $tables = @_ == 1 ? shift : [ @_ ];
36
37    $self->tables($tables);
38
39    return $self;
40
41}
42
43sub _schema {
44    my $self    = shift;
45    my $target  = shift;
46    my $symbol  = shift;
47    my $schemas = @_ == 1 ? shift : [ @_ ];
48
49    $self->schemas($schemas);
50
51    return $self;
52
53}
54
55# ---------------------------------------------------------------------
56# Public Methods
57# ---------------------------------------------------------------------
58
59sub tables {
60    my $self = shift;
61    my ($tables) = $self->validate_params(\@_, [1]);
62
63    $tables = [ split(DELIMITER, $tables) ] unless (ref($tables) eq ARRAY);
64
65    my ($pkg) = caller(4);
66     
67    no strict "refs";               # to register new methods in package
68    no warnings;                    # turn off warnings
69
70    foreach my $table (@$tables) {
71
72        # building constants in the calling package.
73
74        if ($table ne ':all') {
75
76            *{$pkg.PKG.$table} = sub { $KEYS->{$table}; };
77
78        } else {
79
80            while (my ($key, $value) = each(%$KEYS)) {
81
82                *{$pkg.PKG.$key} = sub { $value; };
83
84            }
85
86            last;
87
88        }
89
90    }
91
92}
93
94sub schemas {
95    my $self = shift;
96    my ($schemas) = $self->validate_params(\@_, [1]);
97
98    $schemas = [ split(DELIMITER, $schemas) ] unless (ref($schemas) eq ARRAY);
99
100    foreach my $schema (@$schemas) {
101
102        # loading our schema
103
104        XAS::Model::Schema->load_namespaces(
105            result_namespace    => "+$schema" . "::Result",
106            resultset_namespace => "+$schema" . "::ResultSet",
107        );
108
109        # building our keys
110
111        my $pattern = $schema . '::';
112        my $modules = Class::Inspector->subclasses('UNIVERSAL');
113
114        foreach my $module (@$modules) {
115
116            next if ($module =~ /ResultSet/);
117
118            if ($module =~ m/$pattern/) {
119
120                my @parts = split('::', $module);
121                my $begin = scalar(@parts) - 1;
122                my $name = join('', splice(@parts, $begin, $#parts));
123
124                $KEYS->{$name} = $module;
125
126            }
127
128        }
129
130    }
131
132}
133
134# ---------------------------------------------------------------------
135# Private Methods
136# ---------------------------------------------------------------------
137
1381;
139
140__END__
141
142=head1 NAME
143
144XAS::Model::Database - A class to load database schemas
145
146=head1 SYNOPSIS
147
148  use XAS::Model::Schema;
149  use XAS::Model::Database
150    schema => 'ETL::Model::Database',
151    table  => 'Master';
152
153  try {
154
155      $schema = XAS::Model::Schema->opendb('database');
156
157      my @rows = Master->search($schema);
158
159      foreach my $row (@rows) {
160
161          printf("Hostname = %s\n", $row->Hostname);
162
163      }
164
165  } catch {
166
167      my $ex = $_;
168
169      print $ex;
170
171  };
172
173=head1 DESCRIPTION
174
175This module loads DBIx::Class table definations and defines a path for
176the database.ini configuration file. It can also load shortcut constants
177for table definations.
178
179Example
180
181    use XAS::Model::Database
182      schema => 'ETL::Model::Database',
183      table  => 'Master'
184    ;
185
186    or
187
188    use XAS::Model::Database
189      schema => 'ETL::Model::Database',
190      tables => qw( Master Detail )
191    ;
192
193    or
194
195    use XAS::Model::Database
196      schema => 'ETL::Model::Database',
197      table => ':all'
198    ;
199
200The difference is that in the first example you are only loading the
201"Master" constant into your module. The second example loads the constants
202"Master" and "Detail". The ":all" qualifer would load all the defined
203constants.
204
205=head1 HOOKS
206
207The following hooks are defined to load table definations and define
208constants. The order that they are called is important, i.e. 'schema' must
209come before 'table'.
210
211=head2 schema
212
213This defines a load path to the modules that defines a database schema.
214DBIx::Class loads modules based on the path. For example all modules
215below 'ETL::Model::Database' will be loaded at once. You can be more
216specific. If you only want the 'Progress' database schema you can load
217it by using 'ETL::Model::Database::Progress'.
218 
219=head2 table
220
221This will define a constant for a table defination. This constant is based
222on the table name, which is defined by the modules name. So the module
223'ETL::Model::Database::Progress::ActOther' will have a constant named
224'ActOther' that refers to the module.
225
226=over 4
227
228=item Warning
229
230If you have multiple tables named the same thing in differant schemas
231and load all the schemas at once, this constant will refer to the last
232loaded table defination.
233
234=back
235
236=head2 tables
237
238Does the same thing as 'table'.
239
240=head1 METHODS
241
242=head2 opendb($database)
243
244This method provides the defaults necessary to call the DBIx::Class::Schema
245connect() method. It takes one parameter.
246
247=over 4
248
249=item B<$database>
250
251The name of a configuration item suitable for DBIx::Class::Schema::Configure.
252
253Example
254
255    my $handle = XAS::Model::Database->opendb('database');
256
257=back
258
259=head1 SEE ALSO
260
261=over 4
262
263=item L<https://metacpan.org/pod/DBIx::Class|DBIx::Class>
264
265=item L<XAS|XAS>
266
267=back
268
269=head1 AUTHOR
270
271Kevin L. Esteb, E<lt>kevin@kesteb.usE<gt>
272
273=head1 COPYRIGHT AND LICENSE
274
275Copyright (C) 2014 Kevin L. Esteb
276
277This library is free software; you can redistribute it and/or modify
278it under the same terms as Perl itself, either Perl version 5.8.8 or,
279at your option, any later version of Perl 5 you may have available.
280
281See L<http://dev.perl.org/licenses/> for more information.
282
283=cut
Note: See TracBrowser for help on using the repository browser.