Skip to content
Browse files

Another commit caused by git noobness.

  • Loading branch information...
1 parent dc408ad commit f72a83996f8ad996ff956d2865c6ed821134ef00 @bluefeet committed Jun 23, 2009
Showing with 180 additions and 211 deletions.
  1. +5 −0 Changes
  2. +12 −4 MANIFEST
  3. +3 −0 META.yml
  4. +3 −0 Makefile.PL
  5. +109 −2 README
  6. +23 −168 lib/Class/Measure.pm
  7. +9 −26 lib/Class/Measure/Length.pm
  8. +4 −4 t/00_measure.t
  9. +12 −7 t/01_length.t
View
5 Changes
@@ -1,5 +1,10 @@
Revision history for Perl extension Class::Measure.
+0.04
+ - Fix tests to declare the number of test first and to not use lib.
+ - Remove AUTOLOAD. Slap me please.
+ - Other random cleanups.
+
0.03
- Added nautical_mile length unit type.
View
16 MANIFEST
@@ -1,9 +1,17 @@
Changes
-MANIFEST
-README
-Build.PL
-META.yml
+inc/Module/Install.pm
+inc/Module/Install/Base.pm
+inc/Module/Install/Can.pm
+inc/Module/Install/Fetch.pm
+inc/Module/Install/Makefile.pm
+inc/Module/Install/Metadata.pm
+inc/Module/Install/Win32.pm
+inc/Module/Install/WriteAll.pm
lib/Class/Measure.pm
lib/Class/Measure/Length.pm
+Makefile.PL
+MANIFEST This list of files
+META.yml
+README
t/00_measure.t
t/01_length.t
View
3 META.yml
@@ -4,6 +4,7 @@ author:
- 'Aran Clary Deltac <bluefeet@cpan.org>'
build_requires:
ExtUtils::MakeMaker: 6.42
+ Test::More: 0.82
configure_requires:
ExtUtils::MakeMaker: 6.42
distribution_type: module
@@ -17,6 +18,8 @@ no_index:
directory:
- inc
- t
+requires:
+ Sub::Exporter: 0.982
resources:
license: http://dev.perl.org/licenses/
version: 0.04
View
3 Makefile.PL
@@ -3,4 +3,7 @@ use inc::Module::Install;
name 'Class-Measure';
all_from 'lib/Class/Measure.pm';
+requires 'Sub::Exporter' => '0.982';
+test_requires 'Test::More' => '0.82';
+
WriteAll;
View
111 README
@@ -1,4 +1,111 @@
-Class::Measure 0.03
+NAME
+ Class::Measure - Create, compare, and convert units of measurement.
-See: http://www.arandeltac.com/ClassMeasureModule
+SYNOPSIS
+ See Class::Measure::Length for some examples.
+
+DESCRIPTION
+ This is a base class that is inherited by the Class::Measure classes.
+ This distribution comes with the class Class::Measure::Length.
+
+ The classes Class::Measure::Area, Class::Measure::Mass,
+ Class::Measure::Space, Class::Measure::Temperature, and
+ Class::Measure::Volume are planned and will be added soon.
+
+ The methods described here are available in all Class::Measure classes.
+
+METHODS
+ new
+ my $m = new Class::Measure::Length( 1, 'inch' );
+
+ Creates a new measurement object. You must pass an initial measurement
+ and default unit.
+
+ In most cases the measurement class that you are useing will export a
+ method to create new measurements. For example Class::Measure::Length
+ exports the length() method.
+
+ unit
+ my $unit = $m->unit;
+
+ Returns the object's default unit.
+
+ set_unit
+ $m->set_unit( 'feet' );
+
+ Sets the default unit of the measurement.
+
+ value
+ my $yards = $m->value('yards');
+ my $val = $m->value;
+ print "$m is the same as $val when in a string\n";
+
+ Retrieves the value of the measurement in the default unit. You may
+ specify a unit in which case the value is converted to the unit and
+ returned.
+
+ This method is also used to handle overloading of stringifying the
+ object.
+
+ set_value
+ my $m = length( 0, 'inches' );
+ $m->set_value( 12 ); # 12 inches.
+ $m->set_value( 1, 'foot' ); # 1 foot.
+
+ Sets the measurement in the default unit. You may specify a new default
+ unit as well.
+
+ reg_units
+ Class::Measure::Length->reg_units(
+ 'inch', 'foot', 'yard'
+ );
+
+ Registers one or more units for use in the specified class. Units should
+ be in the singular, most common, form.
+
+ units
+ my @units = Class::Measure::Length->units();
+
+ Returns a list of all registered units.
+
+ reg_aliases
+ Class::Measure::Length->reg_aliases(
+ ['feet','ft'] => 'foot',
+ ['in','inches'] => 'inch',
+ 'yards' => 'yard'
+ );
+
+ Register alternate names for units. Expects two arguments per unit to
+ alias. The first argument being the alias (scalar) or aliases (array
+ ref), and the second argument being the unit to alias them to.
+
+ reg_convs
+ Class::Measure::Length->reg_convs(
+ 12, 'inches' => 'foot',
+ 'yard' => '3', 'feet'
+ );
+
+ Registers a unit conversion. There are three distinct ways to specify a
+ new conversion. Each requires three arguments.
+
+ $count1, $unit1 => $unit2
+ $unit1 => $count2, $unit2
+
+ These first two syntaxes create automatic reverse conversions as well.
+ So, saying there are 12 inches in a foot implies that there are 1/12
+ feet in an inch.
+
+ $unit1 => $unit2, $sub
+
+ The third syntax accepts a subroutine as the last argument the
+ subroutine will be called with the value of $unit1 and it's return value
+ will be assigned to $unit2. This third syntax does not create a reverse
+ conversion automatically.
+
+AUTHOR
+ Aran Clary Deltac <bluefeet@cpan.org>
+
+LICENSE
+ This library is free software; you can redistribute it and/or modify it
+ under the same terms as Perl itself.
View
191 lib/Class/Measure.pm
@@ -1,6 +1,4 @@
-# vim: ts=8:sw=4:sts=4:et
package Class::Measure;
-#------------------------------------------------
=head1 NAME
@@ -23,14 +21,12 @@ The methods described here are available in all Class::Measure classes.
=cut
-#------------------------------------------------
use strict;
use warnings;
-our $VERSION = '0.03';
-our $AUTOLOAD;
-use Carp;
-use Data::Dumper;
+our $VERSION = '0.04';
+
+use Carp qw( croak );
use overload
'+'=>\&_ol_add, '-'=>\&_ol_sub,
@@ -40,7 +36,6 @@ use overload
our $type_convs = {};
our $type_paths = {};
our $type_aliases = {};
-#------------------------------------------------
=head1 METHODS
@@ -58,7 +53,6 @@ length() method.
=cut
-#------------------------------------------------
sub new {
my $class = shift;
$class = ref($class) || $class;
@@ -68,7 +62,6 @@ sub new {
$self->set_value( @_ );
return $self;
}
-#------------------------------------------------
=head2 unit
@@ -78,12 +71,10 @@ Returns the object's default unit.
=cut
-#------------------------------------------------
sub unit {
my $self = shift;
return $self->{unit};
}
-#------------------------------------------------
=head2 set_unit
@@ -93,14 +84,12 @@ Sets the default unit of the measurement.
=cut
-#------------------------------------------------
sub set_unit {
my $self = shift;
my $unit = $self->_unalias( shift );
$self->_conv( $unit );
$self->{unit} = $unit;
}
-#------------------------------------------------
=head2 value
@@ -117,15 +106,13 @@ stringifying the object.
=cut
-#------------------------------------------------
sub value {
my $self = shift;
if( @_ ){
return $self->_conv(shift);
}
return $self->{values}->{$self->{unit}};
}
-#------------------------------------------------
=head2 set_value
@@ -138,13 +125,11 @@ specify a new default unit as well.
=cut
-#------------------------------------------------
sub set_value {
my $self = shift;
$self->{unit} = $self->_unalias(pop @_) if( @_>1 );
$self->{values} = { $self->{unit} => shift };
}
-#------------------------------------------------
=head2 reg_units
@@ -158,17 +143,23 @@ form.
=cut
-#------------------------------------------------
sub reg_units {
my $self = shift;
my $class = ref($self) || $self;
my $convs = $type_convs->{$class} ||= {};
foreach my $unit (@_){
if( defined $convs->{$unit} ){ croak('This unit has already been defined'); }
+ eval('*' . $class . '::' . $unit. ' = sub{
+ my ($self, $value) = @_;
+ if (defined $value) {
+ $self->set_value( $value, $unit );
+ } else {
+ return $self->value( $unit );
+ }
+ }');
$convs->{$unit} = {};
}
}
-#------------------------------------------------
=head2 units
@@ -178,13 +169,11 @@ Returns a list of all registered units.
=cut
-#------------------------------------------------
sub units {
my $self = shift;
my $class = ref($self) || $self;
return keys(%{$type_convs->{$class}});
}
-#------------------------------------------------
=head2 reg_aliases
@@ -201,7 +190,6 @@ the second argument being the unit to alias them to.
=cut
-#------------------------------------------------
sub reg_aliases {
my $self = shift;
my $class = ref($self) || $self;
@@ -214,10 +202,13 @@ sub reg_aliases {
foreach my $alias (@aliases){
if( defined $aliases->{$alias} ){ croak('Alias already in use'); }
$aliases->{$alias} = $unit;
+ eval('*' . $class . '::' . $alias. ' = sub{
+ my ($self, $value) = @_;
+ return $self->$unit($value);
+ }');
}
}
}
-#------------------------------------------------
=head2 reg_convs
@@ -246,7 +237,6 @@ third syntax does not create a reverse conversion automatically.
=cut
-#------------------------------------------------
sub reg_convs {
my $self = shift;
croak('Wrong number of arguments (must be a multiple of three)') if( (@_+0) % 3 );
@@ -275,43 +265,15 @@ sub reg_convs {
}
$type_paths->{$class} = {};
}
-#------------------------------------------------
-
-=head1 PRIVATE METHODS
-
-These methods are used internally and should only
-be useful to authors of Class::Measure classes.
-
-=head2 _unalias
-Accepts a single name either returns the name if it
-is the name of a unit, returns the name of the unit
-that it aliases to, or throws an error if neither a
-matching alias or matching unit was found.
-
-=cut
-
-#------------------------------------------------
sub _unalias {
my $self = shift;
my $class = ref($self) || $self;
my $unit = shift;
return $unit if( defined $type_convs->{$class}->{$unit} );
return $type_aliases->{$class}->{$unit} || croak('Unkown unit or alias "'.$unit.'"');
}
-#------------------------------------------------
-
-=head2 _conv
-Returns the current value as converted to the
-specified unit. Any values that are converted
-are cached so that proceeding calls that might
-require the value in the same unit. If the value
-is ever changed then the value cache is cleared.
-
-=cut
-
-#------------------------------------------------
sub _conv {
my $self = shift;
my $class = ref($self) || $self;
@@ -334,24 +296,7 @@ sub _conv {
}
return $value;
}
-#------------------------------------------------
-
-=head2 _path
-
- my $path = $m->_path(
- 'inch',
- 'yard'
- );
- # $path = ['inch','foot','yard']
-
-Figures out the best conversion path for converting
-from the first unit to the second. Any paths that
-are created are cached for proceding calls that
-might need to get the same path.
-
-=cut
-#------------------------------------------------
sub _path {
my $self = shift;
my $from = $self->_unalias(shift);
@@ -360,7 +305,7 @@ sub _path {
my $key = "$from-$to";
my $paths = $type_paths->{$class} ||= {};
if( defined $paths->{$key} ){ return [@{$paths->{$key}}]; }
-
+
my $units = $type_convs->{$class} ||= {};
my $path;
foreach (1..10){
@@ -371,16 +316,7 @@ sub _path {
$paths->{$key} = $path;
return [@$path];
}
-#------------------------------------------------
-
-=head2 _find_path
-
-Used by _path for recursively finding the best
-path for a conversion.
-=cut
-
-#------------------------------------------------
sub _find_path {
my($level,$to,$units) = splice(@_,0,3);
unless( ref $level ){ $level=[$level]; }
@@ -395,10 +331,10 @@ sub _find_path {
return $path;
}
}
-
+
return 0 if( $depth+1 == $max_depth );
$depth ++;
-
+
foreach my $unit (@$level){
push @$path, $unit;
if(_find_path( [keys %{$units->{$unit}}], $to, $units, $max_depth, $depth, $path )){
@@ -407,24 +343,11 @@ sub _find_path {
}
pop @$path;
}
-
+
$depth --;
return 0;
}
-#------------------------------------------------
-
-=head2 _ol_add
-
- $m = length(2,'inches') + length(1,'foot'); # 14 inches
- $m++; # 15 inches
- $m += length(3,'inches'); # 18 inches
-
-This method handles the overloading of addition
-logic, such as +, +=, and ++.
-=cut
-
-#------------------------------------------------
sub _ol_add {
my($one,$two,$opt) = @_;
if($opt){ my $tmp=$one; $one=$two; $two=$tmp; }
@@ -440,16 +363,7 @@ sub _ol_add {
return $two;
}
}
-#------------------------------------------------
-
-=head2 _ol_sub
-
-This method is the same as _ol_add, but works on
-subtraction.
-=cut
-
-#------------------------------------------------
sub _ol_sub {
my($one,$two,$opt) = @_;
if($opt){ my $tmp=$one; $one=$two; $two=$tmp; }
@@ -465,15 +379,7 @@ sub _ol_sub {
return $two;
}
}
-#------------------------------------------------
-
-=head2 _ol_mult
-
-Multiplication overloader.
-=cut
-
-#------------------------------------------------
sub _ol_mult {
my($one,$two,$opt) = @_;
if($opt){ my $tmp=$one; $one=$two; $two=$tmp; }
@@ -487,15 +393,7 @@ sub _ol_mult {
return $two;
}
}
-#------------------------------------------------
-
-=head2 _ol_div
-
-Division overloader.
-=cut
-
-#------------------------------------------------
sub _ol_div {
my($one,$two,$opt) = @_;
if($opt){ my $tmp=$one; $one=$two; $two=$tmp; }
@@ -509,62 +407,19 @@ sub _ol_div {
return $two;
}
}
-#------------------------------------------------
-
-=head2 _ol_str
-
-Overloads the stringification of this object by
-calling and returning the response of value().
-=cut
-
-#------------------------------------------------
sub _ol_str {
my $self = shift;
return $self->value;
}
-#------------------------------------------------
-
-=head2 AUTOLOAD
-
- # Same as get_value('feet').
- my $feet = $m->feet;
-
- # Same as set_value(2,'feet').
- $m->feet(2);
-Retrieve and set the leangth of measurement.
-
-=cut
-
-#------------------------------------------------
-sub DESTROY {}
-sub AUTOLOAD {
- my $self = shift;
- my $unit = $self->_unalias( ( $AUTOLOAD =~ /([^:]+)$/ )[0] );
- if(@_){
- $self->set_value( shift, $unit );
- }else{
- return $self->value( $unit );
- }
-}
-#------------------------------------------------
-
-=head1 SUBCLASSING
-
-Its straight-forward, see L<Class::Measure::Length> for a simple and complete example.
-
-=head1 TODO/BUGS/SUPPORT
-
-See L<http://www.arandeltac.com/ClassMeasureModule>.
+1;
=head1 AUTHOR
-Copyright (c) 2005 Aran Clary Deltac
+Aran Clary Deltac <bluefeet@cpan.org>
-This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
+=head1 LICENSE
-=cut
+This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
-#------------------------------------------------
-1;
View
35 lib/Class/Measure/Length.pm
@@ -1,6 +1,4 @@
-# vim: ts=8:sw=4:sts=4:et
package Class::Measure::Length;
-#------------------------------------------------
=head1 NAME
@@ -12,13 +10,14 @@ Class::Measure::Length - Calculate measurements of length.
=cut
-#------------------------------------------------
use strict;
use warnings;
-use base qw( Class::Measure Exporter );
-our @EXPORT = qw( length );
-#------------------------------------------------
+use base qw( Class::Measure );
+
+use Sub::Exporter -setup => {
+ exports => [qw( length )]
+};
=head1 METHODS
@@ -33,9 +32,7 @@ Creates a new measurement object.
=cut
-#------------------------------------------------
sub length { return __PACKAGE__->new(@_); }
-#------------------------------------------------
=head1 UNITS
@@ -57,7 +54,6 @@ And all veriations are aliased, such as "m", "meter",
=cut
-#------------------------------------------------
__PACKAGE__->reg_units(
qw( kilometre centimetre millimetre decimetre micrometre nanometre metre )
);
@@ -78,7 +74,6 @@ __PACKAGE__->reg_convs(
1000, 'microns' => 'mm',
1000, 'nanometers' => 'micron',
);
-#------------------------------------------------
=head2 Shared
@@ -97,7 +92,6 @@ All relevant aliases included.
=cut
-#------------------------------------------------
__PACKAGE__->reg_units(
qw( inch foot yard rod mile chain furlong )
);
@@ -121,7 +115,6 @@ __PACKAGE__->reg_convs(
'chain' => 66, 'feet',
'furlong' => 10, 'chains',
);
-#------------------------------------------------
=head2 United Stats
@@ -136,7 +129,6 @@ Aliases included.
=cut
-#------------------------------------------------
__PACKAGE__->reg_units(
qw( survey_mile link fathom cable_length )
);
@@ -152,7 +144,6 @@ __PACKAGE__->reg_convs(
'fathom' => 6, 'feet',
'cable_length' => 123, 'fathoms',
);
-#------------------------------------------------
=head2 Imperial
@@ -161,7 +152,6 @@ in this set is "league".
=cut
-#------------------------------------------------
__PACKAGE__->reg_units(
qw( league )
);
@@ -171,7 +161,6 @@ __PACKAGE__->reg_aliases(
__PACKAGE__->reg_convs(
'league' => 3, 'miles',
);
-#------------------------------------------------
=head2 Other
@@ -180,7 +169,6 @@ __PACKAGE__->reg_convs(
=cut
-#------------------------------------------------
__PACKAGE__->reg_units(
qw( light_second nautical_mile )
);
@@ -192,19 +180,14 @@ __PACKAGE__->reg_convs(
'light_second' => 299792458, 'm',
'nautical_mile' => 1852, 'm',
);
-#------------------------------------------------
-
-=head1 TODO/BUGS/SUPPORT
-See L<http://www.arandeltac.com/ClassMeasureModule>.
+1;
=head1 AUTHOR
-Copyright (c) 2005 Aran Clary Deltac
+Aran Clary Deltac <bluefeet@cpan.org>
-This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
+=head1 LICENSE
-=cut
+This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
-#------------------------------------------------
-1;
View
8 t/00_measure.t
@@ -1,10 +1,10 @@
-# vim: ts=8:sw=4:sts=4:et
use strict;
use warnings;
-use lib 'lib';
-use Test::More 'no_plan';
-use_ok('Class::Measure');
+use Test::More tests => 24;
+BEGIN{
+ use_ok('Class::Measure');
+}
eval{ Class::Measure->new };
ok( $@, 'cannot create from base class' );
View
19 t/01_length.t
@@ -1,18 +1,23 @@
-# vim: ts=8:sw=4:sts=4:et
use strict;
use warnings;
-use lib 'lib';
-use Test::More 'no_plan';
-use_ok('Class::Measure');
-use_ok('Class::Measure::Length');
+use Test::More tests => 5;
+BEGIN{
+ use_ok('Class::Measure::Length', 'length');
+}
my @units = sort Class::Measure::Length->units;
my $first = shift(@units);
-my $m = Class::Measure::Length::length( 10, $first );
+my $m = length( 10, $first );
foreach my $unit (@units){
$m->set_unit($unit);
}
$m->set_unit($first);
-ok( ( int($m->value) == 10 ), 'run all conversions' );
+ok( ( int($m->$first) == 10 ), 'run all conversions' );
+
+my $foot = length( 12, 'inches' );
+is( $foot->feet(), 1, '12 inches is 1 foot' );
+my $yard = $foot * 3;
+is( $yard->yards(), 1, '3 feet is 1 yard' );
+is( $yard->inches(), 36, '1 yard is 36 inches' );

0 comments on commit f72a839

Please sign in to comment.
Something went wrong with that request. Please try again.