view release on metacpan or  search on metacpan

lib/Cache/RamDisk/Functions.pm  view on Meta::CPAN

the total rds allocated,

=item *

their common blocksize,

=item *

the cache keys and their limiting values and keys under which the indexes can be accessed on the shared
memory.

=back

They all have to be stored somewhere, hence another shmem segment came out to be the appropriate place.
The value 'ShMem' awaits is the key, under which this segment will be reachable. Please see L<IPC::Shareable.pm3>
for details on what this value is allowed to be.

The existence of this argument may look weird to some people, as the shmem key could easily be calculated
through C<ftok()> from one of the freshly created directories as well.
But implementing it enables your cache to serve more than just one
application at the same time - as long as they all stick to the same cache control segment.

'ShMem' is an optional argument with a default of 'RdLk'. You will always be advised well when you leave
it untouched - unless there is another application running on your server which you can't persuade of
using another key. Because if another key than the default is used, it has to passed to every
C<Cache::RamDisk> constructor. ;)

=head4 INodes

The number of inodes to be reserved for the filesystem on each disk, see L<mke2fs(8)>. This optional
parameter defaults to 1024. Both the number of inodes and that of the available blocks determine how the
disks' capacities will be used by the cache: when you know that most of the objects to be stored will have
a rather small size (around 1k) it can make sense to double the value, as else only about 50% of the
disk spaces may be occupied. But mostly the default should suffice. Please note that as for the current
version it is not intended to let programmers alter the blocksize on the rds. But this may change, and
any comments being able to change my mind about this item will be appreciated.

=head4 Keys

'Keys' is the only mandatory argument, as a cache without a cache key wouldn't make a sense. 'Keys' awaits
a hashref, where the keys are the cache's keys, and the values limitate each individual Cache::RamDisk
instance's behaviour: for a TIMED instance a value means an item's maximum lifetime in seconds, a LRU
instance treats a cache key's value as maximum number of items allowed. Per DEFAULT the cache is ignorant.

=head4 User/ Group

The system user and group allowed to access the cache. Values have to be real names and not numeric ids.
Both arguments are optional and default to 'root'.


=head3 What happened?

   cd /tmp/rd0 && ls -la
   ipcs


=head2 cache_status ( $basename [, $shmemkey] )

   my $s = cache_status('/tmp/rd');
   print $s->key_stat('fie');
   print $s->rd_stat(0)->{bavail};

The monitoring tool for a running cache. Requires the cache's base pathname (-fragment, see cache_install), and
the 'ShMem' key for this cache, if another than the default value 'RdLk' had been chosen.
Always (!) returns a Class::Struct reference with the following accessible members:

   $s->error                  # contains the error message in case something went wrong
   $s->start_disk             # the index of the first rd allocated
   $s->disks                  # the total of allocated disks
   $s->blocksize              # guess what
   $s->keys                   # a key's limit, as set in 'Keys'
   $s->key_stat               # the number of items currently being stored for a key
   $s->rd_stat                # the resulting hashref from a df() call on a rd


=head2 cache_objects ( $basename [, $shmemkey] )

Monitoring tool #2: get lists of all cached objects. (new in 0.1.6) Returns a hashref keyed to object types. For each object
type the value is another hashref, keyed to the rds' numbers and containing arrayrefs with the object ids as values. E.g.:

   { 'User' => { '1' => [ 2, 5, 67, 8999 ],
                 '2' => [ 1, 3, 4, 66 ] 
               },
     'Foo'  => { '1' => [ 'fie', 'fee', 'fum' ],
                 '2' => [ 'blah', 'bar', 'baz' ]
               }
   }              

=head2 cache_remove ( $basename [, $shmemkey] )

Completely clears all devices (by unmounting them) and removes all relevant shared memory segments.
Awaits the same arguments as cache_status. Returns 1 on success, else emits a warning and returns 0.


=head1 NOTES

As both key and internal information are stored on the 'ShMem' segment, they have to be distinguishable
from another: internal keys all begin and end with each a double underscore. From this follows that input
keys matching the pattern C</^__.*__$/> are ignored by C<cache_install>.

The same applies to key names containing any Perl non-word chars (C</\W/>).

=head1 SEE ALSO

L<Cache::RamDisk.pm3>, L<Filesys::Df.pm3>, L<mke2fs(8)>, L<initrd(4)>, L<Class::Struct.pm3>, L<IPC::Shareable.pm3>


=head1 AUTHOR

Martin Haase-Thomas E<lt>thcsoft@snafu.deE<gt>

=head1 HISTORY

B<0.1.6>   (08/04/03) Fixed some samll bugs, added C<cache_objects> method.

