[Bio] / FigKernelPackages / UserDB.pm Repository:
ViewVC logotype

Annotation of /FigKernelPackages/UserDB.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.2 - (view) (download) (as text)

1 : olson 1.1 #
2 : olson 1.2 # Copyright (c) 2003-2006 University of Chicago and Fellowship
3 :     # for Interpretations of Genomes. All Rights Reserved.
4 :     #
5 :     # This file is part of the SEED Toolkit.
6 :     #
7 :     # The SEED Toolkit is free software. You can redistribute
8 :     # it and/or modify it under the terms of the SEED Toolkit
9 :     # Public License.
10 :     #
11 :     # You should have received a copy of the SEED Toolkit Public License
12 :     # along with this program; if not write to the University of Chicago
13 :     # at info@ci.uchicago.edu or the Fellowship for Interpretation of
14 :     # Genomes at veronika@thefig.info or download a copy from
15 :     # http://www.theseed.org/LICENSE.TXT.
16 :     #
17 :    
18 :     #
19 : olson 1.1 # Basic user management tools for a SEED.
20 :     #
21 :     # The user database explicitly isn't kept in the SEED database instance because
22 :     # it is intended to be persistent across database loads and the installation of
23 :     # new Data directories.
24 :     #
25 :     # If we had the freedom to require a new compiled environment, we might use
26 :     # DBD::SQLite to hold it. But that's not straightforward at this point, so
27 :     # we will hold the user data in a simple flat file, reading it into memory
28 :     # as needed and rewriting to disk when changes need to be made. At this point
29 :     # there will be fairly few accesses to it anyway.
30 :     #
31 :     # We define the following operations on a user database.
32 :     #
33 :     # get_users(): returns the list of usernames that we know about on this system.
34 :     #
35 :     # ensure_user($user): Ensure that a database entry for $user exists.
36 :     #
37 :     # get_user($user): Returns the user parameters as a hash ref.
38 :     #
39 :     # set_user_param($user, $param, $value): Set a user parameter $param to $value.
40 :     #
41 :     # get_user_param($user, $param): Retrieve the user paramter $param.
42 :     #
43 :     # write(): Writes the modified user database to disk.
44 :     #
45 :     # The file format for the user database is intended to be exceedingly simple to generate and
46 :     # parse.
47 :     #
48 :     # It consists of blocks separated by // lines. The first line in the block is the
49 :     # user name, and the remaining lines are tab-delimited pairs 'param-name'\t'param-value'
50 :     #
51 :     # Parameter values are not allowed to contain newlines.
52 :     #
53 :    
54 :     package UserDB;
55 :     use FIG_Config;
56 :    
57 :     use Data::Dumper;
58 :    
59 :     use strict;
60 :    
61 :     sub new
62 :     {
63 :     #
64 :     # We require a $fig reference so we can poke at the database.
65 :     #
66 :    
67 :     my($class, $fig) = @_;
68 :    
69 :     my $file = "$FIG_Config::fig_disk/config/user.db";
70 :    
71 :     my $fh;
72 :     if (!open($fh, "<$file"))
73 :     {
74 :     #
75 :     # DB file doesn't exist yet. Create a new database initialized
76 :     # from the users that show up in the annotations and assignments
77 :     # in the database.
78 :     #
79 :    
80 :     ref($fig) or die "UserDB::new requires a valid FIG object\n";
81 :    
82 :     open(my $wfh, ">$file") or die "Cannot write new user database $file: $!\n";
83 :    
84 :     my @initial_users = _get_initial_users($fig);
85 :     for my $user (@initial_users)
86 :     {
87 :     print $wfh "$user\n";
88 :     print $wfh "//\n";
89 :     }
90 :     close($wfh);
91 :     open($fh, "<$file") or die "Cannot open newly-created user database $file: $!\n";
92 :     }
93 :    
94 :     #
95 :     # Ensure it stays writable.
96 :     #
97 :    
98 :     chmod(0666, $file);
99 :    
100 :     my $self = {
101 :     users => {},
102 :     file => $file,
103 :     };
104 :    
105 :     local($/);
106 :     $/ = "//\n";
107 :    
108 :     while (<$fh>)
109 :     {
110 :     chomp;
111 :    
112 :     my ($user, @params) = split(/\n/, $_);
113 :    
114 :     my $phash = $self->{users}->{$user} = {};
115 :    
116 :     warn "Parse gets user $user\n";
117 :    
118 :     for my $param (@params)
119 :     {
120 :     my ($name, $value) = split(/\t/, $param, 2);
121 :    
122 :     $phash->{$name} = $value;
123 :     }
124 :     }
125 :     close($fh);
126 :    
127 :     bless($self, $class);
128 :    
129 :     return $self;
130 :     }
131 :    
132 :     sub get_users
133 :     {
134 :     my($self) = @_;
135 :    
136 :     return keys(%{$self->{users}});
137 :     }
138 :    
139 :     sub ensure_user
140 :     {
141 :     my($self, $user) = @_;
142 :    
143 :     if (!defined($self->{users}->{$user}))
144 :     {
145 :     $self->{users}->{$user} = {};
146 :     }
147 :     }
148 :    
149 :     sub get_user
150 :     {
151 :     my($self, $user) = @_;
152 :    
153 :     return $self->{users}->{$user};
154 :     }
155 :    
156 :     sub set_user_param
157 :     {
158 :     my($self, $user, $param, $value) = @_;
159 :    
160 :     $self->{users}->{$user}->{$param} = $value;
161 :     }
162 :    
163 :     sub get_user_param
164 :     {
165 :     my($self, $user, $param) = @_;
166 :    
167 :     return $self->{users}->{$user}->{$param};
168 :     }
169 :    
170 :     sub write
171 :     {
172 :     my($self) = @_;
173 :     my $fh;
174 :    
175 :     open($fh, ">$self->{file}") or die "UserDB::write: could not open $self->{file} for writing: $!\n";
176 :    
177 :     while (my ($user, $params) = each (%{$self->{users}}))
178 :     {
179 :     print $fh "$user\n";
180 :     while (my($k, $v) = each(%$params))
181 :     {
182 :     print $fh "$k\t$v\n";
183 :     }
184 :     print $fh "//\n";
185 :     }
186 :     close($fh);
187 :     }
188 :    
189 :     #
190 :     # Return a list of usernames that appear in the database.
191 :     #
192 :     # Strip master:name to just name.
193 :     #
194 :     sub _get_initial_users
195 :     {
196 :     my($fig) = @_;
197 :     my %names;
198 :    
199 :     my $db = $fig->db_handle();
200 :     my $res;
201 :    
202 :     #
203 :     # Pull names from annotations.
204 :     #
205 :    
206 :     $res = $db->SQL("SELECT DISTINCT who FROM annotation_seeks");
207 :     for my $ent (@$res)
208 :     {
209 :     my $who = $ent->[0];
210 :     $who =~ s/^master://;
211 :     $names{$who}++;
212 :     }
213 :    
214 :     #
215 :     # And from assignments
216 :     #
217 :    
218 :     $res = $db->SQL("SELECT DISTINCT made_by FROM assigned_functions");
219 :     for my $ent (@$res)
220 :     {
221 :     my $who = $ent->[0];
222 :     $who =~ s/^master://;
223 :     $names{$who}++;
224 :     }
225 :    
226 :     return keys %names;
227 :     }
228 :    
229 :     1;

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3