1package Chemistry::Bond; 2$VERSION = '0.35'; 3# $Id: Bond.pm,v 1.33 2005/05/20 19:01:04 itubert Exp $ 4 5=head1 NAME 6 7Chemistry::Bond - Chemical bonds as objects in molecules 8 9=head1 SYNOPSIS 10 11 use Chemistry::Bond; 12 13 # assuming we have molecule $mol with atoms $a1 and $a2 14 $bond = Chemistry::Bond->new( 15 id => "b1", 16 type => '=', 17 atoms => [$a1, $a2] 18 order => '2', 19 ); 20 $mol->add_bond($bond); 21 22 # simpler way of doing the same: 23 $mol->new_bond( 24 id => "b1", 25 type => '=', 26 atoms => [$a1, $a2] 27 order => '2', 28 ); 29 30=head1 DESCRIPTION 31 32This module includes objects to describe chemical bonds. 33A bond is defined as a list of atoms (typically two), with some 34associated properies. 35 36=head2 Bond Attributes 37 38In addition to common attributes such as id, name, and type, 39bonds have the order attribute. The bond order is a number, typically the 40integer 1, 2, 3, or 4. 41 42=cut 43 44use 5.006; 45use strict; 46use Scalar::Util 'weaken'; 47use base qw(Chemistry::Obj); 48 49my $N = 0; 50 51=head1 METHODS 52 53=over 4 54 55=item Chemistry::Bond->new(name => value, ...) 56 57Create a new Bond object with the specified attributes. Sensible defaults 58are used when possible. 59 60=cut 61 62sub new { 63 my $class = shift; 64 my %args = @_; 65 my $self = bless { 66 id => $class->nextID(), 67 type => '', 68 atoms => [], 69 order => 1, 70 } , $class; 71 72 $self->$_($args{$_}) for (keys %args); 73 $self; 74} 75 76sub nextID { 77 "b".++$N; 78} 79 80sub reset_id { 81 $N = 0; 82} 83 84 85=item $bond->order() 86 87Sets or gets the bond order. 88 89=cut 90 91Chemistry::Obj::accessor('order'); 92 93=item $bond->length 94 95Returns the length of the bond, i.e., the distance between the two atom 96objects in the bond. Returns zero if the bond does not have exactly two atoms. 97 98=cut 99 100sub length { 101 my $self = shift; 102 103 if (@{$self->{atoms}} == 2) { 104 my $v = $self->{atoms}[1]{coords} - $self->{atoms}[0]{coords}; 105 return $v->length; 106 } else { 107 return 0; 108 } 109} 110 111=item $bond->aromatic($bool) 112 113Set or get whether the bond is considered to be aromatic. 114 115=cut 116 117sub aromatic { 118 my $self = shift; 119 if (@_) { 120 ($self->{aromatic}) = @_; 121 return $self; 122 } else { 123 return $self->{aromatic}; 124 } 125} 126 127=item $bond->print 128 129Convert the bond to a string representation. 130 131=cut 132 133sub print { 134 my $self = shift; 135 my ($indent) = @_; 136 $indent ||= 0; 137 my $l = sprintf "%.4g", $self->length; 138 my $atoms = join " ", map {$_->id} $self->atoms; 139 my $ret = <<EOF; 140$self->{id}: 141 type: $self->{type} 142 order: $self->{order} 143 atoms: "$atoms" 144 length: $l 145EOF 146 $ret .= " attr:\n"; 147 $ret .= $self->print_attr($indent); 148 $ret =~ s/^/" "x$indent/gem; 149 $ret; 150} 151 152=item $bond->atoms() 153 154If called with no parameters, return a list of atoms in the bond. If called 155with a list (or a reference to an array) of atom objects, define the atoms in 156the bond and call $atom->add_bond for each atom in the list. Note: changing the 157atoms in a bond may have strange side effects; it is safer to treat bonds as 158immutable except with respect to properties such as name and type. 159 160=cut 161 162sub atoms { 163 my $self = shift; 164 if (@_) { 165 $self->{atoms} = ref $_[0] ? $_[0] : [@_]; 166 for my $a (@{$self->{atoms}}) { 167 weaken($a); 168 $a->add_bond($self); 169 } 170 } else { 171 return (@{$self->{atoms}}); 172 } 173} 174 175sub _weaken { 176 my $self = shift; 177 for my $a (@{$self->{atoms}}) { 178 weaken($a); 179 } 180 weaken($self->{parent}); 181} 182 183# This method is private and should only be called from $mol->delete_bond 184sub delete_atoms { 185 my $self = shift; 186 for my $a (@{$self->{atoms}}) { # delete bond from each atom 187 $a->delete_bond($self); 188 } 189} 190 191=item $bond->delete 192 193Calls $mol->delete_bond($bond) on the bond's parent molecule. Note that a bond 194should belong to only one molecule or strange things may happen. 195 196=cut 197 198sub delete { 199 my ($self) = @_; 200 $self->parent->_delete_bond($self); 201 $self->{deleted} = 1; 202} 203 204sub parent { 205 my $self = shift; 206 if (@_) { 207 ($self->{parent}) = @_; 208 weaken($self->{parent}); 209 $self; 210 } else { 211 $self->{parent}; 212 } 213} 214 215 216 2171; 218 219=back 220 221=head1 VERSION 222 2230.35 224 225=head1 SEE ALSO 226 227L<Chemistry::Mol>, L<Chemistry::Atom>, L<Chemistry::Tutorial> 228 229The PerlMol website L<http://www.perlmol.org/> 230 231=head1 AUTHOR 232 233Ivan Tubert-Brohman E<lt>itub@cpan.orgE<gt> 234 235=head1 COPYRIGHT 236 237Copyright (c) 2005 Ivan Tubert-Brohman. All rights reserved. This program is 238free software; you can redistribute it and/or modify it under the same terms as 239Perl itself. 240 241=cut 242 243