lib/DBIx/Class/InflateColumn/IP.pm

   1 package DBIx::Class::InflateColumn::IP;
   2
   3 use warnings;
   4 use strict;
   5
   6 our $VERSION = '0.02001';
   7
   8 use base qw/DBIx::Class/;
   9 __PACKAGE__->mk_classdata(ip_format => 'addr');
  10 __PACKAGE__->mk_classdata(ip_class  => 'NetAddr::IP');
  11
  12 =head1 NAME
  13
  14 DBIx::Class::InflateColumn::IP - Auto-create NetAddr::IP objects from columns.
  15
  16 =head1 SYNOPSIS
  17
  18 Load this component and declare columns as IP addresses with the
  19 appropriate format.
  20
  21     package Host;
  22     __PACKAGE__->load_components(qw/InflateColumn::IP Core/);
  23     __PACKAGE__->add_columns(
  24         ip_address => {
  25             data_type => 'bigint',
  26             is_nullable => 0,
  27             is_ip => 1,
  28             ip_format => 'numeric',
  29         }
  30     );
  31
  32     package Network;
  33     __PACKAGE__->load_components(qw/InflateColumn::IP Core/);
  34     __PACKAGE__->add_columns(
  35         address => {
  36             data_type => 'varchar',
  37             size        => 18
  38             is_nullable => 0,
  39             is_ip => 1,
  40             ip_format => 'cidr',
  41         }
  42     );
  43
  44 Then you can treat the specified column as a NetAddr::IP object.
  45
  46     print 'IP address: ', $host->ip_address->addr;
  47     print 'Address type: ', $host->ip_address->iptype;
  48
  49 DBIx::Class::InflateColumn::IP supports a limited amount of
  50 auto-detection of the format based on the column type. If the type
  51 begins with C<int> or C<bigint>, it's assumed to be numeric, while
  52 C<inet> and C<cidr> (as used by e.g. PostgreSQL) are assumed to be
  53 C<cidr> format.
  54
  55 =head1 METHODS
  56
  57 =head2 ip_class
  58
  59 =over
  60
  61 =item Arguments: $class
  62
  63 =back
  64
  65 Gets/sets the address class that the columns should be inflated into.
  66 The default class is NetAddr::IP.
  67
  68 =head2 ip_format
  69
  70 =over
  71
  72 =item Arguments: $format
  73
  74 =back
  75
  76 Gets/sets the name of the method used to deflate the address for the
  77 database. This must return a value suitable for C<$ip_class->new(); The
  78 default format is C<addr>, which returns the address in dotted-quad
  79 notation. See L<NetAddr::IP/Methods> for suitable values.
  80
  81 =head2 register_column
  82
  83 Chains with L<DBIx::Class::Row/register_column>, and sets up IP address
  84 columns appropriately. This would not normally be called directly by end
  85 users.
  86
  87 =cut
  88
  89 sub register_column {
  90     my ($self, $column, $info, @rest) = @_;
  91     $self->next::method($column, $info, @rest);
  92
  93     return unless defined $info->{'is_ip'};
  94
  95     my $ip_format = $info->{ip_format} || _default_format($info->{data_type})
  96         || $self->ip_format || 'addr';
  97     my $ip_class = $info->{ip_class} || $self->ip_class || 'NetAddr::IP';
  98
  99     eval "use $ip_class";
 100     $self->throw_exception("Error loading $ip_class: $@") if $@;
 101     $self->throw_exception("Format '$ip_format' not supported by $ip_class")
 102         unless $ip_class->can($ip_format);
 103
 104     $self->inflate_column(
 105         $column => {
 106             inflate => sub { return $ip_class->new(shift); },
 107             deflate => sub { return scalar shift->$ip_format; },
 108         }
 109     );
 110 }
 111
 112 my @format_map = (
 113   { type => qr/^(?:big)?int/i, format => 'numeric' },
 114   { type => qr{^(?:inet|cidr)$}i, format => 'cidr' },
 115 );
 116
 117 sub _default_format {
 118     my ($type) = @_;
 119
 120     for my $match (@format_map) {
 121         return $match->{format} if $type =~ $match->{type};
 122     }
 123 }
 124
 125 =head1 AUTHOR
 126
 127 Dagfinn Ilmari Mannsåker, C<< <ilmari at ilmari.org> >>
 128
 129 =head1 BUGS
 130
 131 Please report any bugs or feature requests to
 132 C<bug-dbix-class-inflatecolumn-ip at rt.cpan.org>, or through the web interface at
 133 L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=DBIx-Class-InflateColumn-IP>.
 134 I will be notified, and then you'll automatically be notified of progress on
 135 your bug as I make changes.
 136
 137 =head1 SUPPORT
 138
 139 You can find documentation for this module with the perldoc command.
 140
 141     perldoc DBIx::Class::InflateColumn::IP
 142
 143 You can also look for information at:
 144
 145 =over 4
 146
 147 =item * AnnoCPAN: Annotated CPAN documentation
 148
 149 L<http://annocpan.org/dist/DBIx-Class-InflateColumn-IP>
 150
 151 =item * CPAN Ratings
 152
 153 L<http://cpanratings.perl.org/d/DBIx-Class-InflateColumn-IP>
 154
 155 =item * RT: CPAN's request tracker
 156
 157 L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=DBIx-Class-InflateColumn-IP>
 158
 159 =item * Search CPAN
 160
 161 L<http://search.cpan.org/dist/DBIx-Class-InflateColumn-IP>
 162
 163 =back
 164
 165 =head1 SEE ALSO
 166
 167 L<DBIx::Class>, L<NetAddr::IP>
 168
 169 =head1 COPYRIGHT & LICENSE
 170
 171 Copyright 2007 Dagfinn Ilmari Mannsåker, all rights reserved.
 172
 173 This program is free software; you can redistribute it and/or modify it
 174 under the same terms as Perl itself.
 175
 176 =cut
 177
 178 1; # End of DBIx::Class::InflateColumn::IP