view release on metacpan or  search on metacpan

lib/Bio/Das/ProServer/SourceAdaptor.pm  view on Meta::CPAN

  }

  return $response;
}

sub _gen_object_response {
  my ($object) = @_;
  my $children = 0;

  my $response .= sprintf q(<object objectVersion="%s" dbSource="%s" dbVersion="%s" dbAccessionId="%s" dbCoordSys="%s">),
                          $object->{'objectVersion'} || q(),
                          $object->{'dbSource'}      || q(),
                          $object->{'dbVersion'}     || q(),
                          $object->{'dbAccessionId'} || q(),
                          $object->{'dbCoordSys'}    || 'PDBresnum,Protein Structure';

  for my $obj_detail (@{$object->{'objectDetails'}}) {
    $children++;
    $response .= sprintf q(<objectDetail dbSource="%s" property="%s">%s</objectDetail>),
                         $obj_detail->{'source'}   || q(),
                         $obj_detail->{'property'} || q(),
                         $obj_detail->{'detail'}   || q();
  }

  #########
  # Finish off the object
  #
  if($children) {
    $response .= q(</object>);

  } else {
    #########
    # bit of a hack, but makes nice well formed xml
    # Remove the trailing '>' and self-close
    #
    chop $response;
    $response .= q( />);
  }
  return $response;
}

sub _gen_chain_response {
  my ($chain) = @_;

  #########
  # Set up the chain properties, chain id, swisprot mapping and model number.
  #
  my $id = $chain->{'id'} || q();
  if($id =~ /null/mxs) {
    $id = q();
  }

  my $response .= sprintf q(<chain id="%s" %s>),
                          $id,
                          $chain->{'modelNumber'}?qq(model="$chain->{'modelNumber'}"):q();

  #########
  # Now add the "residues" to the chain
  #
  for my $group (@{$chain->{'groups'}}) {
    my $gid   = $group->{'id'};
    my $icode = $group->{'icode'} || q();

    #########
    # Residue properties
    #
    $response .= sprintf q(<group type="%s" groupID="%s" name="%s" %s>),
                         $group->{'type'},
                         $gid,
                         $group->{'name'},
                         $icode ? qq(insertCode="$icode") : q();

    #########
    # Add the atoms to the chain
    #
    for my $atom (@{$group->{'atoms'}}) {
      $response .= sprintf q(<atom x="%s" y="%s" z="%s" atomName="%s" atomID="%s"%s%s%s/>),
                           (map { $atom->{$_} } qw(x y z atomName atomId)),
                           (map { $atom->{$_}?qq( $_="$atom->{$_}"):q() } qw(occupancy tempFactor altLoc));

    }
    #close group tag
    $response .= q(</group>);
  }

  #close chain tag
  $response .= q(</chain>);
  return $response;
}

sub _gen_connect_response {
  my ($connect)    = @_;
  my $response     = q();
  my $atom_serial  = $connect->{'atomSerial'} || undef;
  my $connect_type = $connect->{'type'}       || q();

  if($atom_serial) {
    $response .= qq(<connect atomSerial="$atom_serial" type="$connect_type">);

    for my $atom (@{$connect->{'atom_ids'}}) {
      $response .= qq(<atomid atomID="$atom"/>);
    }
    $response .= q(</connect>);
  }
  return $response;
}

sub das_interaction {
  my ($self, $opts) = @_;
  $self->_encode($opts);

  my $operation   = $opts->{'operation'} || 'intersection';
  my $interactors = $opts->{'interactors'};
  my $details = {};
  for (@{ $opts->{'details'} }) {
    my ($key, $val) = split /,/mxs, $_;
    $key =~ s/^property://mxs;
    if(defined $val) {
      $val =~ s/^value://mxs;
    }
    $details->{$key} = $val;
  }

  my $struct = $self->build_interaction({
                                         interactors => $interactors,
                                         details     => $details,
                                         operation   => $operation,
                                        });
  $self->_encode($struct);