# -*- perl -*- # # Test::AutoBuild::ArchiveManager # # Daniel Berrange # Dennis Gregorovic # # Copyright (C) 2004-2005 Dennis Gregorovice, Daniel Berrange # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA # # $Id: ArchiveManager.pm,v 1.7 2007/12/08 17:35:16 danpb Exp $ =pod =head1 NAME Test::AutoBuild::ArchiveManager - The base class for managing archive =head1 SYNOPSIS # Create a manager (must be some subclass) use Test::AutoBuild::ArchiveManager::XXX; my $manager = Test::AutoBuild::Manager::XXX->new() # Create a new archive, keyed off current time $manager->create_archive(time); # Get current archive & store some stuff my $archive = $manager->get_current_archive $archive->save_data("myobject", "build", { status => "failed" }); # Get prevous archive, aka the 'cache' from last cycle my $cache = $manager->get_previous_archive if ($cache->has_data("myobject", "build")) { my $build = $cache->get_data("myobject", "build"); print "Previous status was ", $build->{status}; } # Purge invalid archives foreach ($manager->list_invalid_archives) { $manager->delete_archive($_->key); } =head1 DESCRIPTION The C module provides capabilities for managing a set of C instances. It provides apis for creation, deletion and retrieval of archive intances, and for determining when an archive should be expired. This module is an abstract base class providing generic functionality, and is intended to be subclassed to provide functionality specific to the backend storage system. It works hand in hand with the L module which defines APIs for working with a single archive intance. The most commonly used subclass is L which provides for management of archives stored on local filesystem, via the L module. For demo & test purposes there is also an in-memory manager L, although obviously this should not be used for large scale archives, since it stores absolutely everything in RAM. =head1 SUBCLASSING There are three methods which must be implemented by all subclasses; The default implementations of these methods simply call C, informing the caller that the subclass forgot to override them. =over 4 =item list_archives To retrieve a list of all archives currently managed. This will later be filtered to separate out current / expired archives. =item create_archive To create a new empty instance of the L subclass related to this module =item delete_archive To delete an instance of L no longer required. =back =head1 METHODS =over 4 =item my $manager = Test::AutoBuild::ArchiveManager->new('max-age' => $age, 'max-instance' => $count, 'max-size' => $size, 'options' => \%options); This method creates a new archive manager instance. This method is not for use by end users since this is an abstract base class; indeed this metohd will die unless the class being constructed is a subclass. The C parameter is used to set the C property, defaulting to C<7d>. The C parameter is used to set the C property defaulting to C<1g>. The C parameter is used to set the C property defaulting to C<10>. The final C parameter is a hash reference containing arbitrary key, value pairs. These are not used by this class, however, may be used by subclasses for implementation specific configuration parameters. =cut package Test::AutoBuild::ArchiveManager; use warnings; use strict; use Class::MethodMaker new_with_init => qw(new), get_set => [qw(max_age max_instance max_size)]; use Log::Log4perl; sub init { my $self = shift; my %params = @_; die ref($self) . " is an abstract module and must be sub-classed" if ref($self) eq "Test::AutoBuild::ArchiveManager"; $self->max_age(exists $params{'max-age'} ? $params{'max-age'} : "7d"); $self->max_instance(exists $params{'max-instance'} ? $params{'max-instance'} : "10"); $self->max_size(exists $params{'max-size'} ? $params{'max-size'} : "1g"); $self->{options} = $params{options} ? $params{options} : {}; } =pod =item my $value = $manager->option($name[, $newvalue]); Retrieves the subclass specific configuration option specified by the C<$name> parameter. If there is no stored option associated with the key C<$name>, then C is returned. If the C<$newvalue> parameter is supplied, then the stored option value is updated. =cut sub option { my $self = shift; my $name = shift; $self->{options}->{$name} = shift if @_; return $self->{options}->{$name}; } =pod =item my $archive = $manager->get_current_archive(); This retrieves the most recently created, and still valid, archive instance managed by this object. If there are no valid archives currently managed, this returns C. This is the method one would typically use to retrieve the archive into which the current build cycle's results will be stored. =cut sub get_current_archive { my $self = shift; my @archives = $self->list_archives; if ($#archives > -1) { return $archives[$#archives]; } return; } =pod =item my $archive = $manager->get_previous_archive(); This retrieves the second most recently created, and still valid archive instance managed by this object. If there are less than two valid archives managed, this returns C. This is the method one would typically use to retrieve the archive from which the previous build cycle's results can be extracted. =cut sub get_previous_archive { my $self = shift; my @archives = $self->list_archives; if ($#archives > 0) { return $archives[$#archives-1]; } return; } =pod =item my $archive = $manager->create_archive($key); This creates a new instance of the L subclass used by this object, assigning it the unique key C<$key>. Archive keys should be generated such that when comparing the keys for two archives, the key associated with the newest archive compares numerically larger than that of the older archive. For all intents & purposes this means, that keys should be monotonically increasing integers. New prescence of a newly created archive is immediately reflected by the other methods in this class. ie, what was the 'current archive' is will become the 'previous archive', and the new archive will be the new 'previous archive'. Any expiry / validity rules will also immediately take effect, for example 'max-instances' may cause an older archive to become invalid. This method must be overriden by subclass, since the default implementation will simply call C. =cut sub create_archive { my $self = shift; my $key = shift; die "module " . ref($self) . " forgot to implement the create_archive method"; } =pod =item $manager->delete_archive($key); This deletes archive instance associated with this manager which has the key C<$key>. If there is no matching achive instance, this method will call C. The deletion of an archive is immediately reflected by the other methods in this class. This method must be overriden by subclass, since the default implementation will simply call C. =cut sub delete_archive { my $self = shift; my $key = shift; die "module " . ref($self) . " forgot to implement the delete_archive method"; } =pod =item my @archives = $manager->list_archives; Returns a list of all archive instances, valid or not, currently managed by this manager object. The archive instances will be some subclass of L applicable to this manager object. The list will be sorted such that the oldest archive is the first in the list, while the newest archive is the last in the list. This method must be overriden by subclasses, since the default implementation simply calls C. =cut sub list_archives { my $self = shift; die "module " . ref($self) . " forgot to implement the list_archives method"; } =pod =item my @archives = $manager->list_invalid_archives; Returns a list of all invalid archive instances currently managed by this manager. An archive is invalid, if its inclusion in the list would cause any of the C, C, or C constraints to be violated. Invalid archives are typically candidates for immediate deletion. =cut sub list_invalid_archives { my $self = shift; my $now = time; my @invalid; my $log = Log::Log4perl->get_logger(); my @archives = reverse $self->list_archives; $log->debug("Checking validity of " . int(@archives) . " archives"); my $seen = {}; my $size = 0; for (my $i = 0 ; $i <= $#archives ; $i++) { if ($i >= $self->max_instance) { $log->info("Archive $i is invalid because there are too many instances"); push @invalid, $archives[$i]; next; } if ($self->_has_archive_expired($archives[$i], $now)) { $log->info("Archive $i is invalid because it has expired"); push @invalid, $archives[$i]; next; } $size += $archives[$i]->size($seen); if ($self->_is_archive_to_large($size)) { $log->info("Archive $i is invalid because the total size is too great"); push @invalid, $archives[$i]; next; } } return @invalid; } sub total_size { my $self = shift; my @archives = shift; my $size; my $seen = {}; foreach my $archive (@archives) { $size += $archive->size($seen); } return $size; } # Not an official public API at this time. sub _has_archive_expired { my $self = shift; my $archive = shift; my $now = shift; my $max_age = $self->max_age; # max_age option has the format like "7d" for 7 days, "4h" for 4 hours, # etc. Convert this into minutes. my $max_age_seconds; if ($max_age =~ /^(\d+)d$/) { $max_age_seconds = $1 * 24 * 60 * 60; } elsif ($max_age =~ /^(\d+)h$/) { $max_age_seconds = $1 * 60 * 60; } elsif ($max_age =~ /^(\d+)m$/) { $max_age_seconds = $1 * 60; } else { die "max_age option, if it exists, must have form NNd (days), NNh (hours) or NNm (mins)"; } my $log = Log::Log4perl->get_logger(); $log->debug("Max age of $max_age correspond to $max_age_seconds"); my $expires_at = $archive->created + $max_age_seconds; $log->debug("Archive expires at $expires_at, but we're now at $now"); if ($expires_at < $now) { return 1; } return 0; } sub _is_archive_to_large { my $self = shift; my $size = shift; my $max_size = $self->max_size; my $max_size_bytes; if ($max_size =~ /^(\d+(?:\.\d+)?)GB?$/i) { $max_size_bytes = $1 * (1024 * 1024 * 1024); } elsif ($max_size =~ /^(\d+(?:\.\d+)?)MB?$/i) { $max_size_bytes = $1 * (1024 * 1024); } elsif ($max_size =~ /^(\d+(?:\.\d+)?)KB?$/i) { $max_size_bytes = $1 * 1024; } elsif ($max_size =~ /^(\d+(?:\.\d+)?)B?$/i) { $max_size_bytes = $1; } else { die "max_size option, if it exists, must have form NNg (gigabytes), NNm (megabytes) or NNk (kilobytes)"; } if ($size > $max_size_bytes) { return 1; } return 0; } 1 # So that the require or use succeeds. __END__ =back =head1 PROPERTIES The following properties each have a correspondingly named method which supports getting & setting of the property value. The getter is the no-arg version, while the setter is the one-argument version. eg, my $age = $manager->max_age $manager->max_age("7d"); =over 4 =item max_age This property controls how long an archive can exist before it is considered invalid & thus a candidate for removal. It is represented as an integer, followed by a unit specifier, eg '7d' for seven days, '8h' for eight hours, or '9m' for nine minutes. =item max_instance This property specifies the total number of archive instances to create before beginning to mark old archives as invalid. It is simply an integer count. =item max_size This property controls the maximum storage to allow to be consumed by all managed archives. It is represented as an integer followed by a unit specifier, eg '1g' for 1 gigabyte, or '2m' for 2 megabytes. =back =head1 BUGS Although nicely documented, the C and C properties are not currently used when determining list of invalid archives. This ommision ought to be fixed at some point.... =head1 AUTHORS Daniel Berrange , Dennis Gregorovic =head1 COPYRIGHT Copyright (C) 2004-2005 Dennis Gregorovic, Daniel Berrange =head1 SEE ALSO C, L, L =cut