File Coverage

blib/lib/Chemistry/Bond.pm
Criterion Covered Total %
statement 49 68 72.0
branch 6 10 60.0
condition 0 2 0.0
subroutine 12 15 80.0
pod 6 10 60.0
total 73 105 69.5


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