use
vars
qw($VERSION @ISA @EXPORT_OK)
;
$VERSION
= 1.3;
@ISA
=
qw(Exporter)
;
@EXPORT_OK
=
qw(convert print_conversion)
;
my
%prefixes
= (
'T'
=> 1e12,
'G'
=> 1e9,
'M'
=> 1e6,
'k'
=> 1000,
'h'
=> 100,
'da'
=> 10,
'd'
=> .1,
'c'
=> .01,
'm'
=> .001,
'µ'
=> 1e-6,
'n'
=> 1e-9,
'dn'
=> 1e-10,
'p'
=> 1e-12,
'f'
=> 1e-15
);
my
%formulas
= (
'are'
=>
'100 m^2'
,
'l'
=>
'm^3/1000'
,
'tonne'
=>
'1000 kg'
,
'N'
=>
'kg m/s^2'
,
'dyn'
=>
'cm gram/s^2'
,
'Pa'
=>
'N/m^2'
,
'bar'
=>
'1e5 Pa'
,
'barye'
=>
'dyne/cm^2'
,
'kine'
=>
'cm/s'
,
'bole'
=>
'g kine'
,
'pond'
=>
'gram gee'
,
'glug'
=>
'pond s^2/cm'
,
'J'
=>
'N m'
,
'W'
=>
'J/s'
,
'gee'
=>
'9.80665 m/s^2'
,
'atm'
=>
'101325 Pa'
,
'Hg'
=>
'13.5951 pond/cm^3'
,
'water'
=>
'pond/cm^3'
,
'mach'
=>
'331.46 m/s'
,
'coulomb'
=>
'A s'
,
'V'
=>
'W/A'
,
'ohm'
=>
'V/A'
,
'siemens'
=>
'A/V'
,
'farad'
=>
'coulomb/V'
,
'Wb'
=>
'V s'
,
'henry'
=>
'Wb/A'
,
'tesla'
=>
'Wb/m^2'
,
'Hz'
=>
'cycle/s'
,
'lbf'
=>
'lb gee'
,
'tonf'
=>
'ton gee'
,
'duty'
=>
'ft lbf'
,
'celo'
=>
'ft/s^2'
,
'jerk'
=>
'ft/s^3'
,
'slug'
=>
'lbf s^2/ft'
,
'reyn'
=>
'psi sec'
,
'psi'
=>
'lbf/in^2'
,
'tsi'
=>
'tonf/in^2'
,
'ouncedal'
=>
'oz ft/s^2'
,
'poundal'
=>
'lb ft/s^2'
,
'tondal'
=>
'ton ft/s^2'
,
'hp'
=>
'550 ft lbf/s'
,
'nauticalmile'
=>
'1852 m'
,
'mil'
=>
'.001 in'
);
my
%reductions
= (
'in'
=>
'0.0254 m'
,
'pnt'
=>
'in/72'
,
'ft'
=>
'12 in'
,
'yd'
=>
'3 ft'
,
'mi'
=>
'5280 ft'
,
'kip'
=>
'1000 lbf'
,
'barrel'
=>
'42 gal'
,
'gal'
=>
'231 in^3'
,
'qt'
=>
'gal/4'
,
'pt'
=>
'qt/2'
,
'gill'
=>
'pt/4'
,
'floz'
=>
'pt/16'
,
'Fd'
=>
'1.8 Cd'
,
'Kd'
=>
'Cd'
,
'min'
=>
'60 s'
,
'hr'
=>
'60 min'
,
'day'
=>
'24 hr'
,
'wk'
=>
'7 day'
,
'lb'
=>
'453.59237 g'
,
'oz'
=>
'lb/16'
,
'dr'
=>
'oz/16'
,
'gr'
=>
'lb/7000'
,
'ton'
=>
'2000 lb'
,
'cycle'
=>
'360 deg'
,
'rad'
=>
'180 deg/3.14159265358979323846'
,
'grad'
=>
'9 deg/10'
,
'troypound'
=>
'5760 gr'
,
'troyounce'
=>
'troypound/12'
,
'pennyweight'
=>
'troyounce/20'
,
'carat'
=>
'0.2 gm'
);
my
@abbreviations
= (
'\bper\b'
=>
'\/'
,
'\bsq(uare)?\s+'
=>
'sq,'
,
'\bcu(bic)?\s+'
=>
'cu,'
,
'\s+squared\b'
=>
'^2'
,
'\s+cubed\b'
=>
'^3'
,
'\bmicrons?\b'
=>
'µ,m'
,
'\bdecinano-?'
=>
'dn,'
,
'\btera-?'
=>
'T,'
,
'\bgiga-?'
=>
'G,'
,
'\bmega-?'
=>
'M,'
,
'\bkilo-?'
=>
'k,'
,
'\bhecto-?'
=>
'h,'
,
'\bdeka-?'
=>
'da,'
,
'\bdeca-?'
=>
'da,'
,
'\bdeci-?'
=>
'd,'
,
'\bcenti-?'
=>
'c,'
,
'\bmilli-?'
=>
'm,'
,
'\bmicro-?'
=>
'µ,'
,
'\bnano-?'
=>
'n,'
,
'\bpico-?'
=>
'p,'
,
'\bfemto-?'
=>
'f,'
,
'\bdn-'
=>
'dn,'
,
'\bT-'
=>
'T,'
,
'\bG-'
=>
'G,'
,
'\bM-'
=>
'M,'
,
'\bk-'
=>
'k,'
,
'\bh-'
=>
'h,'
,
'\bda-'
=>
'da,'
,
'\bda-'
=>
'da,'
,
'\bd-'
=>
'd,'
,
'\bc-'
=>
'c,'
,
'\bm-'
=>
'm,'
,
'\bµ-'
=>
'µ,'
,
'\bn-'
=>
'n,'
,
'\bp-'
=>
'p,'
,
'\bf-'
=>
'f,'
,
'\b[Rr][Pp][Mm]\b'
=>
'cycle\/min'
,
'\bhz\b'
=>
'Hz'
,
'\b[Cc]elsius\b'
=>
'C'
,
'\b[Ff]arenheit\b'
=>
'F'
,
'\b[Kk]elvins?\b'
=>
'K'
,
'\bdegs?\s+C\b'
=>
'C'
,
'\bdegs?\s+F\b'
=>
'F'
,
'\bC\s+change\b'
=>
'Cd'
,
'\bF\s+change\b'
=>
'Fd'
,
'\bK\s+change\b'
=>
'Kd'
,
'\bdegs\b'
=>
'deg'
,
'\bdegrees?\b'
=>
'deg'
,
'\brads\b'
=>
'rad'
,
'\bradians?\b'
=>
'rad'
,
'\bgrads\b'
=>
'grad'
,
'\bgradians?\b'
=>
'grad'
,
'\bangstroms?\b'
=>
'dn,m'
,
'\bcc\b'
=>
'cm^3'
,
'\bhectares?\b'
=>
'h,are'
,
'\bmils?\b'
=>
'm,in'
,
'amperes?\b'
=>
'A'
,
'amps?\b'
=>
'A'
,
'days\b'
=>
'day'
,
'drams?\b'
=>
'dr'
,
'dynes?\b'
=>
'dyn'
,
'feet\b'
=>
'ft'
,
'foot\b'
=>
'ft'
,
'gallons?\b'
=>
'gal'
,
'gm\b'
=>
'g'
,
'grams?\b'
=>
'g'
,
'grains?\b'
=>
'gr'
,
'hours?\b'
=>
'hr'
,
'inch(es)?\b'
=>
'in'
,
'joules?\b'
=>
'J'
,
'lbs\b'
=>
'lb'
,
'lbm\b'
=>
'lb'
,
'liters?\b'
=>
'l'
,
'meters?\b'
=>
'm'
,
'miles?\b'
=>
'mi'
,
'minutes?\b'
=>
'min'
,
'newtons?\b'
=>
'N'
,
'ounces?\b'
=>
'oz'
,
'pascals?\b'
=>
'Pa'
,
'pints?\b'
=>
'pt'
,
'points?\b'
=>
'pnt'
,
'pounds?\b'
=>
'lb'
,
'quarts?\b'
=>
'qt'
,
'seconds?\b'
=>
's'
,
'secs?\b'
=>
's'
,
'watts?\b'
=>
'W'
,
'weeks?\b'
=>
'wk'
,
'yards?\b'
=>
'yd'
);
my
%conversions
= (
'in,m'
=> 0.0254,
'in,pnt'
=> 72,
'ft,in'
=> 12,
'yd,ft'
=> 3,
'mi,ft'
=> 5280,
'barrel,gal'
=> 42,
'gal,in^3'
=> 231,
'gal,qt'
=> 4,
'qt,pt'
=> 2,
'pt,floz'
=> 16,
'pt,gill'
=> 4,
'C,F'
=>
sub
{
$_
[0] * 1.8 + 32 },
'F,C'
=>
sub
{ (
$_
[0] - 32 ) / 1.8 },
'K,C'
=>
sub
{
$_
[0] - 273.15 },
'C,K'
=>
sub
{
$_
[0] + 273.15 },
'Cd,Fd'
=> 1.8,
'Kd,Cd'
=> 1,
'wk,day'
=> 7,
'day,hr'
=> 24,
'hr,min'
=> 60,
'min,s'
=> 60,
'dollar,cent'
=> 100,
'lb,g'
=> 453.59237,
'lb,oz'
=> 16,
'lb,gr'
=> 7000,
'oz,dr'
=> 16,
'ton,lb'
=> 2000,
'cycle,deg'
=> 360,
'rad,deg'
=> 180 / 3.14159265358979323846,
'grad,deg'
=> 9 / 10,
'troypound,gr'
=> 5760,
'troypound,troyounce'
=> 12,
'troyounce,pennyweight'
=> 20,
'carat,gm'
=> .2
);
my
$factors_computed
= 0;
my
%factor
= ();
my
%conversion_history
= ();
sub
register_factor {
my
(
$u1
,
$u2
,
$f
) =
@_
;
$factor
{
$u1
}{
$u2
} =
$f
;
$factor
{
$u2
}{
$u1
} = 1 /
$f
if
(
ref
(
$f
) ne
"CODE"
);
}
sub
print_unit($\%) {
my
(
$prefix
,
$u_group
) =
@_
;
my
(
$num_str
,
$den_str
,
$u
,
$dim
);
$num_str
=
""
;
$den_str
=
""
;
while
( (
$u
,
$dim
) =
each
%{
$u_group
} ) {
if
(
$u
eq
"1"
) {
$prefix
*=
$dim
}
elsif
(
$dim
> 1 ) {
$num_str
.=
"$u^$dim "
}
elsif
(
$dim
== 1 ) {
$num_str
.=
"$u "
}
elsif
(
$dim
== -1 ) {
$den_str
.=
"$u "
}
elsif
(
$dim
< -1 ) {
$den_str
.=
join
(
""
,
$u
,
"^"
, -
$dim
,
" "
) }
}
$num_str
.=
"$prefix "
if
(
$prefix
!= 1 );
chop
$num_str
;
chop
$den_str
;
$num_str
=
"1"
if
( !
$num_str
);
print
$num_str
;
print
"/"
,
$den_str
if
(
$den_str
);
print
"\n"
;
}
my
$current_prefix
;
my
%current_group
;
sub
merge_simple_unit {
my
(
$prefix
,
$u
,
$dim
) =
@_
;
if
(
$dim
> 1 ) {
$current_prefix
*=
$prefix
*
*$dim
}
if
(
$dim
== 1 ) {
$current_prefix
*=
$prefix
}
elsif
(
$dim
== -1 ) {
$current_prefix
/=
$prefix
}
elsif
(
$dim
< -1 ) {
$current_prefix
/=
$prefix
**-
$dim
}
if
(
$u
ne
"1"
) {
if
(
defined
(
$current_group
{
$u
} ) ) {
$current_group
{
$u
} +=
$dim
}
else
{
$current_group
{
$u
} =
$dim
}
delete
$current_group
{
$u
}
if
(
$current_group
{
$u
} == 0 );
}
}
sub
reduce_simple_unit {
my
(
$u
,
$dim
,
$apply_reductions
) =
@_
;
my
(
$p
);
if
(
defined
(
$formulas
{
$u
} ) ) {
reduce_unit(
$formulas
{
$u
},
$dim
,
$apply_reductions
);
return
;
}
if
(
$apply_reductions
&&
defined
(
$reductions
{
$u
} ) ) {
reduce_unit(
$reductions
{
$u
},
$dim
,
$apply_reductions
);
return
;
}
elsif
(
defined
(
$factor
{
$u
} ) ) {
merge_simple_unit( 1,
$u
,
$dim
);
return
;
}
foreach
$p
(
keys
%prefixes
) {
if
(
$u
=~ /^
$p
,?(.+)/ ) {
if
(
defined
(
$formulas
{$1} ) ) {
merge_simple_unit(
$prefixes
{
$p
},
"1"
,
$dim
);
reduce_unit(
$formulas
{$1},
$dim
,
$apply_reductions
);
return
;
}
if
(
$apply_reductions
&&
defined
(
$reductions
{$1} ) ) {
merge_simple_unit(
$prefixes
{
$p
},
"1"
,
$dim
);
reduce_unit(
$reductions
{$1},
$dim
,
$apply_reductions
);
return
;
}
elsif
(
defined
(
$factor
{$1} ) ) {
merge_simple_unit(
$prefixes
{
$p
}, $1,
$dim
);
return
;
}
}
}
Carp::croak
"unknown unit '$u' used"
;
}
sub
reduce_unit {
my
(
$u_group
,
$dim
,
$apply_reductions
) =
@_
;
my
(
$u
);
foreach
$u
(
keys
%{
$u_group
} ) {
if
(
$u
eq
"1"
) {
merge_simple_unit(
$u_group
->{
$u
},
$u
,
$dim
);
}
else
{
reduce_simple_unit(
$u
,
$dim
*
$u_group
->{
$u
},
$apply_reductions
);
}
}
}
sub
canonicalize_unit_list (\@$$) {
my
(
$units
,
$u_group
,
$denomenator
) =
@_
;
my
(
$u
,
$dim
);
foreach
$u
( @{
$units
} ) {
next
if
( !
$u
);
if
(
$u
=~ s/\^(.+)$// ) {
$dim
= $1;
}
elsif
(
$u
=~ /^sq,(.+)/ ) {
$u
= $1;
$dim
= 2;
}
elsif
(
$u
=~ /^cu,(.+)/ ) {
$u
= $1;
$dim
= 3;
}
else
{
$dim
= 1;
}
$dim
= -
$dim
if
(
$denomenator
);
if
(
$u
=~ /^-?\d+(?:\.\d+)?(?:e-?\d+)?$/ ) {
if
(
$dim
== 1 ) {
$dim
=
$u
}
elsif
(
$dim
== -1 ) {
$dim
= 1 /
$u
}
else
{
$dim
=
$u
*
*$dim
}
$u
=
"1"
;
}
if
(
defined
(
$u_group
->{
$u
} ) ) {
if
(
$u
eq
"1"
) {
$u_group
->{
$u
} *=
$dim
}
else
{
$u_group
->{
$u
} +=
$dim
}
}
else
{
$u_group
->{
$u
} =
$dim
;
}
}
}
sub
canonicalize_unit_string ($$) {
my
(
$units
,
$u_group
) =
@_
;
my
(
$num
,
$den
,
$u
,
@units
);
substitute_abbreviations( \
$units
);
$units
=~
tr
[*][ ];
$units
=~ s/\s*\^\s*/\^/g;
$units
=~ s/-\s*(\D)/ $1/g;
if
(
$units
=~ m|^([^/]*)/(.*)| ) {
$num
= $1;
$den
= $2;
$den
=~
tr
[/][ ];
}
else
{
$num
=
$units
;
$den
=
""
;
}
@units
=
split
( /\s+/,
$num
);
if
(
scalar
@units
) {
canonicalize_unit_list(
@units
,
$u_group
, 0 );
}
@units
=
split
( /\s+/,
$den
);
if
(
scalar
@units
) {
canonicalize_unit_list(
@units
,
$u_group
, 1 );
}
$u_group
;
}
sub
reduce_toplevel_unit ($\%) {
my
(
$units
,
$u_group
) =
@_
;
canonicalize_unit_string(
$units
,
$u_group
);
$current_prefix
= 1;
%current_group
= ();
reduce_unit(
$u_group
, 1, 0 );
%{
$u_group
} =
%current_group
;
$current_prefix
;
}
sub
finish_reducing_toplevel_unit (\%) {
my
(
$u_group
) =
@_
;
$current_prefix
= 1;
%current_group
= ();
reduce_unit(
$u_group
, 1, 1 );
%{
$u_group
} =
%current_group
;
$current_prefix
;
}
sub
get_factor {
my
(
$u1
,
$u2
) =
@_
;
(
$u1
eq
$u2
) ? 1 :
$factor
{
$u1
}{
$u2
};
}
my
$combined_f
;
my
$combined_f_useless
;
sub
attempt_direct_conversion {
my
(
$value
,
$u1
,
$u1_dim
,
$u2
,
$u2_dim
) =
@_
;
my
(
$f
);
if
(
$u1_dim
!=
$u2_dim
) {
$u1
=
"$u1^$u1_dim"
if
(
$u1_dim
!= 1 );
$u2
=
"$u2^$u2_dim"
if
(
$u2_dim
!= 1 );
$u1_dim
= 1;
}
if
(
$u1_dim
< 0 ) {
$u1_dim
= -
$u1_dim
;
$f
= get_factor(
$u2
,
$u1
);
}
else
{
$f
= get_factor(
$u1
,
$u2
);
}
if
(
defined
(
$f
) ) {
if
(
ref
(
$f
) eq
"CODE"
) {
$value
=
&$f
(
$value
,
$u1_dim
);
$combined_f_useless
= 1;
}
elsif
(
$f
!= 1 ) {
$f
=
$f
*
*$u1_dim
if
(
$u1_dim
> 1 );
$value
*=
$f
;
$combined_f
*=
$f
;
}
return
$value
;
}
undef
;
}
my
%tmp_u_history
;
my
@tmp_u_path
;
my
@tmp_dim_path
;
my
$tmp_value
;
my
$tmp_uX
;
my
$tmp_uX_dim
;
sub
apply_factor_chain {
my
$chained_f
= 1.0;
my
$chained_f_useless
= 0;
push
@tmp_u_path
,
$tmp_uX
;
my
$final
=
scalar
(
@tmp_u_path
) - 1;
my
$original_value
=
$tmp_value
;
my
(
$i
,
$f
,
$dim
);
for
(
$i
= 0;
$i
<
$final
; ++
$i
) {
$dim
=
$tmp_dim_path
[
$i
];
$f
= get_factor(
$tmp_u_path
[
$i
],
$tmp_u_path
[
$i
+ 1 ] );
if
(
defined
(
$f
) ) {
if
(
ref
(
$f
) eq
"CODE"
) {
if
(
$dim
< 0 ) {
$dim
= -
$dim
;
$f
= get_factor(
$tmp_u_path
[
$i
+ 1 ],
$tmp_u_path
[
$i
] );
}
$tmp_value
=
&$f
(
$tmp_value
,
$dim
);
$chained_f_useless
= 1;
}
elsif
(
$f
!= 1 ) {
$f
=
$f
*
*$dim
if
(
$dim
!= 1 );
$tmp_value
*=
$f
;
$chained_f
*=
$f
;
}
}
}
if
(
$chained_f_useless
) {
$combined_f_useless
= 1;
}
else
{
my
$u1
=
$tmp_u_path
[0];
if
(
exists
(
$factor
{
$u1
} ) &&
exists
(
$factor
{
$tmp_uX
} ) ) {
my
$u1_dim
=
$tmp_dim_path
[0];
$u1
=
"$u1^$u1_dim"
if
(
$u1_dim
!= 1 );
$tmp_uX
=
"$tmp_uX^$tmp_uX_dim"
if
(
$tmp_uX_dim
!= 1 );
register_factor(
$u1
,
$tmp_uX
,
$chained_f
);
$combined_f
*=
$chained_f
;
}
}
die
"OK\n"
;
}
sub
breadth_first_factor_search {
my
(
$level
,
$u
,
$dim
) =
@_
;
my
$attempts
= 0;
SEARCH:
{
$tmp_u_history
{
$u
} = 1;
++
$attempts
;
push
@tmp_u_path
,
$u
;
push
@tmp_dim_path
,
$dim
;
if
(
$level
== 0 ) {
if
(
$dim
==
$tmp_uX_dim
&&
defined
(
$factor
{
$u
}{
$tmp_uX
} ) ) {
apply_factor_chain();
}
}
else
{
my
$child
;
foreach
$child
(
keys
%{
$factor
{
$u
} } ) {
if
( !
defined
(
$tmp_u_history
{
$child
} ) ) {
breadth_first_factor_search(
$level
- 1,
$child
,
$dim
);
}
}
}
if
(
$attempts
< 2 ) {
if
(
$dim
== 1 ) {
if
(
$u
=~ /^([^^]+)\^(.+)/ ) {
$u
= $1;
$dim
= $2;
redo
SEARCH
if
( !
defined
(
$tmp_u_history
{
$u
} ) );
}
}
else
{
$u
=
"$u^$dim"
;
$dim
= 1;
redo
SEARCH
if
( !
defined
(
$tmp_u_history
{
$u
} ) );
}
}
}
while
(
$attempts
-- > 0 ) {
pop
@tmp_u_path
;
pop
@tmp_dim_path
;
}
}
sub
attempt_indirect_conversion {
my
(
$input_value
,
$u1
,
$u1_dim
,
$uX
,
$uX_dim
) =
@_
;
$tmp_value
=
$input_value
;
$tmp_uX
=
$uX
;
$tmp_uX_dim
=
$uX_dim
;
eval
{
my
$level
;
for
(
$level
= 0;
$level
< 4; ++
$level
) {
%tmp_u_history
= ();
@tmp_u_path
= ();
@tmp_dim_path
= ();
breadth_first_factor_search(
$level
,
$u1
,
$u1_dim
);
}
};
return
undef
if
( $@ ne
"OK\n"
);
return
$tmp_value
;
}
sub
perform_unit_conversion ($\%\%) {
my
(
$value
,
$u1_group
,
$u2_group
) =
@_
;
my
(
$u1
,
$u1_dim
);
my
(
$u2
,
$u2_dim
);
my
(
$new_value
);
DIRECT_UNIT_CONVERSION:
foreach
$u1
(
keys
%{
$u1_group
} ) {
$u1_dim
=
$u1_group
->{
$u1
};
foreach
$u2
(
keys
%{
$u2_group
} ) {
$u2_dim
=
$u2_group
->{
$u2
};
$new_value
= attempt_direct_conversion(
$value
,
$u1
,
$u1_dim
,
$u2
,
$u2_dim
);
if
(
defined
(
$new_value
) ) {
$value
=
$new_value
;
delete
$u1_group
->{
$u1
};
delete
$u2_group
->{
$u2
};
next
DIRECT_UNIT_CONVERSION;
}
}
}
INDIRECT_UNIT_CONVERSION:
foreach
$u1
(
keys
%{
$u1_group
} ) {
$u1_dim
=
$u1_group
->{
$u1
};
foreach
$u2
(
keys
%{
$u2_group
} ) {
$u2_dim
=
$u2_group
->{
$u2
};
$new_value
= attempt_indirect_conversion(
$value
,
$u1
,
$u1_dim
,
$u2
,
$u2_dim
);
if
(
defined
(
$new_value
) ) {
$value
=
$new_value
;
delete
$u1_group
->{
$u1
};
delete
$u2_group
->{
$u2
};
next
INDIRECT_UNIT_CONVERSION;
}
}
}
if
(
scalar
keys
%{
$u1_group
} ||
scalar
keys
%{
$u2_group
} ) {
$tmp_value
=
$value
;
die
"REDUCE\n"
;
}
$value
;
}
sub
compute_base_factors {
my
(
$pair
,
$f
,
$u1
,
$u2
);
while
( (
$pair
,
$f
) =
each
%conversions
) {
(
$u1
,
$u2
) =
split
( /,/,
$pair
);
register_factor(
$u1
,
$u2
,
$f
);
}
my
$code
=
"sub substitute_abbreviations { my(\$units) = \@_; SUBST: {\n"
;
my
(
$pattern
,
$subst
);
my
$i
= 0;
while
(
$i
<
scalar
@abbreviations
) {
$pattern
=
$abbreviations
[
$i
++ ];
$subst
=
$abbreviations
[
$i
++ ];
$code
.=
" redo SUBST if (\$\$units =~ s/$pattern/$subst/g);\n"
;
}
$code
.=
"} }"
;
eval
$code
;
foreach
$u1
(
keys
%formulas
) {
$formulas
{
$u1
} = canonicalize_unit_string(
$formulas
{
$u1
}, {} );
}
foreach
$u1
(
keys
%reductions
) {
$reductions
{
$u1
} = canonicalize_unit_string(
$reductions
{
$u1
}, {} );
}
$factors_computed
= 1;
}
sub
print_conversion {
my
(
$value
,
$u1
,
$u2
) =
@_
;
my
$my_result
= Convert(
$value
,
$u1
,
$u2
);
print
"$value $u1 == $my_result $u2\n"
;
$my_result
;
}
sub
convert {
my
(
$value
,
$u1
,
$u2
) =
@_
;
my
(
%u1_group
,
%u2_group
);
my
(
$u1_prefix
,
$u2_prefix
);
my
(
$f
);
return
(
$value
)
if
(
$u1
eq
$u2
);
if
(
defined
(
$f
=
$conversion_history
{
$u1
}{
$u2
} ) ) {
return
(
$value
*
$f
);
}
if
( !
$factors_computed
) {
compute_base_factors();
}
$u1_prefix
= reduce_toplevel_unit(
$u1
,
%u1_group
);
$u2_prefix
= reduce_toplevel_unit(
$u2
,
%u2_group
);
$combined_f
=
$u1_prefix
/
$u2_prefix
;
$combined_f_useless
= 0;
$value
*=
$combined_f
;
eval
{
$value
= perform_unit_conversion(
$value
,
%u1_group
,
%u2_group
); };
if
($@) {
if
( $@ eq
"REDUCE\n"
) {
$u1_prefix
= finish_reducing_toplevel_unit(
%u1_group
);
$u2_prefix
= finish_reducing_toplevel_unit(
%u2_group
);
$f
=
$u1_prefix
/
$u2_prefix
;
if
( !
$combined_f_useless
) {
$combined_f
*=
$f
;
}
$value
=
$tmp_value
*
$f
;
eval
{
$value
= perform_unit_conversion(
$value
,
%u1_group
,
%u2_group
); };
if
($@) {
if
( $@ eq
"REDUCE\n"
) {
Carp::croak
"conversion of unit '$u1' to '$u2' failed (incompatible units?)"
;
}
else
{
Carp::croak $@;
}
}
}
else
{
Carp::croak
"impossible! $@"
;
}
}
if
( !
$combined_f_useless
) {
$conversion_history
{
$u1
}{
$u2
} =
$combined_f
;
}
$value
;
}
1;