The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
# -*- perl -*-
#
# Test::AutoBuild::Repository by Daniel Berrange <dan@berrange.com>
#
# Copyright (C) 2002 Daniel Berrange <dan@berrange.com>
#
# 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: Repository.pm,v 1.2.2.2 2004/08/16 09:05:37 danpb Exp $

=pod

=head1 NAME

Test::AutoBuild::Repository - Source control repository access

=head1 SYNOPSIS

  use Test::AutoBuild::Repository

  my $rep = Test::AutoBuild::Repository->new(
               name => $name,
               options => \%options,
               env => \%env,
               label => $label);

  # Add a module to the repository
  $rep->module($module);

  # Initialize the repository
  $rep->init();
 
  # Checkout / update the module
  my $changed = $rep->export($name, $module);

=head1 DESCRIPTION

This module provides the API for interacting with the source
control repositories. A repository implementation has to be
able to do two main things

 * Get a checkout of a new module
 * Update an existing checkout, determining if any
   changes where made

=head1 CONFIGURATION

The valid configuration options for the C<repositories> block are

=head1 METHODS

=over 4

=cut

package Test::AutoBuild::Repository;

use strict;
use Test::AutoBuild::Lib;
use Carp qw(confess);


=pod

=item my $rep = Test::AutoBuild::Repository->new(name => $name,
           label => $label,
           options => \%options,
           env => \%env);

This method creates a new repository. The C<name> argument is an
alphanumeric token representing the name of the repository. The
C<label> argument is a human friendly name of the repository. The
optional C<options> argument is a hashref of implementation
specific options. The optional C<env> argument is a hashref of
environment variables to set when running the commands to access
the repository.

=cut

sub new {
    my $proto = shift;
    my $class = ref($proto) || $proto;
    my $self = {};
    my %params = @_;

    $self->{name} = exists $params{name} ? $params{name} : confess "name parameter is required";
    $self->{options} = exists $params{options} ? $params{options} : {};
    $self->{env} = exists $params{env} ? $params{env} : {};
    $self->{label} = exists $params{label} ? $params{label} : confess "label parameter is required";
    $self->{modules} = {};

    bless $self, $class;

    return $self;
}

=pod

=item my $name = $rep->name([$name]);

When run without any arguments, returns the alphanumeric token representing
the name of the repository. If a single argument is supplied, this is use to
update the name.

=cut

sub name {
    my $self = shift;
    $self->{name} = shift if @_;
    return $self->{name};
}

=pod

=item my $value = $rep->option($name[, $value]);

When run with a single argument, retuns the option value corresponding to
the name specified in the first argument. If a second argument is supplied,
then the 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 $value = $rep->env($name[, $value]);

When run with a single argument, retuns the environment variable corresponding 
to the name specified in the first argument. If a second argument is supplied,
then the environment variable is updated.

=cut

sub env {
   my $self = shift;
   my $name = shift;

   $self->{env}->{$name} = shift if @_;
   return $self->{env}->{$name};
}

=pod

=item my $label = $rep->label([$label]);

When run without any arguments, returns the human friendly string representing
the label of the repository. If a single argument is supplied, this is use to
update the label.

=cut

sub label {
    my $self = shift;
    $self->{label} = shift if @_;
    return $self->{label};
}

=item my $module = $rep->module($name[, $module]);

When run with a single argument, returns the module object corresponding
to the name specified as the first argument. If the second argument is
supplied, then the module object is updated.

=cut

sub module {
    my $self = shift;
    my $name = shift;
    $self->{modules}->{$name} = shift if @_;
    return $self->{modules}->{$name};
}

=item my @modules = $rep->modules();

Returns the list of modules in this repository

=cut

sub modules {
    my $self = shift;
    return keys %{$self->{modules}};
}


=item $rep->init();

Performs any one time initialization required prior to
exporting modules from the repoitory.

=cut

sub init {
    my $self = shift;
}

=item my $changed = $rep->export($name, $module);

Exports the module specified in the second argument to a directory
specified by the first argument. Returns zero if there were no changes
to export; non-zero if the module was new or changed. This is a virtual
method which must be implemented by all subclasses.

=cut

sub export {
    my $self = shift;
    my $module = shift;
    confess "class " . ref($self) . " forgot to implement the export method";
}

=item my $output = $rep->_run($cmd);

Runs the command specified in the first argument, having first
setup the environment variables specified when the repository
was created. It returns any text written to standard out by the
command

=cut

sub _run {
    my $self = shift;
    my $cmd = shift;

    return Test::AutoBuild::Lib::run($cmd, $self->{env});
}

1 # So that the require or use succeeds.

__END__

=back 4

=head1 AUTHORS

Daniel Berrange <dan@berrange.com>

=head1 COPYRIGHT

Copyright (C) 2002 Daniel Berrange <dan@berrange.com>

=head1 SEE ALSO

L<perl(1)>

=cut