FS/FS/detail_format.pm

   1 package FS::detail_format;
   2
   3 use strict;
   4 use vars qw( $DEBUG );
   5 use FS::Conf;
   6 use FS::cdr;
   7 use FS::cust_bill_pkg_detail;
   8 use Date::Format qw(time2str);
   9 use Text::CSV_XS;
  10
  11 my $me = '[FS::detail_format]';
  12
  13 =head1 NAME
  14
  15 FS::detail_format - invoice detail formatter
  16
  17 =head1 DESCRIPTION
  18
  19 An FS::detail_format object is a converter to create invoice details
  20 (L<FS::cust_bill_pkg_detail>) from call detail records (L<FS::cdr>)
  21 or other usage information.  FS::detail_format inherits from nothing.
  22
  23 Subclasses of FS::detail_format represent specific detail formats.
  24
  25 =head1 CLASS METHODS
  26
  27 =over 4
  28
  29 =item new FORMAT, OPTIONS
  30
  31 Returns a new detail formatter.  The FORMAT argument is the name of
  32 a subclass.
  33
  34 OPTIONS may contain:
  35
  36 - buffer: an arrayref to store details into.  This may avoid the need for
  37   a large copy operation at the end of processing.  However, since
  38   summary formats will produce nothing until the end of processing,
  39   C<finish> must be called after all CDRs have been appended.
  40
  41 - inbound: a flag telling the formatter to format CDRs for display to
  42   the receiving party, rather than the originator.  In this case, the
  43   L<FS::cdr_termination> object will be fetched and its values used for
  44   rated_price, rated_seconds, rated_minutes, and svcnum.  This can be
  45   changed with the C<inbound> method.
  46
  47 =cut
  48
  49 sub new {
  50   my $class = shift;
  51   if ( $class eq 'FS::detail_format' ) {
  52     my $format = shift
  53       or die "$me format name required";
  54     $class = "FS::detail_format::$format"
  55       unless $format =~ /^FS::detail_format::/;
  56   }
  57   eval "use $class";
  58   die "$me error loading $class: $@" if $@;
  59   my %opt = @_;
  60
  61   my $self = { conf => FS::Conf->new,
  62                csv  => Text::CSV_XS->new,
  63                inbound  => ($opt{'inbound'} ? 1 : 0),
  64                buffer   => ($opt{'buffer'} || []),
  65              };
  66   bless $self, $class;
  67 }
  68
  69 =back
  70
  71 =head1 METHODS
  72
  73 =item inbound VALUE
  74
  75 Set/get the 'inbound' flag.
  76
  77 =cut
  78
  79 sub inbound {
  80   my $self = shift;
  81   $self->{inbound} = ($_[0] > 0) if (@_);
  82   $self->{inbound};
  83 }
  84
  85 =item append CDRS
  86
  87 Takes any number of call detail records (as L<FS::cdr> objects),
  88 formats them, and appends them to the internal buffer.
  89
  90 By default, this simply calls C<single_detail> on each CDR in the
  91 set.  Subclasses should override C<append> and maybe C<finish> if
  92 they do not produce detail lines from CDRs in a 1:1 fashion.
  93
  94 The 'billpkgnum', 'invnum', 'pkgnum', and 'phonenum' fields will
  95 be set later.
  96
  97 =cut
  98
  99 sub append {
 100   my $self = shift;
 101   foreach (@_) {
 102     push @{ $self->{buffer} }, $self->single_detail($_);
 103   }
 104 }
 105
 106 =item details
 107
 108 Returns all invoice detail records in the buffer.  This will perform
 109 a C<finish> first.  Subclasses generally shouldn't override this.
 110
 111 =cut
 112
 113 sub details {
 114   my $self = shift;
 115   $self->finish;
 116   @{ $self->{buffer} }
 117 }
 118
 119 =item finish
 120
 121 Ensures that all invoice details are generated given the CDRs that
 122 have been appended.  By default, this does nothing.
 123
 124 =cut
 125
 126 sub finish {}
 127
 128 =item header
 129
 130 Returns a header row for the format, as an L<FS::cust_bill_pkg_detail>
 131 object.  By default this has 'format' = 'C', 'detail' = the value
 132 returned by C<header_detail>, and all other fields empty.
 133
 134 This is called after C<finish>, so it can use information from the CDRs.
 135
 136 =cut
 137
 138 sub header {
 139   my $self = shift;
 140
 141   FS::cust_bill_pkg_detail->new(
 142     { 'format' => 'C', 'detail' => $self->header_detail }
 143   )
 144 }
 145
 146 =item single_detail CDR
 147
 148 Takes a single CDR and returns an invoice detail to describe it.
 149
 150 By default, this maps the following fields from the CDR:
 151
 152 rated_price       => amount
 153 rated_classnum    => classnum
 154 rated_seconds     => duration
 155 rated_regionname  => regionname
 156 accountcode       => accountcode
 157 startdate         => startdate
 158
 159 It then calls C<columns> on the CDR to obtain a list of detail
 160 columns, formats them as a CSV string, and stores that in the
 161 'detail' field.
 162
 163 =cut
 164
 165 sub single_detail {
 166   my $self = shift;
 167   my $cdr = shift;
 168
 169   my @columns = $self->columns($cdr);
 170   my $status = $self->csv->combine(@columns);
 171   die "$me error combining ".$self->csv->error_input."\n"
 172     if !$status;
 173
 174   my $rated_price = $cdr->rated_price;
 175   $rated_price = 0 if $cdr->freesidestatus eq 'no-charge';
 176
 177   FS::cust_bill_pkg_detail->new( {
 178       'amount'      => $rated_price,
 179       'classnum'    => $cdr->rated_classnum,
 180       'duration'    => $cdr->rated_seconds,
 181       'regionname'  => $cdr->rated_regionname,
 182       'accountcode' => $cdr->accountcode,
 183       'startdate'   => $cdr->startdate,
 184       'format'      => 'C',
 185       'detail'      => $self->csv->string,
 186   });
 187 }
 188
 189 =item columns CDR
 190
 191 Returns a list of CSV columns (to be shown on the invoice) for
 192 the CDR.  This is the method most subclasses should override.
 193
 194 =cut
 195
 196 sub columns {
 197   my $self = shift;
 198   die "$me no columns method in ".ref($self);
 199 }
 200
 201 =item header_detail
 202
 203 Returns the 'detail' field for the header row.  This should
 204 probably be a CSV string of column headers for the values returned
 205 by C<columns>.
 206
 207 =cut
 208
 209 sub header_detail {
 210   my $self = shift;
 211   die "$me no header_detail method in ".ref($self);
 212 }
 213
 214 # convenience methods for subclasses
 215
 216 sub conf { $_[0]->{conf} }
 217
 218 sub csv { $_[0]->{csv} }
 219
 220 sub date_format {
 221   my $self = shift;
 222   $self->{date_format} ||= ($self->conf->config('date_format') || '%m/%d/%Y');
 223 }
 224
 225 sub money_char {
 226   my $self = shift;
 227   $self->{money_char} ||= ($self->conf->config('money_char') || '$');
 228 }
 229
 230 #imitate previous behavior for now
 231
 232 sub duration {
 233   my $self = shift;
 234   my $cdr = shift;
 235   my $object = $self->{inbound} ? $cdr->cdr_termination(1) : $cdr;
 236   my $sec = $object->rated_seconds if $object;
 237   # XXX termination objects don't have rated_granularity so this may
 238   # result in inbound CDRs being displayed as min/sec when they shouldn't.
 239   # Should probably fix this.
 240   if ( $cdr->rated_granularity eq '0' ) {
 241     '1 call';
 242   }
 243   elsif ( $cdr->rated_granularity eq '60' ) {
 244     sprintf('%dm', ($sec + 59)/60);
 245   }
 246   else {
 247     sprintf('%dm %ds', $sec / 60, $sec % 60);
 248   }
 249 }
 250
 251 sub price {
 252   my $self = shift;
 253   my $cdr = shift;
 254   my $object = $self->{inbound} ? $cdr->cdr_termination(1) : $cdr;
 255   my $price = $object->rated_price if $object;
 256   $price = '0.00' if $object->freesidestatus eq 'no-charge';
 257   length($price) ? $self->money_char . $price : '';
 258 }
 259
 260 1;