DBR

 view release on metacpan or  search on metacpan

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

      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

		    -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

		    -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

      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

 						  }
 				      );
      }

      $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

      $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

					  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';