B<0.1.5>   Some smaller changes due to my newly achieved respect for initrd's.

B<0.1.4>   Nothing serious. Just beautified the docs a little.

B<0.1.3>   Implemented 'SIndex' as hashref for assigning shmem sizes to the keys directly.

lib/Cache/RamDisk/Functions.pm  view on Meta::CPAN

#                              foreach (keys %cache) { print STDERR "$_=".$cache{$_}."\n";}
   $stie->shunlock;
   undef $stie;
   untie %cache;
   # finally create the shmem segments and prefill them
   for ($i = 0; $i < @keys; $i++) {
      my $baz = "";
      unless (eval { $stie = tie $baz, 'IPC::Shareable', $ftoks[$i], { create => 1, mode => 0666,
                                                                       size => $args->{'SIndex'}->{$keys[$i]}*1024,
                                                                       exclusive => 0, destroy => 0 } } ) {
         warn $@;
         return $ret;
      }
      $stie->shlock;
      $baz = "";
      $stie->shunlock;
      undef $stie;
      untie $baz;
   }

   cache_status ($args->{'Base'}, $args->{'ShMem'});
}

# monitoring tool
sub cache_status {
   struct ( c_status => { disks     => '$',
                          blocksize  => '$',
                          keys       => '*%',
                          rd_stat    => '*%',
                          key_stat   => '*%',
                          error      => '$',
                          start_disk => '$'
                        } ) unless defined &c_status::new;
   my $stat = new c_status (disks => 0, blocksize => 1024, error => 0);
   my $rdpath = shift || do {
                              $stat->error("Argument missing");
                              return $stat;
                            };
   my (%cache, $tie);
   my $shkey = shift || 'RdLk';
   unless (eval { $tie = tie %cache, 'IPC::Shareable', $shkey, { create => 0, destroy => 0,
                                                                 exclusive => 0, mode => 0666,
                                                                 size => 65536 } } ) {
      $stat->error($@);
      return $stat;
   }

   $tie->shlock(LOCK_SH);

   # 1. general:
   $stat->disks($cache{__Disks__});
   $stat->blocksize($cache{__BSize__});
   $stat->start_disk($cache{__DStart__}); # new in 0.1.5

   # 2. key infos:
   my @key;
   foreach (keys %cache) {
      unless (/^__.*__/) {
         @key = split /:/, $cache{$_};
         $stat->keys($_, $key[0]);
         $stat->key_stat($_, $key[1]);
      }
   }
   $tie->shunlock;

   # 3. disk infos:
   for (my $i = $stat->start_disk; $i < $stat->disks+$stat->start_disk; $i++) {
      $stat->rd_stat($i, df($rdpath.$i));
   }

   undef $tie;
   untie %cache;

   $stat;
}

# new in 0.1.6: monitoring tool, pt.2:
sub cache_objects {
   my $rdpath = shift || die "Argument missing!";
   my (%cache, $tie);
   my $shkey = shift || 'RdLk';
   die $@ unless (eval { $tie = tie %cache, 'IPC::Shareable', $shkey, { create => 0, destroy => 0,
                                                                        exclusive => 0, mode => 0666,
                                                                        size => 65536 } } );
   my $res = {};
   my (@key, $idx, $xtie, $obj, @tidx, $ikey, $rd, $id);
   foreach $ikey (keys %cache) { 
      @key = split /:/, $cache{$ikey}; # [0] = cache value, [1] = items on cache, [2] = ftok, [3] = shmemsize
      unless (eval { $xtie = tie $idx, 'IPC::Shareable', $key[2], { create => 0, destroy => 0,
                                                                   exclusive => 0, mode => 0666,
                                                                   size => $key[3]*1024 } } ) {
         undef $tie;
         untie %cache;
         die $@;
      }
      unless ($ikey =~ /^__\w+__$/) {
         $obj = {};
         @tidx = split /\n/, $idx;
         foreach (@tidx) {
            ($rd, $id) = split /\/\//;
            $obj->{$rd} = [] unless defined $obj->{$rd};
            push @{$obj->{$rd}}, $id;
         }
         $res->{$ikey} = $obj; 
      }
      undef $xtie;
      untie $idx;
   }

   undef $tie;
   untie %cache;
   $res;
}

# remove all system resources related to a cache.
sub cache_remove {
   if ($<) {
      warn "You must be root to remove a cache";
      return 0;
   }

   my $rdpath = shift || do {
                              warn "Argument missing";
                              return 0;
                            };
   my (%cache, $tie);
   my $shkey = shift || 'RdLk';
   unless (eval { $tie = tie %cache, 'IPC::Shareable', $shkey, { create => 0, destroy => 0,