DBR

 view release on metacpan or  search on metacpan

lib/DBR/Config/Field.pm  view on Meta::CPAN

276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
      return DBR::Config::Trans->new(
                                     session  => $self->[O_session],
                                     field_id => $self->[O_field_id],
                                     trans_id => $trans_id,
                                    );
}
 
 
### Admin functions
 
sub update_translator{
      my $self = shift;
      my $transname = shift;
 
      $self->[O_session]->is_admin or return $self->_error('Cannot update translator in non-admin mode');
 
      my $existing_trans_id = $FIELDS_BY_ID{ $self->[O_field_id] }->[C_trans_id];
 
      my $trans_defs = DBR::Config::Trans->list_translators or die 'Failed to get translator list';
 
      my %trans_lookup;

lib/DBR/Config/Field.pm  view on Meta::CPAN

307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
                    -table  => 'dbr_fields',
                    -fields => { trans_id => ['d', $new_trans->{id} ]},
                    -where  => { field_id => ['d', $self->field_id  ]}
                   ) or die "Failed to update dbr_fields";
 
      $FIELDS_BY_ID{ $self->[O_field_id] }->[C_trans_id] = $new_trans->{id}; # update local copy
 
      return 1;
}
 
sub update_regex{
      my $self = shift;
      my $regex = shift;
 
      $self->[O_session]->is_admin or return $self->_error('Cannot update translator in non-admin mode');
 
      my $existing_regex = $FIELDS_BY_ID{ $self->[O_field_id] }->[C_regex];
      return 1 if defined($existing_regex) && $regex eq $existing_regex;
 
      my $instance = $self->table->conf_instance or die "Failed to retrieve conf instance";
      my $dbrh     = $instance->connect or die "Failed to connect to conf instance";

lib/DBR/Config/Field.pm  view on Meta::CPAN

332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
                    -where  => { field_id => ['d', $self->field_id  ]}
                   ) or die "Failed to update dbr_fields";
 
      my $fieldref = $FIELDS_BY_ID{ $self->[O_field_id] };
      $fieldref->[C_regex] = $regex; # update local copy
      _gen_valcheck($fieldref);      # Update value test sub
 
      return 1;
}
 
sub update_default{
      my $self = shift;
      my $value = shift;
 
      $self->[O_session]->is_admin or return $self->_error('Cannot update translator in non-admin mode');
 
      my $existing_value = $FIELDS_BY_ID{ $self->[O_field_id] }->[C_default];
      return 1 if defined($existing_value) && $value eq $existing_value;
 
      my $instance = $self->table->conf_instance or die "Failed to retrieve conf instance";
      my $dbrh     = $instance->connect or die "Failed to connect to conf instance";

lib/DBR/Config/ScanDB.pm  view on Meta::CPAN

119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
      my @rows;
      while (my $row = $sth->fetchrow_hashref()) {
            push @rows, $row;
      }
 
      $sth->finish();
 
      return \@rows;
}
 
sub update_table{
      my $self   = shift;
      my $fields = shift;
      my $name   = shift;
      my $pkey   = shift;
 
      my $dbh = $self->{conf_instance}->connect || die "failed to connect to config db";
 
      return $self->_error('failed to select from dbr_tables') unless
        my $tables = $dbh->select(
                                  -table  => 'dbr_tables',

lib/DBR/Config/ScanDB.pm  view on Meta::CPAN

159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
                                                  }
                                      );
      }
 
      $self->update_fields($fields,$table_id,$pkey) or return $self->_error('Failed to update fields');
 
      return 1;
}
 
 
sub update_fields{
      my $self = shift;
      my $fields = shift;
      my $table_id = shift;
      my $pkey_map = shift;
 
      my $dbh = $self->{conf_instance}->connect || die "failed to connect to config db";
 
      return $self->_error('failed to select from dbr_fields') unless
        my $records = $dbh->select(
                                   -table  => 'dbr_fields',

lib/DBR/Handle.pm  view on Meta::CPAN

34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
      $self->{dbrv1} = DBR::Interface::DBRv1->new(
                                                  session  => $self->{session},
                                                  instance => $self->{instance},
                                                 ) or return $self->_error('failed to create DBRv1 interface object');
 
      return( $self );
}
 
sub select{ my $self = shift; return $self->{dbrv1}->select(@_) }
sub insert{ my $self = shift; return $self->{dbrv1}->insert(@_) }
sub update{ my $self = shift; return $self->{dbrv1}->update(@_) }
sub delete{ my $self = shift; return $self->{dbrv1}->delete(@_) }
 
sub AUTOLOAD {
      my $self = shift;
      my $method = $AUTOLOAD;
 
      my @params = @_;
 
      $method =~ s/.*:://;
      return unless $method =~ /[^A-Z]/; # skip DESTROY and all-cap methods

lib/DBR/Interface/DBRv1.pm  view on Meta::CPAN

154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
                                          session  => $self->{session},
                                          sets   => \@sets,
                                          quiet_error => $params{-quiet} ? 1:0,
                                          tables => $Qtable,
                                         ) or return $self->_error('failed to create query object');
 
      return $query->run();
 
}
 
sub update {
      my $self = shift;
      my %params = @_;
 
 
      my $table  = $params{-table} || $params{-update};
      my $fields = $params{-fields};
 
      return $self->_error('No -table parameter specified') unless $table =~ /^[A-Za-z0-9_-]+$/;
      return $self->_error('No proper -fields parameter specified') unless ref($fields) eq 'HASH';