From: Dagfinn Ilmari Mannsaker Date: Sun, 17 Jun 2007 19:38:15 +0000 (+0000) Subject: import DBIx-Class-InflateColumn-IP 0.02001 from CPAN X-Git-Tag: v0.02001 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=3baacba6651b3ec616a8e6ee699298717c0854e2;p=dbsrgits%2FDBIx-Class-InflateColumn-IP.git import DBIx-Class-InflateColumn-IP 0.02001 from CPAN git-cpan-module: DBIx-Class-InflateColumn-IP git-cpan-version: 0.02001 git-cpan-authorid: ILMARI git-cpan-file: authors/id/I/IL/ILMARI/DBIx-Class-InflateColumn-IP-0.02001.tar.gz --- diff --git a/Changes b/Changes index c7cecf1..7fb9b91 100644 --- a/Changes +++ b/Changes @@ -1,5 +1,8 @@ Revision history for DBIx::Class::InflateColumn::IP +0.02001 Sun Jun 17 20:27:34 2007 + - Initial version of format autodetection, based solely on column type. + 0.02000 Thu May 24 11:28:40 2007 - First release uploaded to CPAN. - Added configuration options for format and class. diff --git a/MANIFEST b/MANIFEST index 2d83afe..17b3f28 100644 --- a/MANIFEST +++ b/MANIFEST @@ -13,7 +13,6 @@ inc/Module/Install/WriteAll.pm lib/DBIx/Class/InflateColumn/IP.pm Makefile.PL MANIFEST -MANIFEST.SKIP META.yml # Will be created by "make dist" README t/00-load.t diff --git a/MANIFEST.SKIP b/MANIFEST.SKIP deleted file mode 100644 index 6d0568a..0000000 --- a/MANIFEST.SKIP +++ /dev/null @@ -1,21 +0,0 @@ -\bRCS\b -\bCVS\b -,v$ -\B\.svn\b -t/var -^blib/ -^pm_to_blib -^MakeMaker-\d -Makefile$ -Makefile.old$ -Build.PL -Build.bat -\.db -t/TEST$ -t/SMOKE$ -^blibdirs\.ts -\.gz -~$ -\.bak$ -^\.cvsignore -TODO diff --git a/META.yml b/META.yml index 3e3c911..5241b47 100644 --- a/META.yml +++ b/META.yml @@ -1,8 +1,8 @@ --- abstract: Auto-create NetAddr::IP objects from columns. -author: "Dagfinn Ilmari Manns\xC3\xA5ker, C<< >>" +author: "Dagfinn Ilmari Manns\xE5ker, C<< >>" distribution_type: module -generated_by: Module::Install version 0.65 +generated_by: Module::Install version 0.67 license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.3.html @@ -17,4 +17,4 @@ requires: NetAddr::IP: 0 perl: 5.6.1 tests: t/*.t -version: 0.02000 +version: 0.02001 diff --git a/Makefile.PL b/Makefile.PL index ad53317..3143016 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -11,7 +11,7 @@ requires 'DBIx::Class' => 0.07005; requires 'NetAddr::IP'; tests 't/*.t'; -clean_files 'DBIx-Class-InflateColumn-IP-* t/var'; +clean_files 'DBIx-Class-InflateColumn-IP-* t/var README'; eval { system 'pod2text lib/DBIx/Class/InflateColumn/IP.pm > README'; diff --git a/README b/README index f9ca334..173d954 100644 --- a/README +++ b/README @@ -34,6 +34,11 @@ SYNOPSIS print 'IP address: ', $host->ip_address->addr; print 'Address type: ', $host->ip_address->iptype; + DBIx::Class::InflateColumn::IP supports a limited amount of + auto-detection of the format based on the column type. If the type + begins with "int", it's assumed to be numeric, while "inet" and "cidr" + (as used by e.g. PostgreSQL) are assumed to be "cidr" format. + METHODS ip_class Arguments: $class @@ -55,7 +60,7 @@ METHODS directly by end users. AUTHOR - Dagfinn Ilmari MannsÃ¥ker, "" + Dagfinn Ilmari Mannsåker, "" BUGS Please report any bugs or feature requests to @@ -89,7 +94,7 @@ SEE ALSO DBIx::Class, NetAddr::IP COPYRIGHT & LICENSE - Copyright 2007 Dagfinn Ilmari MannsÃ¥ker, all rights reserved. + Copyright 2007 Dagfinn Ilmari Mannsåker, all rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. diff --git a/inc/Module/Install.pm b/inc/Module/Install.pm index af6a59c..9d13686 100644 --- a/inc/Module/Install.pm +++ b/inc/Module/Install.pm @@ -28,7 +28,7 @@ BEGIN { # This is not enforced yet, but will be some time in the next few # releases once we can make sure it won't clash with custom # Module::Install extensions. - $VERSION = '0.65'; + $VERSION = '0.67'; } # Whether or not inc::Module::Install is actually loaded, the diff --git a/inc/Module/Install/AutoInstall.pm b/inc/Module/Install/AutoInstall.pm index b4b55af..c244cb5 100644 --- a/inc/Module/Install/AutoInstall.pm +++ b/inc/Module/Install/AutoInstall.pm @@ -6,7 +6,7 @@ use Module::Install::Base; use vars qw{$VERSION $ISCORE @ISA}; BEGIN { - $VERSION = '0.65'; + $VERSION = '0.67'; $ISCORE = 1; @ISA = qw{Module::Install::Base}; } diff --git a/inc/Module/Install/Base.pm b/inc/Module/Install/Base.pm index b46a8ca..81fbcb6 100644 --- a/inc/Module/Install/Base.pm +++ b/inc/Module/Install/Base.pm @@ -1,7 +1,7 @@ #line 1 package Module::Install::Base; -$VERSION = '0.65'; +$VERSION = '0.67'; # Suspend handler for "redefined" warnings BEGIN { diff --git a/inc/Module/Install/Can.pm b/inc/Module/Install/Can.pm index 9bcf278..5d1eab8 100644 --- a/inc/Module/Install/Can.pm +++ b/inc/Module/Install/Can.pm @@ -11,7 +11,7 @@ use ExtUtils::MakeMaker (); use vars qw{$VERSION $ISCORE @ISA}; BEGIN { - $VERSION = '0.65'; + $VERSION = '0.67'; $ISCORE = 1; @ISA = qw{Module::Install::Base}; } diff --git a/inc/Module/Install/Fetch.pm b/inc/Module/Install/Fetch.pm index 0d2c39c..e884477 100644 --- a/inc/Module/Install/Fetch.pm +++ b/inc/Module/Install/Fetch.pm @@ -6,7 +6,7 @@ use Module::Install::Base; use vars qw{$VERSION $ISCORE @ISA}; BEGIN { - $VERSION = '0.65'; + $VERSION = '0.67'; $ISCORE = 1; @ISA = qw{Module::Install::Base}; } diff --git a/inc/Module/Install/Include.pm b/inc/Module/Install/Include.pm index 964b93d..574acc8 100644 --- a/inc/Module/Install/Include.pm +++ b/inc/Module/Install/Include.pm @@ -6,7 +6,7 @@ use Module::Install::Base; use vars qw{$VERSION $ISCORE @ISA}; BEGIN { - $VERSION = '0.65'; + $VERSION = '0.67'; $ISCORE = 1; @ISA = qw{Module::Install::Base}; } diff --git a/inc/Module/Install/Makefile.pm b/inc/Module/Install/Makefile.pm index eb67033..fbc5cb2 100644 --- a/inc/Module/Install/Makefile.pm +++ b/inc/Module/Install/Makefile.pm @@ -7,7 +7,7 @@ use ExtUtils::MakeMaker (); use vars qw{$VERSION $ISCORE @ISA}; BEGIN { - $VERSION = '0.65'; + $VERSION = '0.67'; $ISCORE = 1; @ISA = qw{Module::Install::Base}; } @@ -17,196 +17,221 @@ sub Makefile { $_[0] } my %seen = (); sub prompt { - shift; - - # Infinite loop protection - my @c = caller(); - if ( ++$seen{"$c[1]|$c[2]|$_[0]"} > 3 ) { - die "Caught an potential prompt infinite loop ($c[1]|$c[2]|$_[0])"; - } - - # In automated testing, always use defaults - if ( $ENV{AUTOMATED_TESTING} and ! $ENV{PERL_MM_USE_DEFAULT} ) { - local $ENV{PERL_MM_USE_DEFAULT} = 1; - goto &ExtUtils::MakeMaker::prompt; - } else { - goto &ExtUtils::MakeMaker::prompt; - } + shift; + + # Infinite loop protection + my @c = caller(); + if ( ++$seen{"$c[1]|$c[2]|$_[0]"} > 3 ) { + die "Caught an potential prompt infinite loop ($c[1]|$c[2]|$_[0])"; + } + + # In automated testing, always use defaults + if ( $ENV{AUTOMATED_TESTING} and ! $ENV{PERL_MM_USE_DEFAULT} ) { + local $ENV{PERL_MM_USE_DEFAULT} = 1; + goto &ExtUtils::MakeMaker::prompt; + } else { + goto &ExtUtils::MakeMaker::prompt; + } } sub makemaker_args { - my $self = shift; - my $args = ($self->{makemaker_args} ||= {}); - %$args = ( %$args, @_ ) if @_; - $args; + my $self = shift; + my $args = ($self->{makemaker_args} ||= {}); + %$args = ( %$args, @_ ) if @_; + $args; } # For mm args that take multiple space-seperated args, # append an argument to the current list. sub makemaker_append { - my $self = shift; - my $name = shift; - my $args = $self->makemaker_args; - $args->{name} = defined $args->{$name} - ? join( ' ', $args->{name}, @_ ) - : join( ' ', @_ ); + my $self = sShift; + my $name = shift; + my $args = $self->makemaker_args; + $args->{name} = defined $args->{$name} + ? join( ' ', $args->{name}, @_ ) + : join( ' ', @_ ); } sub build_subdirs { - my $self = shift; - my $subdirs = $self->makemaker_args->{DIR} ||= []; - for my $subdir (@_) { - push @$subdirs, $subdir; - } + my $self = shift; + my $subdirs = $self->makemaker_args->{DIR} ||= []; + for my $subdir (@_) { + push @$subdirs, $subdir; + } } sub clean_files { - my $self = shift; - my $clean = $self->makemaker_args->{clean} ||= {}; - %$clean = ( - %$clean, - FILES => join(' ', grep length, $clean->{FILES}, @_), - ); + my $self = shift; + my $clean = $self->makemaker_args->{clean} ||= {}; + %$clean = ( + %$clean, + FILES => join(' ', grep length, $clean->{FILES}, @_), + ); } sub realclean_files { - my $self = shift; - my $realclean = $self->makemaker_args->{realclean} ||= {}; - %$realclean = ( - %$realclean, - FILES => join(' ', grep length, $realclean->{FILES}, @_), - ); + my $self = shift; + my $realclean = $self->makemaker_args->{realclean} ||= {}; + %$realclean = ( + %$realclean, + FILES => join(' ', grep length, $realclean->{FILES}, @_), + ); } sub libs { - my $self = shift; - my $libs = ref $_[0] ? shift : [ shift ]; - $self->makemaker_args( LIBS => $libs ); + my $self = shift; + my $libs = ref $_[0] ? shift : [ shift ]; + $self->makemaker_args( LIBS => $libs ); } sub inc { - my $self = shift; - $self->makemaker_args( INC => shift ); + my $self = shift; + $self->makemaker_args( INC => shift ); +} + +my %test_dir = (); + +sub _wanted_t { + /\.t$/ and -f $_ and $test_dir{$File::Find::dir} = 1; +} + +sub tests_recursive { + my $self = shift; + if ( $self->tests ) { + die "tests_recursive will not work if tests are already defined"; + } + my $dir = shift || 't'; + unless ( -d $dir ) { + die "tests_recursive dir '$dir' does not exist"; + } + require File::Find; + %test_dir = (); + File::Find::find( \&_wanted_t, $dir ); + $self->tests( join ' ', map { "$_/*.t" } sort keys %test_dir ); } sub write { - my $self = shift; - die "&Makefile->write() takes no arguments\n" if @_; - - my $args = $self->makemaker_args; - $args->{DISTNAME} = $self->name; - $args->{NAME} = $self->module_name || $self->name || $self->determine_NAME($args); - $args->{VERSION} = $self->version || $self->determine_VERSION($args); - $args->{NAME} =~ s/-/::/g; - if ( $self->tests ) { - $args->{test} = { TESTS => $self->tests }; - } - if ($] >= 5.005) { - $args->{ABSTRACT} = $self->abstract; - $args->{AUTHOR} = $self->author; - } - if ( eval($ExtUtils::MakeMaker::VERSION) >= 6.10 ) { - $args->{NO_META} = 1; - } - if ( eval($ExtUtils::MakeMaker::VERSION) > 6.17 and $self->sign ) { - $args->{SIGN} = 1; - } - unless ( $self->is_admin ) { - delete $args->{SIGN}; - } - - # merge both kinds of requires into prereq_pm - my $prereq = ($args->{PREREQ_PM} ||= {}); - %$prereq = ( %$prereq, map { @$_ } map { @$_ } grep $_, - ($self->build_requires, $self->requires) ); - - # merge both kinds of requires into prereq_pm - my $subdirs = ($args->{DIR} ||= []); - if ($self->bundles) { - foreach my $bundle (@{ $self->bundles }) { - my ($file, $dir) = @$bundle; - push @$subdirs, $dir if -d $dir; - delete $prereq->{$file}; - } - } - - if ( my $perl_version = $self->perl_version ) { - eval "use $perl_version; 1" - or die "ERROR: perl: Version $] is installed, " - . "but we need version >= $perl_version"; - } - - $args->{INSTALLDIRS} = $self->installdirs; - - my %args = map { ( $_ => $args->{$_} ) } grep {defined($args->{$_})} keys %$args; - - my $user_preop = delete $args{dist}->{PREOP}; - if (my $preop = $self->admin->preop($user_preop)) { - $args{dist} = $preop; - } - - my $mm = ExtUtils::MakeMaker::WriteMakefile(%args); - $self->fix_up_makefile($mm->{FIRST_MAKEFILE} || 'Makefile'); + my $self = shift; + die "&Makefile->write() takes no arguments\n" if @_; + + my $args = $self->makemaker_args; + $args->{DISTNAME} = $self->name; + $args->{NAME} = $self->module_name || $self->name || $self->determine_NAME($args); + $args->{VERSION} = $self->version || $self->determine_VERSION($args); + $args->{NAME} =~ s/-/::/g; + if ( $self->tests ) { + $args->{test} = { TESTS => $self->tests }; + } + if ($] >= 5.005) { + $args->{ABSTRACT} = $self->abstract; + $args->{AUTHOR} = $self->author; + } + if ( eval($ExtUtils::MakeMaker::VERSION) >= 6.10 ) { + $args->{NO_META} = 1; + } + if ( eval($ExtUtils::MakeMaker::VERSION) > 6.17 and $self->sign ) { + $args->{SIGN} = 1; + } + unless ( $self->is_admin ) { + delete $args->{SIGN}; + } + + # merge both kinds of requires into prereq_pm + my $prereq = ($args->{PREREQ_PM} ||= {}); + %$prereq = ( %$prereq, + map { @$_ } + map { @$_ } + grep $_, + ($self->build_requires, $self->requires) + ); + + # merge both kinds of requires into prereq_pm + my $subdirs = ($args->{DIR} ||= []); + if ($self->bundles) { + foreach my $bundle (@{ $self->bundles }) { + my ($file, $dir) = @$bundle; + push @$subdirs, $dir if -d $dir; + delete $prereq->{$file}; + } + } + + if ( my $perl_version = $self->perl_version ) { + eval "use $perl_version; 1" + or die "ERROR: perl: Version $] is installed, " + . "but we need version >= $perl_version"; + } + + $args->{INSTALLDIRS} = $self->installdirs; + + my %args = map { ( $_ => $args->{$_} ) } grep {defined($args->{$_})} keys %$args; + + my $user_preop = delete $args{dist}->{PREOP}; + if (my $preop = $self->admin->preop($user_preop)) { + $args{dist} = $preop; + } + + my $mm = ExtUtils::MakeMaker::WriteMakefile(%args); + $self->fix_up_makefile($mm->{FIRST_MAKEFILE} || 'Makefile'); } sub fix_up_makefile { - my $self = shift; - my $makefile_name = shift; - my $top_class = ref($self->_top) || ''; - my $top_version = $self->_top->VERSION || ''; - - my $preamble = $self->preamble - ? "# Preamble by $top_class $top_version\n" - . $self->preamble - : ''; - my $postamble = "# Postamble by $top_class $top_version\n" - . ($self->postamble || ''); - - local *MAKEFILE; - open MAKEFILE, "< $makefile_name" or die "fix_up_makefile: Couldn't open $makefile_name: $!"; - my $makefile = do { local $/; }; - close MAKEFILE or die $!; - - $makefile =~ s/\b(test_harness\(\$\(TEST_VERBOSE\), )/$1'inc', /; - $makefile =~ s/( -I\$\(INST_ARCHLIB\))/ -Iinc$1/g; - $makefile =~ s/( "-I\$\(INST_LIB\)")/ "-Iinc"$1/g; - $makefile =~ s/^(FULLPERL = .*)/$1 "-Iinc"/m; - $makefile =~ s/^(PERL = .*)/$1 "-Iinc"/m; - - # Module::Install will never be used to build the Core Perl - # Sometimes PERL_LIB and PERL_ARCHLIB get written anyway, which breaks - # PREFIX/PERL5LIB, and thus, install_share. Blank them if they exist - $makefile =~ s/^PERL_LIB = .+/PERL_LIB =/m; - #$makefile =~ s/^PERL_ARCHLIB = .+/PERL_ARCHLIB =/m; - - # Perl 5.005 mentions PERL_LIB explicitly, so we have to remove that as well. - $makefile =~ s/("?)-I\$\(PERL_LIB\)\1//g; - - # XXX - This is currently unused; not sure if it breaks other MM-users - # $makefile =~ s/^pm_to_blib\s+:\s+/pm_to_blib :: /mg; - - open MAKEFILE, "> $makefile_name" or die "fix_up_makefile: Couldn't open $makefile_name: $!"; - print MAKEFILE "$preamble$makefile$postamble" or die $!; - close MAKEFILE or die $!; - - 1; + my $self = shift; + my $makefile_name = shift; + my $top_class = ref($self->_top) || ''; + my $top_version = $self->_top->VERSION || ''; + + my $preamble = $self->preamble + ? "# Preamble by $top_class $top_version\n" + . $self->preamble + : ''; + my $postamble = "# Postamble by $top_class $top_version\n" + . ($self->postamble || ''); + + local *MAKEFILE; + open MAKEFILE, "< $makefile_name" or die "fix_up_makefile: Couldn't open $makefile_name: $!"; + my $makefile = do { local $/; }; + close MAKEFILE or die $!; + + $makefile =~ s/\b(test_harness\(\$\(TEST_VERBOSE\), )/$1'inc', /; + $makefile =~ s/( -I\$\(INST_ARCHLIB\))/ -Iinc$1/g; + $makefile =~ s/( "-I\$\(INST_LIB\)")/ "-Iinc"$1/g; + $makefile =~ s/^(FULLPERL = .*)/$1 "-Iinc"/m; + $makefile =~ s/^(PERL = .*)/$1 "-Iinc"/m; + + # Module::Install will never be used to build the Core Perl + # Sometimes PERL_LIB and PERL_ARCHLIB get written anyway, which breaks + # PREFIX/PERL5LIB, and thus, install_share. Blank them if they exist + $makefile =~ s/^PERL_LIB = .+/PERL_LIB =/m; + #$makefile =~ s/^PERL_ARCHLIB = .+/PERL_ARCHLIB =/m; + + # Perl 5.005 mentions PERL_LIB explicitly, so we have to remove that as well. + $makefile =~ s/("?)-I\$\(PERL_LIB\)\1//g; + + # XXX - This is currently unused; not sure if it breaks other MM-users + # $makefile =~ s/^pm_to_blib\s+:\s+/pm_to_blib :: /mg; + + open MAKEFILE, "> $makefile_name" or die "fix_up_makefile: Couldn't open $makefile_name: $!"; + print MAKEFILE "$preamble$makefile$postamble" or die $!; + close MAKEFILE or die $!; + + 1; } sub preamble { - my ($self, $text) = @_; - $self->{preamble} = $text . $self->{preamble} if defined $text; - $self->{preamble}; + my ($self, $text) = @_; + $self->{preamble} = $text . $self->{preamble} if defined $text; + $self->{preamble}; } sub postamble { - my ($self, $text) = @_; - $self->{postamble} ||= $self->admin->postamble; - $self->{postamble} .= $text if defined $text; - $self->{postamble} + my ($self, $text) = @_; + $self->{postamble} ||= $self->admin->postamble; + $self->{postamble} .= $text if defined $text; + $self->{postamble} } 1; __END__ -#line 338 +#line 363 diff --git a/inc/Module/Install/Metadata.pm b/inc/Module/Install/Metadata.pm index b5658c9..b886046 100644 --- a/inc/Module/Install/Metadata.pm +++ b/inc/Module/Install/Metadata.pm @@ -6,7 +6,7 @@ use Module::Install::Base; use vars qw{$VERSION $ISCORE @ISA}; BEGIN { - $VERSION = '0.65'; + $VERSION = '0.67'; $ISCORE = 1; @ISA = qw{Module::Install::Base}; } @@ -56,14 +56,23 @@ foreach my $key (@tuple_keys) { }; } -sub install_as_core { $_[0]->installdirs('perl') } -sub install_as_cpan { $_[0]->installdirs('site') } -sub install_as_site { $_[0]->installdirs('site') } -sub install_as_vendor { $_[0]->installdirs('vendor') } +# configure_requires is currently a null-op +sub configure_requires { 1 } + +# Aliases for build_requires that will have alternative +# meanings in some future version of META.yml. +sub test_requires { shift->build_requires(@_) } +sub install_requires { shift->build_requires(@_) } + +# Aliases for installdirs options +sub install_as_core { $_[0]->installdirs('perl') } +sub install_as_cpan { $_[0]->installdirs('site') } +sub install_as_site { $_[0]->installdirs('site') } +sub install_as_vendor { $_[0]->installdirs('vendor') } sub sign { my $self = shift; - return $self->{'values'}{'sign'} if defined wantarray and !@_; + return $self->{'values'}{'sign'} if defined wantarray and ! @_; $self->{'values'}{'sign'} = ( @_ ? $_[0] : 1 ); return $self; } @@ -296,20 +305,24 @@ sub license_from { { my $license_text = $1; my @phrases = ( - 'under the same (?:terms|license) as perl itself' => 'perl', - 'GNU public license' => 'gpl', - 'GNU lesser public license' => 'gpl', - 'BSD license' => 'bsd', - 'Artistic license' => 'artistic', - 'GPL' => 'gpl', - 'LGPL' => 'lgpl', - 'BSD' => 'bsd', - 'Artistic' => 'artistic', - 'MIT' => 'MIT', + 'under the same (?:terms|license) as perl itself' => 'perl', 1, + 'GNU public license' => 'gpl', 1, + 'GNU lesser public license' => 'gpl', 1, + 'BSD license' => 'bsd', 1, + 'Artistic license' => 'artistic', 1, + 'GPL' => 'gpl', 1, + 'LGPL' => 'lgpl', 1, + 'BSD' => 'bsd', 1, + 'Artistic' => 'artistic', 1, + 'MIT' => 'mit', 1, + 'proprietary' => 'proprietary', 0, ); - while ( my ( $pattern, $license ) = splice( @phrases, 0, 2 ) ) { + while ( my ($pattern, $license, $osi) = splice(@phrases, 0, 3) ) { $pattern =~ s{\s+}{\\s+}g; if ( $license_text =~ /\b$pattern\b/i ) { + if ( $osi and $license_text =~ /All rights reserved/i ) { + warn "LEGAL WARNING: 'All rights reserved' may invalidate Open Source licenses. Consider removing it."; + } $self->license($license); return 1; } diff --git a/inc/Module/Install/Win32.pm b/inc/Module/Install/Win32.pm index 42cb653..612dc30 100644 --- a/inc/Module/Install/Win32.pm +++ b/inc/Module/Install/Win32.pm @@ -6,7 +6,7 @@ use Module::Install::Base; use vars qw{$VERSION $ISCORE @ISA}; BEGIN { - $VERSION = '0.65'; + $VERSION = '0.67'; $ISCORE = 1; @ISA = qw{Module::Install::Base}; } diff --git a/inc/Module/Install/WriteAll.pm b/inc/Module/Install/WriteAll.pm index d0908fb..e1db381 100644 --- a/inc/Module/Install/WriteAll.pm +++ b/inc/Module/Install/WriteAll.pm @@ -6,7 +6,7 @@ use Module::Install::Base; use vars qw{$VERSION $ISCORE @ISA}; BEGIN { - $VERSION = '0.65'; + $VERSION = '0.67'; $ISCORE = 1; @ISA = qw{Module::Install::Base}; } diff --git a/lib/DBIx/Class/InflateColumn/IP.pm b/lib/DBIx/Class/InflateColumn/IP.pm index ea7ed81..ba4a3d5 100644 --- a/lib/DBIx/Class/InflateColumn/IP.pm +++ b/lib/DBIx/Class/InflateColumn/IP.pm @@ -3,7 +3,7 @@ package DBIx::Class::InflateColumn::IP; use warnings; use strict; -our $VERSION = '0.02000'; +our $VERSION = '0.02001'; use base qw/DBIx::Class/; __PACKAGE__->mk_classdata(ip_format => 'addr'); @@ -46,6 +46,11 @@ Then you can treat the specified column as a NetAddr::IP object. print 'IP address: ', $host->ip_address->addr; print 'Address type: ', $host->ip_address->iptype; +DBIx::Class::InflateColumn::IP supports a limited amount of +auto-detection of the format based on the column type. If the type +begins with C, it's assumed to be numeric, while C and +C (as used by e.g. PostgreSQL) are assumed to be C format. + =head1 METHODS =head2 ip_class @@ -86,8 +91,9 @@ sub register_column { return unless defined $info->{'is_ip'}; - my $ip_format = $info->{ip_format} || $self->ip_format || 'addr'; - my $ip_class = $info->{ip_class} || $self->ip_class || 'NetAddr::IPf'; + my $ip_format = $info->{ip_format} || _default_format($info->{data_type}) + || $self->ip_format || 'addr'; + my $ip_class = $info->{ip_class} || $self->ip_class || 'NetAddr::IP'; eval "use $ip_class"; $self->throw_exception("Error loading $ip_class: $@") if $@; @@ -102,9 +108,22 @@ sub register_column { ); } +my @format_map = ( + { type => qr/^int/i, format => 'numeric' }, + { type => qr{^(?:inet|cidr)$}i, format => 'cidr' }, +); + +sub _default_format { + my ($type) = @_; + + for my $match (@format_map) { + return $match->{format} if $type =~ $match->{type}; + } +} + =head1 AUTHOR -Dagfinn Ilmari MannsÃ¥ker, C<< >> +Dagfinn Ilmari Mannsåker, C<< >> =head1 BUGS @@ -148,7 +167,7 @@ L, L =head1 COPYRIGHT & LICENSE -Copyright 2007 Dagfinn Ilmari MannsÃ¥ker, all rights reserved. +Copyright 2007 Dagfinn Ilmari Mannsåker, all rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. diff --git a/t/lib/DBICTest.pm b/t/lib/DBICTest.pm index e642504..0bbabbd 100644 --- a/t/lib/DBICTest.pm +++ b/t/lib/DBICTest.pm @@ -55,7 +55,8 @@ sub init_schema { my $dbuser = $ENV{"DBICTEST_DBUSER"} || ''; my $dbpass = $ENV{"DBICTEST_DBPASS"} || ''; - my $schema = DBICTest::Schema->compose_connection('DBICTest' => $dsn, $dbuser, $dbpass); + my $schema = DBICTest::Schema->compose_namespace('DBICTest') + ->connect($dsn, $dbuser, $dbpass); $schema->storage->on_connect_do(['PRAGMA synchronous = OFF']); if ( !$args{no_deploy} ) { __PACKAGE__->deploy_schema( $schema ); diff --git a/t/lib/DBICTest/Schema/Host.pm b/t/lib/DBICTest/Schema/Host.pm index 317f13d..5f1d99f 100644 --- a/t/lib/DBICTest/Schema/Host.pm +++ b/t/lib/DBICTest/Schema/Host.pm @@ -15,7 +15,6 @@ __PACKAGE__->add_columns( data_type => 'integer', is_nullable => 0, is_ip => 1, - ip_format => 'numeric', } );