view release on metacpan or  search on metacpan

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

		    $self->[O_field_id],
		    $self->[O_session],
		    $params{with_index} ? $self->[O_index]        : undef, # index
		    $params{with_alias} ? $self->[O_table_alias]  : undef, #alias
		   ],
		   ref($self),
		  );

}

sub makevalue{ # shortcut function?
      my $self = shift;
      my $value = shift;

      return DBR::Query::Part::Value->new(
					  session   => $self->[O_session],
					  value     => $value,
					  is_number => $self->is_numeric,
					  field     => $self,
					 );

}

sub field_id     { $_[0]->[O_field_id] }
sub table_id     { $FIELDS_BY_ID{  $_[0]->[O_field_id] }->[C_table_id]    }
sub name         { $FIELDS_BY_ID{  $_[0]->[O_field_id] }->[C_name]        }
sub is_pkey      { $FIELDS_BY_ID{  $_[0]->[O_field_id] }->[C_is_pkey]     }
sub is_nullable  { $FIELDS_BY_ID{  $_[0]->[O_field_id] }->[C_is_nullable] }
sub is_readonly  { $FIELDS_BY_ID{  $_[0]->[O_field_id] }->[C_is_readonly] }
sub datatype     { $FIELDS_BY_ID{  $_[0]->[O_field_id] }->[C_data_type]   }
sub testsub      { $FIELDS_BY_ID{  $_[0]->[O_field_id] }->[C_testsub]     }
sub default_val  { $FIELDS_BY_ID{  $_[0]->[O_field_id] }->[C_default]     }

sub table    {
      return DBR::Config::Table->new(
				     session   => $_[0][O_session],
				     table_id => $FIELDS_BY_ID{  $_[0][O_field_id] }->[C_table_id]
				    );
}

sub is_numeric{
      my $field = $FIELDS_BY_ID{ $_[0]->[O_field_id] };
      return $datatype_lookup{ $field->[C_data_type] }->{numeric} ? 1:0;
}

sub translator{
      my $self = shift;

      my $trans_id = $FIELDS_BY_ID{ $self->[O_field_id] }->[C_trans_id] or return undef;

      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;
      map {$trans_lookup{ uc($_->{name}) } = $_}  @$trans_defs;
      my $new_trans = $trans_lookup{ uc ($transname) } or die "Invalid translator '$transname'";

      return 1 if $existing_trans_id && $new_trans->{id} == $existing_trans_id;


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

      $dbrh->update(
		    -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";

      $dbrh->update(
		    -table  => 'dbr_fields',
		    -fields => { regex => $regex },
		    -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";

      $dbrh->update(
		    -table  => 'dbr_fields',
		    -fields => { default_val => $value },
		    -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_default] = $value; # update local copy

      return 1;
}

1;