lib/DBIx/Class/InflateColumn/IP.pm

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