FS/bin/freeside-cdrrated

   1 #!/usr/bin/perl -w
   2
   3 use strict;
   4 use FS::Daemon ':all'; #daemonize1 drop_root daemonize2 myexit logfile sig*
   5 use FS::UID qw( adminsuidsetup );
   6 use FS::Record qw( qsearch qsearchs );
   7 use FS::cdr;
   8 use FS::svc_phone;
   9 use FS::part_pkg;
  10
  11 my $user = shift or die &usage;
  12
  13 daemonize1('freeside-cdrrated');
  14
  15 drop_root();
  16
  17 adminsuidsetup($user);
  18
  19 logfile( "%%%FREESIDE_LOG%%%/cdrrated-log.". $FS::UID::datasrc );
  20
  21 daemonize2();
  22
  23 our $conf = new FS::Conf;
  24
  25 die "not running; cdr-prerate conf option is off\n"
  26   unless _shouldrun();
  27
  28 #--
  29
  30 my $extra_sql = '';
  31 my @cdrtypenums = $conf->config('cdr-prerate-cdrtypenums');
  32 if ( @cdrtypenums ) {
  33   $extra_sql .= ' AND cdrtypenum IN ('. join(',', @cdrtypenums ). ')';
  34 }
  35
  36 our %svcnum = ();   # phonenum => svcnum
  37 our %pkgnum = ();   # phonenum => pkgnum
  38 our %cust_pkg = (); # pkgnum   => cust_pkg (NOT phonenum => cust_pkg!)
  39 our %pkgpart = ();  # phonenum => pkgpart
  40 our %part_pkg = (); # pkgpart  => part_pkg
  41
  42 #some false laziness w/freeside-cdrrewrited
  43
  44 while (1) {
  45
  46   my $found = 0;
  47   foreach my $cdr (
  48     qsearch( {
  49       'table'     => 'cdr',
  50       'hashref'   => { 'freesidestatus' => '' },
  51       'extra_sql' => $extra_sql.
  52                      ' LIMIT 1024'. #arbitrary, but don't eat too much memory
  53                      ' FOR UPDATE',
  54     } )
  55
  56   ) {
  57
  58     $found = 1;
  59
  60     #find the matching service - some weird false laziness w/svc_phone::get_cdrs
  61
  62     #in charged_party or src
  63     #hmm... edge case; get_cdrs rating will match a src if a charged_party is
  64     # present #but doesn't match a service...
  65     my $number = $cdr->charged_party || $cdr->src;
  66
  67     #technically default_prefix. phonenum or phonenum (or default_prefix without the + . phonenum)
  68     #but for now we're just assuming default_prefix is +1
  69     my $prefix = '+1'; #$options{'default_prefix'};
  70
  71     $number = substr($number, length($prefix))
  72       if $prefix eq substr($number, 0, length($prefix));
  73     if ( $prefix && $prefix =~ /^\+(\d+)$/ ) {
  74       $prefix = $1;
  75       $number = substr($number, length($prefix))
  76         if $prefix eq substr($number, 0, length($prefix));
  77     }
  78
  79     unless ( $svcnum{$number} ) {
  80       #only phone number matching supported right now
  81       my $svc_phone = qsearchs('svc_phone', { 'phonenum' => $number } );
  82       unless ( $svc_phone ) {
  83         #XXX set freesideratestatus or something so we don't keep retrying?
  84         next;
  85       }
  86
  87       $svcnum{$number} = $svc_phone->svcnum;
  88
  89       my $cust_pkg = $svc_phone->cust_svc->cust_pkg;
  90       unless ( $cust_pkg ) {
  91         #XXX unlinked svc_phone?
  92         # warn and also set freesideratestatus or somesuch?
  93         next;
  94       }
  95
  96       $pkgnum{$number} = $cust_pkg->pkgnum;
  97       $cust_pkg{$cust_pkg->pkgnum} ||= $cust_pkg;
  98
  99       #get the package, search through the part_pkg and linked for a voip_cdr def w/matching cdrtypenum (or no use_cdrtypenum)
 100       my @part_pkg =
 101         grep { $_->plan eq 'voip_cdr'
 102                  && ( ! length($_->option_cacheable('use_cdrtypenum'))
 103                       || $_->option_cacheable('use_cdrtypenum')
 104                            eq $cdr->cdrtypenum #eq otherwise 0 matches ''
 105                     )
 106                  && ( ! length($_->option_cacheable('ignore_cdrtypenum'))
 107                       || $_->option_cacheable('ignore_cdrtypenum')
 108                            ne $cdr->cdrtypenum #ne otherwise 0 matches ''
 109                     )
 110
 111              }
 112           $cust_pkg->part_pkg->self_and_bill_linked;
 113
 114       if ( ! @part_pkg ) {
 115         #XXX no package for this CDR
 116         # warn and also set freesideratestatus or somesuch?
 117         #  or at least warn
 118         next;
 119       } elsif ( scalar(@part_pkg) > 1 ) {
 120         warn "multiple package could rate CDR ". $cdr->acctid. "\n";
 121         # and also set freesideratestatus or somesuch?
 122         next;
 123       }
 124
 125       $pkgpart{$number} = $part_pkg[0]->pkgpart;
 126       $part_pkg{ $part_pkg[0]->pkgpart } ||= $part_pkg[0];
 127
 128     }
 129
 130     if ( $part_pkg{ $pkgpart{$number} }->option('min_included') ) {
 131       #then we can't prerate this CDR
 132       #some sort of warning?
 133       # (sucks if you're depending on credit limit fraud warnings)
 134       next;
 135     }
 136
 137     my $error = $cdr->rate(
 138       'part_pkg' => $part_pkg{ $pkgpart{$number} },
 139       'cust_pkg' => $cust_pkg{ $pkgnum{$number} },
 140       'svcnum'   => $svcnum{$number},
 141     );
 142     if ( $error ) {
 143       #XXX ???
 144       warn $error;
 145       sleep 30;
 146     } else {
 147
 148       #this could get expensive on a per-call basis
 149       # trigger in a separate process with less frequency?
 150
 151       my $cust_main = $cust_pkg{ $pkgnum{$number} }->cust_main;
 152
 153       my $error = $cust_main->check_credit_limit;
 154       if ( $error ) {
 155         #"should never happen" normally, but as a daemon, better to survive
 156         # e.g. database going away and coming back and resume doing our thing
 157         warn $error;
 158         sleep 30;
 159       }
 160
 161     }
 162
 163     last if sigterm() || sigint();
 164
 165   }
 166
 167   myexit() if sigterm() || sigint();
 168   sleep 5 unless $found;
 169
 170 }
 171
 172 #--
 173
 174 sub _shouldrun {
 175   $conf->exists('cdr-prerate');
 176 }
 177
 178 sub usage {
 179   die "Usage:\n\n  freeside-cdrrewrited user\n";
 180 }
 181
 182 =head1 NAME
 183
 184 freeside-cdrrated - Real-time daemon for CDR rating
 185
 186 =head1 SYNOPSIS
 187
 188   freeside-cdrrated
 189
 190 =head1 DESCRIPTION
 191
 192 Runs continuously, searches for CDRs and which can be pre-rated, and rates them.
 193
 194 =head1 SEE ALSO
 195
 196 cdr-prerate configuration setting
 197
 198 =cut
 199
 200 1;
 201