FS/FS/SearchCache.pm

   1 package FS::SearchCache;
   2
   3 use strict;
   4 use vars qw($DEBUG);
   5 #use Carp qw(carp cluck croak confess);
   6
   7 $DEBUG = 0;
   8
   9 =head1 NAME
  10
  11 FS::SearchCache - cache
  12
  13 =head1 SYNOPSIS
  14
  15 =head1 DESCRIPTION
  16
  17 =head1 METHODS
  18
  19 =over 4
  20
  21 =item new
  22
  23 =cut
  24
  25 sub new {
  26   my $proto = shift;
  27   my $class = ref($proto) || $proto;
  28   my( $table, $key ) = @_;
  29   warn "table $table\n" if $DEBUG > 1;
  30   warn "key $key\n" if $DEBUG > 1;
  31   my $self = { 'table' => $table,
  32                'key'   => $key,
  33                'cache' => {},
  34                'subcache' => {},
  35              };
  36   bless ($self, $class);
  37
  38   $self;
  39 }
  40
  41 =item table
  42
  43 =cut
  44
  45 sub table { my $self = shift; $self->{table}; }
  46
  47 =item key
  48
  49 =cut
  50
  51 sub key { my $self = shift; $self->{key}; }
  52
  53 =item cache
  54
  55 =cut
  56
  57 sub cache { my $self = shift; $self->{cache}; }
  58
  59 =item subcache
  60
  61 =cut
  62
  63 sub subcache {
  64   my $self = shift;
  65   my $col = shift;
  66   my $table = shift;
  67   my $keyval = shift;
  68   if ( exists $self->{subcache}->{$col}->{$keyval} ) {
  69     warn "returning existing subcache for $keyval ($col)".
  70          "$self->{subcache}->{$col}->{$keyval}\n" if $DEBUG;
  71     return $self->{subcache}->{$col}->{$keyval};
  72   } else {
  73     #my $tablekey = @_ ? shift : $col;
  74     my $tablekey = $col;
  75     my $subcache = ref($self)->new( $table, $tablekey );
  76     $self->{subcache}->{$col}->{$keyval} = $subcache;
  77     warn "creating new subcache $table $tablekey: $subcache\n" if $DEBUG;
  78     $subcache;
  79   }
  80 }
  81
  82 =back
  83
  84 =head1 BUGS
  85
  86 Dismal documentation.
  87
  88 =head1 SEE ALSO
  89
  90 L<FS::Record>, L<FS::cust_main>
  91
  92 =cut
  93
  94 1;
  95
  96