File: Config.pm

package info (click to toggle)
libchado-perl 1.23-2
  • links: PTS, VCS
  • area: main
  • in suites: jessie, jessie-kfreebsd
  • size: 23,976 kB
  • ctags: 10,378
  • sloc: xml: 192,540; sql: 165,945; perl: 28,339; sh: 101; python: 73; makefile: 46
file content (276 lines) | stat: -rw-r--r-- 7,478 bytes parent folder | download | duplicates (4)
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
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
package Bio::GMOD::DB::Config;
use strict;

=head1 NAME

Bio::GMOD::Config::DB -- a GMOD utility package for reading db config files

=head1 SYNOPSIS

    $ export GMOD_ROOT=/usr/local/gmod
    
    my $conf    = Bio::GMOD::Config->new();
    my $tmpdir  = $conf->tmp();
    my $confdir = $conf->conf();

    #assume there is a file 'chado.conf' with database connetion info
    my $dbconf  = Bio::GMOD::DB::Config->new($conf, 'chado');
    my $dbusername = $dbconf->user();
    my $dbhostname = $dbconf->port();
    # ...etc...

=head1 DESCRIPTION

Bio::GMOD::DB::Config is a module to allow programmatic access to the
database configuration files in GMOD_ROOT/conf.   

=head1 METHODS

=cut

use DBI;
use File::Spec::Functions qw/ catdir catfile /;
use vars '@ISA';
use base qw/ Bio::GMOD::Config /;

my $VERSION = 1.23;

=head2 new

 Title   : new
 Usage   : my $config = Bio::GMOD::DB::Config->new($conf, 'dbname');
 Function: create new Bio::GMOD::DB::Config object
 Returns : new Bio::GMOD::DB::Config
 Args    : Bio::GMOD::Config object, db config name
 Status  : Public

Returns a Bio::GMOD::DB::Config object.  If no db config name argument is
specified, the configuration file called 'default.conf' will be used.

=cut


sub new {
    my $self    = shift;
    my $conf    = shift;
    my $dbname  = shift;

    $dbname ||= 'default';

    my $confdir = $conf->confdir; #get from Bio::GMOD::Config
    my $conffile= catfile($confdir, "$dbname.conf");

    my %dbconf;
    open CONF, $conffile or die "Couldn't open $conffile: $!";
    while (<CONF>) {
        next if /^\#/;
        if (/(\w+)\s*=\s*(\S.*)/) {
            $dbconf{$1}=$2; 
        }
    }
    close CONF;

    return bless {conf   => \%dbconf}, $self;
}

=head2 user
                                                                                
 Title   : user
 Usage   : $username = $dbconf->user();
 Function: return the value the database username
 Returns : see above
 Args    : none
 Status  : Public
                                                                                
=cut

sub user {
    shift->get_tag_value('DBUSER');
}

=head2 password
                                                                                
 Title   : password
 Usage   : $password = $dbconf->password();
 Function: return the value the database password
 Returns : see above
 Args    : none
 Status  : Public
                                                                                
=cut

sub password {
    shift->get_tag_value('DBPASS');
}
                                                                                
=head2 host
                                                                                
 Title   : host
 Usage   : $host = $dbconf->host();
 Function: return the value the database host name
 Returns : see above
 Args    : none
 Status  : Public
                                                                                
=cut

sub host {
    shift->get_tag_value('DBHOST');
}
                                                                                
=head2 port
                                                                                
 Title   : port
 Usage   : $port = $dbconf->port();
 Function: return the value the database port
 Returns : see above
 Args    : none
 Status  : Public
                                                                                
=cut

sub port {
	shift->get_tag_value('DBPORT');
}
                                                                                
=head2 driver
                                                                                
 Title   : driver
 Usage   : $driver = $dbconf->driver();
 Function: return the value the database driver
 Returns : see above
 Args    : none
 Status  : Public
                                                                                
=cut
                                                                                
sub driver {
    shift->get_tag_value('DBDRIVER');
}

=head2 name
                                                                                
 Title   : name 
 Usage   : $dbname = $dbconf->name();
 Function: return the value the database name
 Returns : see above
 Args    : none
 Status  : Public

=cut

sub name {
    shift->get_tag_value('DBNAME');
}

=head2 sqlfile
                                                                                
 Title   : sqlfile
 Usage   : $sqlfile = $dbconf->sqlfile();
 Function: returns the path of the sqlfile (ie, ddl file) the defines the schema
 Returns : see above
 Args    : none
 Status  : Public
                                                                                
=cut

sub sqlfile {
    shift->get_tag_value('SQLFILE');
}

=head2 schema
                                                                                
 Title   : schema
 Usage   : $schema = $dbconf->schema();
 Function: Returns the schema chado resides in (usually public)
 Returns : see above
 Args    : none
 Status  : Public
                                                                                
=cut

sub schema {
    shift->get_tag_value('SCHEMA');
}


=head2 organism
                                                                                
 Title   : organism
 Usage   : $organism = $dbconf->organism();
 Function: Returns the common name of the "default" organism of the database,
           if there is one
 Returns : A species common name, or undef
 Args    : none
 Status  : Public
                                                                                
=cut
                                                                                
sub organism {
    my $self = shift;
    my $org = $self->get_tag_value('DBORGANISM');
    return $org if $org;
    return undef;
}


=head2 dbh
                                                                                
 Title   : dbh
 Usage   : $dbh = $dbconf->dbh();
 Function: return a database handle
 Returns : see above
 Args    : none
 Status  : Public
                                                                                
=cut

sub dbh {
    my $self = shift;

    my $dsn = $self->dsn;

    my $dbh = DBI->connect( $dsn, $self->user(), $self->password() )
        or die "couldn't create db connection:$!";
        #this should throw--maybe I should inherit from Bio::Root

    return $dbh;
}

=head2 dsn
                                                                                
 Title   : dsn
 Usage   : $dsn = $dbconf->dsn();
 Function: return a database connection string
 Returns : see above
 Args    : none
 Status  : Public
                                                                                
=cut


sub dsn {
    my $self = shift;

    my $dsn = "dbi:Pg:dbname=".$self->name();
    $dsn .= ";host=".$self->host() if $self->host();
    $dsn .= ";port=".$self->port() if $self->port();
 
    return $dsn;
}



1;

=head1 AUTHOR
                                                                                
Scott Cain E<lt>cain@cshl.orgE<gt>.
                                                                                
Copyright (c) 2004 Cold Spring Harbor Laboratory
                                                                                
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
                                                                                
=cut