package fees and usage-based fees, #27687, #25899
[freeside.git] / FS / FS / svc_IP_Mixin.pm
1 package FS::svc_IP_Mixin;
2
3 use strict;
4 use base 'FS::IP_Mixin';
5 use FS::Record qw(qsearchs qsearch);
6 use NEXT;
7
8 =item addr_block
9
10 Returns the address block assigned to this service.
11
12 =item router
13
14 Returns the router assigned to this service, if there is one.
15
16 =cut
17
18 #addr_block and router methods provided by FS::IP_Mixin
19
20 =item NetAddr
21
22 Returns the address as a L<NetAddr::IP> object.  Use C<$svc->NetAddr->addr>
23 to put it into canonical string form.
24
25 =cut
26
27 sub NetAddr {
28   my $self = shift;
29   NetAddr::IP->new($self->ip_addr);
30 }
31
32 =item ip_addr
33
34 Wrapper for set/get on the IP address field.
35
36 =cut
37
38 sub ip_addr {
39   my $self = shift;
40   my $ip_field = $self->table_info->{'ip_field'}
41     or return '';
42   if ( @_ ) {
43     $self->set($ip_field, @_);
44   } else {
45     $self->get($ip_field);
46   }
47 }
48
49 =item allowed_routers
50
51 Returns a list of L<FS::router> objects allowed on this service.
52
53 =cut
54
55 sub allowed_routers {
56   my $self = shift;
57   my $svcpart = $self->svcnum ? $self->cust_svc->svcpart : $self->svcpart;
58   my @r = map { $_->router } 
59     qsearch('part_svc_router', { svcpart => $svcpart });
60
61   if ( $self->cust_main ) {
62     my $agentnum = $self->cust_main->agentnum;
63     return grep { !$_->agentnum or $_->agentnum == $agentnum } @r;
64   } else {
65     return @r;
66   }
67 }
68
69 =item svc_ip_check
70
71 Wrapper for C<ip_check> which also checks the validity of the router.
72
73 =cut
74
75 sub svc_ip_check {
76   my $self = shift;
77   my $error = $self->ip_check;
78   return $error if $error;
79   if ( my $router = $self->router ) {
80     if ( grep { $_->routernum eq $router->routernum } $self->allowed_routers ) {
81       return '';
82     } else {
83       return 'Router '.$router->routername.' not available for this service';
84     }
85   }
86   '';
87 }
88
89 sub _used_addresses {
90   my ($class, $block, $exclude) = @_;
91   my $ip_field = $class->table_info->{'ip_field'}
92     or return ();
93   # if the service doesn't have an ip_field, then it has no IP addresses 
94   # in use, yes? 
95
96   my %hash = ( $ip_field => { op => '!=', value => '' } );
97   #$hash{'blocknum'} = $block->blocknum if $block;
98   $hash{'svcnum'} = { op => '!=', value => $exclude->svcnum } if ref $exclude;
99   map { $_->NetAddr->addr } qsearch($class->table, \%hash);
100 }
101
102 sub _is_used {
103   my ($class, $addr, $exclude) = @_;
104   my $ip_field = $class->table_info->{'ip_field'}
105     or return '';
106
107   my $svc = qsearchs($class->table, { $ip_field => $addr })
108     or return '';
109
110   return '' if ( ref $exclude and $exclude->svcnum == $svc->svcnum );
111
112   my $cust_svc = $svc->cust_svc;
113   if ( $cust_svc ) {
114     my @label = $cust_svc->label;
115     # "svc_foo 1234 (Service Desc)"
116     # this should be enough to identify it without leaking customer
117     # names across agents
118     "$label[2] $label[3] ($label[0])";
119   } else {
120     join(' ', $class->table, $svc->svcnum, '(unlinked service)');
121   }
122 }
123
124 =item attached_router
125
126 Returns the L<FS::router> attached via this service (as opposed to the one
127 this service is connected through), that is, a router whose "svcnum" field
128 equals this service's primary key.
129
130 If the 'router_routernum' pseudo-field is set, returns that router instead.
131
132 =cut
133
134 sub attached_router {
135   my $self = shift;
136   if ( length($self->get('router_routernum') )) {
137     return FS::router->by_key($self->router_routernum);
138   } else {
139     qsearchs('router', { 'svcnum' => $self->svcnum });
140   }
141 }
142
143 =item attached_block
144
145 Returns the address block (L<FS::addr_block>) assigned to the attached_router,
146 if there is one.
147
148 If the 'router_blocknum' pseudo-field is set, returns that block instead.
149
150 =cut
151
152 sub attached_block {
153   my $self = shift;
154   if ( length($self->get('router_blocknum')) ) {
155     return FS::addr_block->by_key($self->router_blocknum);
156   } else {
157     my $router = $self->attached_router or return '';
158     my ($block) = $router->addr_block;
159     return $block || '';
160   }
161 }
162
163 =item radius_check
164
165 Returns nothing.
166
167 =cut
168
169 sub radius_check { }
170
171 =item radius_reply
172
173 Returns RADIUS reply items that are relevant across all exports and 
174 necessary for the IP address configuration of the service.  Currently, that
175 means "Framed-Route" if there's an attached router.
176
177 =cut
178
179 sub radius_reply {
180   my $self = shift;
181   my %reply;
182   my ($block) = $self->attached_block;
183   if ( $block ) {
184     # block routed over dynamic IP: "192.168.100.0/29 0.0.0.0 1"
185     # or
186     # block routed over fixed IP: "192.168.100.0/29 192.168.100.1 1"
187     # (the "1" at the end is the route metric)
188     $reply{'Framed-Route'} =
189     $block->cidr . ' ' .
190     ($self->ip_addr || '0.0.0.0') . ' 1';
191   }
192   %reply;
193 }
194
195 sub replace_check {
196   my ($new, $old) = @_;
197   # this modifies $old, not $new, which is a slight abuse of replace_check,
198   # but there's no way to ensure that replace_old gets called...
199   #
200   # ensure that router_routernum and router_blocknum are set to their
201   # current values, so that exports remember the service's attached router 
202   # and block even after they've been replaced
203   my $router = $old->attached_router;
204   my $block = $old->attached_block;
205   $old->set('router_routernum', $router ? $router->routernum : 0);
206   $old->set('router_blocknum', $block ? $block->blocknum : 0);
207   my $err_or_ref = $new->NEXT::replace_check($old) || '';
208   # because NEXT::replace_check($old) ends up trying to AUTOLOAD replace_check
209   # which is dumb, but easily worked around
210   ref($err_or_ref) ? '' : $err_or_ref;
211 }
212
213 1;