1package Math::Calc::Units::Convert::Multi; 2use base 'Exporter'; 3use vars qw(@EXPORT_OK); 4BEGIN { 5 @EXPORT_OK = qw(to_canonical simple_convert singular 6 variants major_variants 7 major_pref range_score pref_score 8 get_class construct); 9}; 10require Math::Calc::Units::Convert::Time; 11require Math::Calc::Units::Convert::Byte; 12require Math::Calc::Units::Convert::Date; 13require Math::Calc::Units::Convert::Distance; 14require Math::Calc::Units::Convert::Combo; 15use strict; 16use vars qw(@UnitClasses); 17 18@UnitClasses = qw(Math::Calc::Units::Convert::Time 19 Math::Calc::Units::Convert::Byte 20 Math::Calc::Units::Convert::Date 21 Math::Calc::Units::Convert::Distance 22 Math::Calc::Units::Convert::Combo); 23 24# to_canonical : unit -> value 25# 26sub to_canonical { 27 my ($unit) = @_; 28 29 my $val = 1; 30 my %newUnit; 31 32 while (my ($unitName, $power) = each %$unit) { 33 my ($mult, $canon) = name_to_canonical($unitName); 34 $val *= $mult ** $power; 35 36 if (ref $canon) { 37 # Uh oh, it was a combination of basic types 38 my $c = to_canonical($canon); 39 $val *= $c->[0] ** $power; 40 while (my ($name, $subPower) = each %{ $c->[1] }) { 41 if (($newUnit{$name} += $subPower * $power) == 0) { 42 delete $newUnit{$name}; 43 } 44 } 45 } else { 46 if (($newUnit{$canon} += $power) == 0) { 47 delete $newUnit{$canon}; 48 } 49 } 50 } 51 52 return [ $val, \%newUnit ]; 53} 54 55# name_to_canonical : unitName -> value x baseUnit 56# 57# Memoizing this doubles the speed of the test suite. 58# 59my %CANON_CACHE; 60sub name_to_canonical { 61 my $unitName = shift; 62 $CANON_CACHE{$unitName} ||= [ _name_to_canonical($unitName) ]; 63 return @{ $CANON_CACHE{$unitName} }; 64} 65 66sub _name_to_canonical { 67 my ($unitName) = @_; 68 69 # First, check for compound units 70 if (my $v = Math::Calc::Units::Convert::Combo->lookup_compound($unitName)) { 71 return @$v; 72 } 73 74 foreach my $uclass (@UnitClasses) { 75 if (my ($val, $base) = $uclass->to_canonical($unitName)) { 76 return ($val, $base); 77 } 78 } 79 return Math::Calc::Units::Convert::Base->to_canonical($unitName); 80} 81 82sub get_class { 83 my ($unitName) = @_; 84 my (undef, $canon) = name_to_canonical($unitName); 85 foreach my $uclass (@UnitClasses) { 86 my $canon_unit = $uclass->canonical_unit(); 87 next if ! defined $canon_unit; 88 return $uclass if $canon_unit eq $canon; 89 } 90 return 'Math::Calc::Units::Convert::Base'; 91} 92 93sub simple_convert { 94 my ($u, $v) = @_; 95 foreach my $uclass (@UnitClasses) { 96 my $c; 97 return $c if $c = $uclass->simple_convert($u, $v); 98 } 99 return; 100} 101 102sub singular { 103 my ($unitName) = @_; 104 return get_class($unitName)->singular($unitName); 105} 106 107sub variants { 108 my ($base) = @_; 109 return get_class($base)->variants($base); 110} 111 112sub major_variants { 113 my ($base) = @_; 114 return get_class($base)->major_variants($base); 115} 116 117sub major_pref { 118 my ($base) = @_; 119 return get_class($base)->major_pref($base); 120} 121 122sub range_score { 123 my ($val, $unitName) = @_; 124 die if ref $unitName; 125 return get_class($unitName)->range_score($val, $unitName); 126} 127 128sub pref_score { 129 my ($unitName) = @_; 130 die if ref $unitName; 131 return get_class($unitName)->pref_score($unitName); 132} 133 134sub construct { 135 my ($constructor, $args) = @_; 136 foreach my $uclass (@UnitClasses) { 137 my $c; 138 return $c if $c = $uclass->construct($constructor, $args); 139 } 140 return; 141} 142 1431; 144