File Coverage

blib/lib/Physics/Unit/Scalar.pm
Criterion Covered Total %
statement 130 144 90.2
branch 32 52 61.5
condition 8 21 38.1
subroutine 25 28 89.2
pod 13 18 72.2
total 208 263 79.0


line stmt bran cond sub pod time code
1             package Physics::Unit::Scalar;
2              
3 1     1   13709 use strict;
  1         1  
  1         25  
4 1     1   4 use warnings;
  1         1  
  1         22  
5 1     1   3 use Carp;
  1         3  
  1         62  
6 1     1   4 use base qw(Exporter);
  1         1  
  1         80  
7 1     1   3 use vars qw( $VERSION @EXPORT_OK %EXPORT_TAGS $debug);
  1         1  
  1         85  
8              
9             $VERSION = '0.54';
10             $VERSION = eval $VERSION;
11              
12             @EXPORT_OK = qw( ScalarFactory GetScalar );
13             %EXPORT_TAGS = ('ALL' => \@EXPORT_OK);
14              
15 1     1   443 use Physics::Unit ':ALL';
  1         2  
  1         992  
16              
17              
18             InitSubtypes();
19              
20             sub new {
21 16     16 1 4388 my $proto = shift;
22 16 50       35 print "Scalar::new: proto is $proto.\n" if $debug;
23 16         14 my $class;
24 16         18 my $self = {};
25              
26 16 100       25 if (ref $proto) {
27             # Copy constructor
28 1         2 $class = ref $proto;
29 1         8 $self->{$_} = $$proto{$_} for keys %$proto;
30             }
31             else {
32             # Construct from a definition string
33             # Get the definition string, and remove whitespace
34 15         17 my $def = shift;
35 15 50       25 print "def is '$def'.\n" if $debug;
36 15 100       24 if (defined $def) {
37 14         79 $def =~ s/^\s*(.*?)\s*$/$1/;
38             }
39              
40 15         17 $class = $proto;
41              
42             # Convert the argument into a unit object
43 15 100       22 if ($class eq 'Physics::Unit::Scalar') {
44             # Build a generic Physics::Unit::Scalar object
45              
46 3         7 return ScalarFactory($def);
47              
48             #my $u = Physics::Unit->new($def);
49             #$self->{value} = $u->factor;
50             #$u->factor(1);
51             #$self->{MyUnit} = $self->{default_unit} = $u;
52             }
53             else {
54             # The user specified the type of Scalar explicitly
55             my $mu = $self->{MyUnit} = $self->{default_unit} =
56 12         23 GetMyUnit($class);
57              
58             # If no definition string was given, then set the value to
59             # one.
60              
61 12 100 66     147 if (!defined $def || $def eq '') {
    100          
62 1         3 $self->{value} = 1;
63             }
64              
65             # If the definition consists of just a number, then we'll use
66             # the default unit
67              
68             elsif ($def =~ /^$Physics::Unit::number_re$/io) {
69 2         5 $self->{value} = $def + 0; # convert to number
70             }
71              
72             else {
73 9         21 my $u = GetUnit($def);
74              
75 9 100       21 croak 'Unit definition string is of incorrect type'
76             if 'Physics::Unit::' . $u->type ne $class;
77              
78 8         21 $self->{value} = $u->convert($mu);
79             }
80             }
81             }
82              
83 12         31 bless $self, $class;
84             }
85              
86             sub ScalarFactory {
87 5     5 1 18 my $self = {
88             value => 1,
89             MyUnit => Physics::Unit->new(shift),
90             };
91              
92             # Call the mystery ScalarResolve() function.
93 5         9 return ScalarResolve($self);
94             }
95              
96             sub default_unit {
97 1     1 1 2 my $proto = shift;
98 1 50       3 if (ref $proto) {
99 1         4 return $proto->{default_unit};
100             }
101             else {
102 0         0 return GetDefaultUnit($proto);
103             }
104             }
105              
106             sub ToString {
107 11     11 1 1243 my $self = shift;
108 11 100       40 return $self->value .' '. $self->MyUnit->ToString unless @_;
109 1         3 my $u = GetUnit(shift);
110 1         2 my $v = $self->value * $self->MyUnit->convert($u);
111 1         9 return $v .' '. $u->ToString;
112             }
113              
114             sub convert {
115 1     1 1 263 my $self = shift;
116              
117 1         3 my $u = GetUnit(shift);
118              
119 1 50 33     7 croak 'convert called with invalid parameters'
120             if !ref $self || !ref $u;
121              
122 1         2 return $self->value * $self->MyUnit->convert($u);
123             }
124              
125             sub value {
126 13     13 1 306 my $self = shift;
127 13 50       19 $self->{value} = shift if @_;
128 13         83 return $self->{value};
129             }
130              
131             sub add {
132 1     1 1 300 my $self = shift;
133              
134 1         4 my $other = GetScalar(shift);
135              
136 1 50 33     6 croak 'Invalid arguments to Physics::Unit::Scalar::add'
137             if !ref $self || !ref $other;
138 1 50       2 carp "Scalar types don't match in add()"
139             if ref $self ne ref $other;
140              
141 1         2 $self->{value} += $other->{value};
142              
143 1         2 return $self;
144             }
145              
146             sub neg {
147 0     0 1 0 my $self = shift;
148 0 0       0 croak 'Invalid arguments to Physics::Unit::Scalar::neg'
149             if !ref $self;
150              
151 0         0 $self->{value} = - $self->{value};
152             }
153              
154             sub subtract {
155 0     0 1 0 my $self = shift;
156              
157 0         0 my $other = GetScalar(shift);
158              
159 0 0 0     0 croak 'Invalid arguments to Physics::Unit::Scalar::subtract'
160             if !(ref $self) || !(ref $other);
161 0 0       0 carp "Scalar types don't match in subtract()"
162             if ref $self ne ref $other;
163              
164 0         0 $self->{value} -= $other->{value};
165              
166 0         0 return $self;
167             }
168              
169             sub times {
170 2     2 1 1 my $self = shift;
171 2         4 my $other = GetScalar(shift);
172              
173 2 50 33     8 croak 'Invalid arguments to Physics::Unit::Scalar::times'
174             if !ref $self || !ref $other;
175              
176 2         6 my $value = $self->{value} * $other->{value};
177              
178 2         5 my $mu = $self->{MyUnit}->copy;
179              
180 2         5 $mu->times($other->{MyUnit});
181              
182 2         4 my $newscalar = {
183             value => $value,
184             MyUnit => $mu,
185             };
186              
187 2         5 return ScalarResolve($newscalar);
188             }
189              
190             sub recip {
191 2     2 1 2 my $self = shift;
192 2 50       4 croak 'Invalid argument to Physics::Unit::Scalar::recip'
193             unless ref $self;
194              
195             croak 'Attempt to take reciprocal of a zero Scalar'
196 2 50       5 unless $self->{value};
197              
198 2         6 my $mu = $self->{MyUnit}->copy;
199              
200             my $newscalar = {
201             value => 1 / $self->{value},
202 2         9 MyUnit => $mu->recip,
203             };
204              
205 2         5 return ScalarResolve($newscalar);
206             }
207              
208             sub divide {
209 2     2 1 4 my $self = shift;
210              
211 2         3 my $other = GetScalar(shift);
212              
213 2 50 33     11 croak 'Invalid arguments to Physics::Unit::Scalar::times'
214             if !ref $self || !ref $other;
215              
216 2         7 my $arg = $other->recip;
217              
218 2         9 return $self->times($arg);
219             }
220              
221             sub GetScalar {
222 5     5 1 5 my $n = shift;
223 5 100       10 if (ref $n) {
224 3         5 return $n;
225             }
226             else {
227 2         5 return ScalarFactory($n);
228             }
229             }
230              
231             sub InitSubtypes {
232 1     1 0 3 for my $type (ListTypes()) {
233 30 50       38 print "Creating class $type\n" if $debug;
234              
235 30         36 my $prototype = GetTypeUnit($type);
236 30   66     38 my $type_unit_name = $prototype->name || $prototype->def;
237             {
238 1     1   9 no strict 'refs';
  1         1  
  1         30  
  30         19  
239 1     1   4 no warnings 'once';
  1         1  
  1         122  
240 30         27 my $package = 'Physics::Unit::' . $type;
241 30         21 @{$package . '::ISA'} = qw(Physics::Unit::Scalar);
  30         218  
242 30         40 ${$package . '::DefaultUnit'} = ${$package . '::MyUnit'} =
  30         75  
  30         76  
243             GetUnit( $type_unit_name );
244             }
245             }
246             }
247              
248             sub MyUnit {
249 12     12 0 10 my $proto = shift;
250 12 50       21 if (ref ($proto)) {
251 12         34 return $proto->{MyUnit};
252             }
253             else {
254 0         0 return GetMyUnit($proto);
255             }
256             }
257              
258             sub GetMyUnit {
259 18     18 0 30 my $class = shift;
260 1     1   4 no strict 'refs';
  1         1  
  1         37  
261 18         11 return ${$class . '::MyUnit'};
  18         72  
262             }
263              
264             sub GetDefaultUnit {
265 0     0 0 0 my $class = shift;
266 1     1   3 no strict 'refs';
  1         1  
  1         168  
267 0         0 return ${$class . '::DefaultUnit'};
  0         0  
268             }
269              
270             sub ScalarResolve {
271 9     9 0 6 my $self = shift;
272              
273 9         11 my $mu = $self->{MyUnit};
274 9         17 my $type = $mu->type;
275              
276 9 100       15 if ($type) {
277 6 50       11 $type = 'dimensionless' if $type eq 'prefix';
278 6         12 $type = 'Physics::Unit::' . $type;
279              
280 6         7 my $newunit = GetMyUnit($type);
281 6         14 $self->{value} *= $mu->convert($newunit);
282 6         12 $self->{MyUnit} = $newunit;
283 6         11 $self->{default_unit} = $newunit;
284             }
285             else {
286 3         5 $type = "Physics::Unit::Scalar";
287              
288 3         10 $self->{value} *= $mu->factor;
289 3         8 $mu->factor(1);
290 3         5 $self->{default_unit} = $mu;
291             }
292              
293 9         55 bless $self, $type;
294             }
295              
296             1;
297              
298             __END__