| 
      
            Lines 41-74
          use Modern::Perl;
      
      
        Link Here
      
     | 
  
        
          | 41 | 
          use base qw(Class::Accessor);  | 
          41 | 
          use base qw(Class::Accessor);  | 
        
        
          | 42 | 
           | 
          42 | 
           | 
        
        
          | 43 | 
          our %L1_cache;  | 
          43 | 
          our %L1_cache;  | 
        
            
              | 44 | 
               | 
               | 
               | 
            
        
          | 45 | 
          our $singleton_cache;  | 
          44 | 
          our $singleton_cache;  | 
        
            
               | 
               | 
              45 | 
               | 
            
            
              | 46 | 
              =head2 get_instance  | 
            
            
              | 47 | 
               | 
            
            
              | 48 | 
              This gets a shared instance of the lite cache, set up in a very default  | 
            
            
              | 49 | 
              way. The lite cache is an in memory only cache that's automatically flushed  | 
            
            
              | 50 | 
              for every request.  | 
            
            
              | 51 | 
               | 
            
            
              | 52 | 
              =cut  | 
            
            
              | 53 | 
               | 
            
        
          | 46 | 
          sub get_instance { | 
          54 | 
          sub get_instance { | 
        
        
          | 47 | 
              my ($class) = @_;  | 
          55 | 
              my ($class) = @_;  | 
        
        
          | 48 | 
              $singleton_cache = $class->new() unless $singleton_cache;  | 
          56 | 
              $singleton_cache = $class->new() unless $singleton_cache;  | 
        
        
          | 49 | 
              return $singleton_cache;  | 
          57 | 
              return $singleton_cache;  | 
        
        
          | 50 | 
          }  | 
          58 | 
          }  | 
        
        
          | 51 | 
           | 
          59 | 
           | 
        
            
               | 
               | 
              60 | 
              =head2 get_from_cache  | 
            
            
              | 61 | 
               | 
            
            
              | 62 | 
                  my $value = $cache->get_from_cache($key);  | 
            
            
              | 63 | 
               | 
            
            
              | 64 | 
              Retrieve the value stored under the specified key in the cache.  | 
            
            
              | 65 | 
               | 
            
            
              | 66 | 
              The retrieved value is a direct reference so should not be modified.  | 
            
            
              | 67 | 
               | 
            
            
              | 68 | 
              =cut  | 
            
            
              | 69 | 
               | 
            
        
          | 52 | 
          sub get_from_cache { | 
          70 | 
          sub get_from_cache { | 
        
        
          | 53 | 
              my ( $self, $key ) = @_;  | 
          71 | 
              my ( $self, $key ) = @_;  | 
        
        
          | 54 | 
              return $L1_cache{$key}; | 
          72 | 
              return $L1_cache{$key}; | 
        
        
          | 55 | 
          }  | 
          73 | 
          }  | 
        
        
          | 56 | 
           | 
          74 | 
           | 
        
            
               | 
               | 
              75 | 
              =head2 set_in_cache  | 
            
            
              | 76 | 
               | 
            
            
              | 77 | 
                  $cache->set_in_cache($key, $value);  | 
            
            
              | 78 | 
               | 
            
            
              | 79 | 
              Save a value to the specified key in the cache.  | 
            
            
              | 80 | 
               | 
            
            
              | 81 | 
              =cut  | 
            
            
              | 82 | 
               | 
            
        
          | 57 | 
          sub set_in_cache { | 
          83 | 
          sub set_in_cache { | 
        
        
          | 58 | 
              my ( $self, $key, $value ) = @_;  | 
          84 | 
              my ( $self, $key, $value ) = @_;  | 
        
        
          | 59 | 
              $L1_cache{$key} = $value; | 
          85 | 
              $L1_cache{$key} = $value; | 
        
        
          | 60 | 
          }  | 
          86 | 
          }  | 
        
        
          | 61 | 
           | 
          87 | 
           | 
        
            
               | 
               | 
              88 | 
              =head2 clear_from_cache  | 
            
            
              | 89 | 
               | 
            
            
              | 90 | 
                  $cache->clear_from_cache($key);  | 
            
            
              | 91 | 
               | 
            
            
              | 92 | 
              Remove the value identified by the specified key from the lite cache.  | 
            
            
              | 93 | 
               | 
            
            
              | 94 | 
              =cut  | 
            
            
              | 95 | 
               | 
            
        
          | 62 | 
          sub clear_from_cache { | 
          96 | 
          sub clear_from_cache { | 
        
        
          | 63 | 
              my ( $self, $key ) = @_;  | 
          97 | 
              my ( $self, $key ) = @_;  | 
        
        
          | 64 | 
              delete $L1_cache{$key}; | 
          98 | 
              delete $L1_cache{$key}; | 
        
        
          | 65 | 
          }  | 
          99 | 
          }  | 
        
        
          | 66 | 
           | 
          100 | 
           | 
        
            
               | 
               | 
              101 | 
              =head2 all_keys  | 
            
            
              | 102 | 
               | 
            
            
              | 103 | 
                  my @keys = $cache->all_keys();  | 
            
            
              | 104 | 
               | 
            
            
              | 105 | 
              Returns an array of all keys currently in the lite cache.  | 
            
            
              | 106 | 
               | 
            
            
              | 107 | 
              =cut  | 
            
            
              | 108 | 
               | 
            
        
          | 67 | 
          sub all_keys { | 
          109 | 
          sub all_keys { | 
        
        
          | 68 | 
              my ( $self ) = @_;  | 
          110 | 
              my ( $self ) = @_;  | 
        
        
          | 69 | 
              return keys %L1_cache;  | 
          111 | 
              return keys %L1_cache;  | 
        
        
          | 70 | 
          }  | 
          112 | 
          }  | 
        
        
          | 71 | 
           | 
          113 | 
           | 
        
            
               | 
               | 
              114 | 
              =head2 flush  | 
            
            
              | 115 | 
               | 
            
            
              | 116 | 
                  $cache->flush();  | 
            
            
              | 117 | 
               | 
            
            
              | 118 | 
              Clear the entire lite cache.  | 
            
            
              | 119 | 
               | 
            
            
              | 120 | 
              =cut  | 
            
            
              | 121 | 
               | 
            
        
          | 72 | 
          sub flush { | 
          122 | 
          sub flush { | 
        
        
          | 73 | 
              my ( $self ) = @_;  | 
          123 | 
              my ( $self ) = @_;  | 
        
        
          | 74 | 
              %L1_cache = ();  | 
          124 | 
              %L1_cache = ();  | 
        
            
              | 75 | 
              -   | 
               | 
               |