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 = ();
  37 our %pkgpart = ();
  38 our %part_pkg = ();
  39
  40 #some false laziness w/freeside-cdrrewrited
  41
  42 while (1) {
  43
  44   my $found = 0;
  45   foreach my $cdr (
  46     qsearch( {
  47       'table'     => 'cdr',
  48       'hashref'   => { 'freesidestatus' => '' },
  49       'extra_sql' => $extra_sql.
  50                      ' LIMIT 1024'. #arbitrary, but don't eat too much memory
  51                      ' FOR UPDATE',
  52     } )
  53
  54   ) {
  55
  56     $found = 1;
  57
  58     #find the matching service - some weird false laziness w/svc_phone::get_cdrs
  59
  60     #in charged_party or src
  61     #hmm... edge case; get_cdrs rating will match a src if a charged_party is
  62     # present #but doesn't match a service...
  63     my $number = $cdr->charged_party || $cdr->src;
  64
  65     #technically default_prefix. phonenum or phonenum (or default_prefix without the + . phonenum)
  66     #but for now we're just assuming default_prefix is +1
  67     my $prefix = '+1'; #$options{'default_prefix'};
  68
  69     $number = substr($number, length($prefix))
  70       if $prefix eq substr($number, 0, length($prefix));
  71     if ( $prefix && $prefix =~ /^\+(\d+)$/ ) {
  72       $prefix = $1;
  73       $number = substr($number, length($prefix))
  74         if $prefix eq substr($number, 0, length($prefix));
  75     }
  76
  77     unless ( $svcnum{$number} ) {
  78       #only phone number matching supported right now
  79       my $svc_phone = qsearchs('svc_phone', { 'phonenum' => $number } );
  80       unless ( $svc_phone ) {
  81         #XXX set freesideratestatus or something so we don't keep retrying?
  82         next;
  83       }
  84
  85       $svcnum{$number} = $svc_phone->svcnum;
  86
  87       my $cust_pkg = $svc_phone->cust_svc->cust_pkg;
  88       unless ( $cust_pkg ) {
  89         #XXX unlinked svc_phone?
  90         # warn and also set freesideratestatus or somesuch?
  91         next;
  92       }
  93
  94       #get the package, search through the part_pkg and linked for a voip_cdr def w/matching cdrtypenum (or no use_cdrtypenum)
  95       my @part_pkg =
  96         grep { $_->plan eq 'voip_cdr'
  97                  && ( ! length($_->option_cacheable('use_cdrtypenum'))
  98                       || $_->option_cacheable('use_cdrtypenum')
  99                            eq $cdr->cdrtypenum #eq otherwise 0 matches ''
 100                     )
 101                  && ( ! length($_->option_cacheable('ignore_cdrtypenum'))
 102                       || $_->option_cacheable('ignore_cdrtypenum')
 103                            ne $cdr->cdrtypenum #ne otherwise 0 matches ''
 104                     )
 105
 106              }
 107           $cust_pkg->part_pkg->self_and_bill_linked;
 108
 109       if ( ! @part_pkg ) {
 110         #XXX no package for this CDR
 111         # warn and also set freesideratestatus or somesuch?
 112         #  or at least warn
 113         next;
 114       } elsif ( scalar(@part_pkg) > 1 ) {
 115         warn "multiple package could rate CDR ". $cdr->acctid. "\n";
 116         # and also set freesideratestatus or somesuch?
 117         next;
 118       }
 119
 120       $pkgpart{$number} = $part_pkg[0]->pkgpart;
 121       $part_pkg{ $part_pkg[0]->pkgpart } ||= $part_pkg[0];
 122
 123     }
 124
 125     #unless ( $part_pkg{$pkgpart{$number}} ) {
 126     #}
 127
 128     #XXX if $part_pkg->option('min_included') then we can't prerate this CDR
 129
 130     my $error = $cdr->rate(
 131       'part_pkg' => $part_pkg{ $pkgpart{$number} },
 132       'svcnum'   => $svcnum{ $number },
 133     );
 134     if ( $error ) {
 135       #XXX ???
 136       warn $error;
 137       sleep 30;
 138     }
 139
 140     last if sigterm() || sigint();
 141
 142   }
 143
 144   myexit() if sigterm() || sigint();
 145   sleep 5 unless $found;
 146
 147 }
 148
 149 #--
 150
 151 sub _shouldrun {
 152   $conf->exists('cdr-prerate');
 153 }
 154
 155 sub usage {
 156   die "Usage:\n\n  freeside-cdrrewrited user\n";
 157 }
 158
 159 =head1 NAME
 160
 161 freeside-cdrrated - Real-time daemon for CDR rating
 162
 163 =head1 SYNOPSIS
 164
 165   freeside-cdrrated
 166
 167 =head1 DESCRIPTION
 168
 169 Runs continuously, searches for CDRs and which can be pre-rated, and rates them.
 170
 171 =head1 SEE ALSO
 172
 173 cdr-prerate configuration setting
 174
 175 =cut
 176
 177 1;
 178