Changeset 31677

Show
Ignore:
Timestamp:
03/30/09 00:04:44 (4 years ago)
Author:
kokogiko
Message:

tag 0.0.4

Location:
lang/perl/Geo-Direction-Name/trunk
Files:
7 added
8 modified

Legend:

Unmodified
Added
Removed

  • lang/perl/Geo-Direction-Name/trunk/Changes

    r21013 r31677  
    11Revision history for Geo-Direction-Name 
     2 
     30.0.4  Sun Mar 29 2009 
     4       - Fix the fatal data error of ja locale 
     5       - Add zh_CN, zh_TW locale 
     6       - Add direction specification add-on system 
    27 
    380.0.3  Thu Oct 09 2008 

  • lang/perl/Geo-Direction-Name/trunk/MANIFEST

    r21014 r31677  
    66lib/Geo/Direction/Name/Locale/ja.pm 
    77lib/Geo/Direction/Name/Locale/ko.pm 
     8lib/Geo/Direction/Name/Locale/zh_CN.pm 
     9lib/Geo/Direction/Name/Locale/zh_TW.pm 
     10lib/Geo/Direction/Name/Spec.pm 
    811Makefile.PL 
    912MANIFEST                        This list of files 
     13META.yml 
    1014README 
    1115t/00.load.t 
    … …  
    1317t/01-2.ja_string.t 
    1418t/01-3.ko_string.t 
     19t/01-4.zh_CN_string.t 
     20t/01-5.zh_TW_string.t 
    1521t/02-1.en_dir.t 
    1622t/02-2.ja_dir.t 
    1723t/02-3.ko_dir.t 
     24t/02-4.zh_CN_dir.t 
     25t/02-5.zh_TW_dir.t 
    1826t/03.error.t 
    19 META.yml 

  • lang/perl/Geo-Direction-Name/trunk/lib/Geo/Direction/Name.pm

    r21013 r31677  
    55use Carp; 
    66 
    7 use version; our $VERSION = qv('0.0.3'); 
     7use version; our $VERSION = qv('0.0.4'); 
    88use Scalar::Util qw(looks_like_number); 
    99use Class::Inspector; 
    … …  
    1919 
    2020sub new { 
    21     my $class  = shift; 
    22     my $locale = shift || "en_US"; 
     21    my ( $class, $opt ) = @_; 
    2322 
    2423    my $self = bless {}, $class; 
    2524 
    26     $self->locale($locale); 
     25    my $spec; 
     26    my $locale; 
     27    if ( $opt && ref($opt) ) { 
     28        $spec   = $opt->{spec}; 
     29        $locale = $opt->{locale}; 
     30    } else { 
     31        # For backward compatibility 
     32        $locale = $opt; 
     33    } 
     34 
     35    $self->spec(   $spec ); 
     36    $self->locale( $locale ); 
    2737 
    2838    $self; 
    2939} 
    3040 
     41sub spec   { 
     42    my $self   =   shift; 
     43    my $spec   =   shift; 
     44    my $noerr  =   shift; 
     45    my $errstr =   "Specification class(subclass of Geo::Direction::Name::Spec) must be set"; 
     46    $spec      ||= 'default' unless ( $self->{spec} ); 
     47     
     48    if ( $spec ) { 
     49        $errstr = "Geo::Direction::Name not support this specification now: " . $spec; 
     50        delete $self->{spec}; 
     51        my $class = __PACKAGE__ . '::Spec' . ( $spec eq 'default' ? '' : '::' . ucfirst($spec) ) ; 
     52        if( Class::Inspector->loaded($class) || $class->require ) { 
     53            $self->{spec} = $class->new; 
     54        } 
     55    } 
     56 
     57    croak $errstr unless ( $noerr || $self->{spec} ); 
     58    $self->{spec}; 
     59} 
     60 
    3161sub locale { 
    32     my $self = shift; 
    33     if ($_[0]) { 
    34         my $locale = Geo::Direction::Name->load($_[0]); 
    35  
    36         croak("Geo::Direction::Name not support this locale now: " . $_[0]) unless ($locale); 
    37  
    38         $self->{locale} = $locale; 
    39     } 
    40  
    41     $self->{locale}; 
     62    my $self   = shift; 
     63 
     64    $self->spec->locale( @_ ); 
    4265} 
    4366  
    4467sub to_string   { 
    4568    my $self      = shift; 
    46     my $direction = shift; 
    47     my $option    = shift || {}; 
    48  
    49     my $abbr      = defined($option->{abbreviation}) ? $option->{abbreviation} : 1; 
    50     my $devide    = $option->{devide} || 8; 
    51  
    52     croak ("Direction value must be a number") unless (looks_like_number($direction)); 
    53     croak ("Abbreviation parameter must be 0 or 1") if ( $abbr !~ /^[01]$/ ); 
    54     my $log2 = log($devide)/log(2); 
    55     croak ("Devide parameter must be 4, 8, 16 or 32") if ( $log2 !~ /^[2345]$/ ); 
    56  
    57     $direction   += 180 / $devide; 
    58  
    59     while ($direction < 0.0 || $direction >= 360.0) { 
    60         $direction +=  $direction < 0 ? 360.0 : -360.0; 
    61     } 
    62  
    63     my $i = int($direction * $devide / 360) * (32 / $devide); 
    64  
    65     $self->locale->string($i,$abbr); 
     69 
     70    $self->spec->to_string( @_ ); 
    6671} 
    6772 
    6873sub from_string { 
    6974    my $self      = shift; 
    70     my $string    = shift; 
    71  
    72     $self->locale->direction($string); 
    73 } 
    74  
    75 sub load { 
    76     my $class  = shift; 
    77     my $locale = shift; 
    78  
    79     ($locale)  = split(/\./,$locale); 
    80     my ($lang) = split(/_/,$locale); 
    81  
    82     foreach my $class (map { "Geo::Direction::Name::Locale::" . $_ } ($locale, $lang)) { 
    83         if( Class::Inspector->loaded($class) || $class->require) { 
    84             return $class->new; 
    85         } 
    86     } 
    87     return; 
    88 } 
     75 
     76    $self->spec->from_string( @_ ); 
     77} 
     78 
    8979 
    90801; # Magic true value required at end of module 
    … …  
    151141=item * new( [LOCALE] ) 
    152142 
     143Old interface (Backward compatible). 
    153144Return the Geo::Direction::Name object. 
    154145LOCALE is optional, default is "en_US". 
     146 
     147=item * new( [OPTION] ) 
     148 
     149New interface. 
     150OPTION is hash reference, could be set two values. 
     151Default specification is used. 
     152 
     153=over 8 
     154 
     155=item * spec 
     156 
     157Set original spec name if want. 
     158If not set, use default specification. 
     159 
     160=item * locale 
     161 
     162Set locale. 
     163 
     164=back 
    155165 
    156166=back 
    … …  
    179189Default is 8. 
    180190 
     191After version 0.0.4, you can set other deviding number by using non-default specification. 
     192 
     193 
    181194=back 
    182195 
    … …  
    191204 
    192205=over 4 
     206 
     207=item * spec 
    193208 
    194209=item * locale 

  • lang/perl/Geo-Direction-Name/trunk/lib/Geo/Direction/Name/Locale.pm

    r18518 r31677  
    55use Carp; 
    66 
    7 use version; our $VERSION = qv('0.0.2'); 
     7use version; our $VERSION = qv('0.0.4'); 
    88 
    99BEGIN 
    … …  
    1616 
    1717sub new { 
    18     my $class  = shift; 
     18    my $class = shift; 
     19    my $dev   = shift || 32; 
    1920 
    2021    my $dir  = $class->dir_string(); 
    2122    my $abbr = $class->abbr_string(); 
    2223 
     24    my $dev1 = $dev - 1; 
    2325    my %dirs = (); 
    2426    my @strs = map {  
    … …  
    2628        $dirs{lc($abbr->[$_])} = $_; 
    2729        [ $dir->[$_], $abbr->[$_],]  
    28     } (0..31); 
     30    } (0..$dev1); 
    2931 
    3032    bless { 
    3133        dirs => \%dirs, 
    3234        strs => \@strs, 
     35        dev  => $dev,  
    3336    }, $class; 
    3437} 
    … …  
    4750    my $i = $self->{dirs}->{lc($str)}; 
    4851    return unless (defined($i)); 
    49     return $i * 11.25; 
     52    return $i * 360.0 / $self->{dev}; 
    5053} 
    5154 

  • lang/perl/Geo-Direction-Name/trunk/lib/Geo/Direction/Name/Locale/ja.pm

    r18518 r31677  
    4444    '西微北', 
    4545    '西北西', 
     46    '北西微西', 
     47    '北西', 
    4648    '北西微北', 
    47     '北西', 
    48     '北西微西', 
    4949    '北北西', 
    5050    '北微西', 

  • lang/perl/Geo-Direction-Name/trunk/t/01-2.ja_string.t

    r7217 r31677  
    80780732 
    808808--- expected 
     809北西微西 
     810 
     811=== 
     812--- input 
     813315.000 
     8144 
     815--- expected 
     816北 
     817 
     818=== 
     819--- input 
     820315.000 
     8218 
     822--- expected 
     823北西 
     824 
     825=== 
     826--- input 
     827315.000 
     82816 
     829--- expected 
     830北西 
     831 
     832=== 
     833--- input 
     834315.000 
     83532 
     836--- expected 
     837北西 
     838 
     839=== 
     840--- input 
     841326.250 
     8424 
     843--- expected 
     844北 
     845 
     846=== 
     847--- input 
     848326.250 
     8498 
     850--- expected 
     851北西 
     852 
     853=== 
     854--- input 
     855326.250 
     85616 
     857--- expected 
     858北北西 
     859 
     860=== 
     861--- input 
     862326.250 
     86332 
     864--- expected 
    809865北西微北 
    810866 
    811867=== 
    812868--- input 
    813 315.000 
    814 4 
    815 --- expected 
    816 北 
    817  
    818 === 
    819 --- input 
    820 315.000 
    821 8 
    822 --- expected 
    823 北西 
    824  
    825 === 
    826 --- input 
    827 315.000 
    828 16 
    829 --- expected 
    830 北西 
    831  
    832 === 
    833 --- input 
    834 315.000 
    835 32 
    836 --- expected 
    837 北西 
    838  
    839 === 
    840 --- input 
    841 326.250 
    842 4 
    843 --- expected 
    844 北 
    845  
    846 === 
    847 --- input 
    848 326.250 
    849 8 
    850 --- expected 
    851 北西 
    852  
    853 === 
    854 --- input 
    855 326.250 
     869337.500 
     8704 
     871--- expected 
     872北 
     873 
     874=== 
     875--- input 
     876337.500 
     8778 
     878--- expected 
     879北 
     880 
     881=== 
     882--- input 
     883337.500 
    85688416 
    857885--- expected 
    … …  
    860888=== 
    861889--- input 
    862 326.250 
    863 32 
    864 --- expected 
    865 北西微西 
    866  
    867 === 
    868 --- input 
    869890337.500 
    870 4 
    871 --- expected 
    872 北 
    873  
    874 === 
    875 --- input 
    876 337.500 
    877 8 
    878 --- expected 
    879 北 
    880  
    881 === 
    882 --- input 
    883 337.500 
    884 16 
     89132 
    885892--- expected 
    886893北北西 
    … …  
    888895=== 
    889896--- input 
    890 337.500 
    891 32 
    892 --- expected 
    893 北北西 
    894  
    895 === 
    896 --- input 
    897897348.750 
    8988984 

  • lang/perl/Geo-Direction-Name/trunk/t/02-2.ja_dir.t

    r7217 r31677  
    188188=== 
    189189--- input 
     190北西微西 
     191--- expected 
     192303.750 
     193 
     194=== 
     195--- input 
     196北西 
     197--- expected 
     198315.000 
     199 
     200=== 
     201--- input 
    190202北西微北 
    191203--- expected 
    192 303.750 
    193  
    194 === 
    195 --- input 
    196 北西 
    197 --- expected 
    198 315.000 
    199  
    200 === 
    201 --- input 
    202 北西微西 
    203 --- expected 
    204204326.250 
    205205 

  • lang/perl/Geo-Direction-Name/trunk/t/03.error.t

    r21013 r31677  
    66 
    77eval { Geo::Direction::Name->new("bb_BB"); }; 
    8 ok $@ =~ /Geo::Direction::Name not support this locale now: bb_BB/; 
     8ok $@ =~ /Geo::Direction::Name::Spec not support this locale now: bb_BB/; 
    99 
    1010my $dobj = Geo::Direction::Name->new; 
    … …  
    1717 
    1818eval { $dobj->to_string(180.0,{devide => 5}); }; 
    19 ok $@ =~ /Devide parameter must be 4, 8, 16 or 32/; 
     19ok $@ =~ /Devide parameter must be 4,8,16,32/; 
    2020 
    2121is $dobj->from_string("foo"), undef;