WebService::TestSystem - Web service for implementing a distributed

 id
 descriptor
 description
 category
 code_location
 configuration_notes
 status
 environment_default
 lilo_default
 repeat_safe

    limit           - the number of records to return
    order_by        - the fieldname to order the records by

    distro          - search condition (supports % wildcards)
    test            - search condition (supports % wildcards)
    host            - search condition (supports % wildcards)
    host_type       - search condition (supports % wildcards)
    project         - search condition (supports % wildcards)
    priority        - search condition (must match exactly)
    status          - search condition (must match exactly)
    patch_id        - search condition (must be a valid patch id number)
    patch           - search condition (must match a valid patch name)
    created_by      - user id number for requestor
    username        - username of requestor

    id              - the test request's id
    created_by      - user id# of the requestor
    username        - username of the requestor
    project         - project associated with the request
    status          - the state the test request is currently in
    priority        - priority

    created_date    - date it was created
    started_date    - datetime the test run began
    completion_date - date it was completed

    distro          - distro image name
    test            - test name
    host            - host name
    host_type       - host class
    patch           - patch name

    distro_tag_id   - id# of distro image
    test_id         - id# of test
    host_id         - id# of host
    host_type_id    - id# of host type
    project_id      - id# of project
    patch_tag_id    - id# of patch

  id     - a regular expression that will resolve to one or more 
           host id's
  type   - a regular expression that resolves to a valid set of
           host_type's

  email - an email address to send an email to when the system becomes
          available.
  on_state_change - if set to true, will notify user of ALL changes,
          not just availability.

package WebService::TestSystem;
@WebService::TestSystem::ISA = qw(WebService::TicketAuth::DBI);

use strict;
use Config::Simple;
use WebService::TicketAuth::DBI;
use WebService::TestSystem::Metrics;
use WebService::TestSystem::Request;
use DBI;

# This is the location of the configuration file.
# You can update this value here if you wish to move it to a 
# different location.
my $config_file = "/etc/webservice_testsystem/testsystem.conf";

use vars qw($VERSION %FIELDS);
our $VERSION = '0.06';

use base 'WebService::TicketAuth::DBI';
use fields qw(
              stpdb_dbh
              stpdb_dbi
              stpdb_user
              stpdb_pass

              metrics
	      request

              _error_msg
              _debug
              );

sub new {
    my $class = shift;
    my WebService::TestSystem $self = fields::new($class);

    # Load up configuration parameters from config file
    my %config;
    my $errormsg = '';
    if (! Config::Simple->import_from($config_file, \%config)) {
        $errormsg = "Could not load config file '$config_file': " . 
	    Config::Simple->error()."\n";
    }

    $self->SUPER::new(%config);
    
    foreach my $param (qw(stpdb_dbi stpdb_user stpdb_pass)) {
        if (defined $config{$param}) {
            $self->{$param} = $config{$param};
        }
    }
    $self->{_error_msg} .= $errormsg;

    return $self;
}

# Internal routine for getting the database handle; if it does not
# yet exist, it creates a new one.
sub _get_dbh {
    my $self = shift;

    $self->{'stpdb_dbh'} = 
        DBI->connect_cached($self->{'stpdb_dbi'}, 
                            $self->{'stpdb_user'}, 
                            $self->{'stpdb_pass'}
                            );
    if (! $self->{'stpdb_dbh'}) {
        $self->_set_error("Could not connect to '"
                          .$self->{'stpdb_dbi'}
                          ."' as user '"
                          .$self->{'stpdb_user'}
                          ."':  $! \n$DBI::errstr\n");
    }
    return $self->{'stpdb_dbh'};
}

# Internal routine for setting the error message
sub _set_error {
    my $self = shift;

    $self->{'_error_msg'} = shift;
}

sub get_error {
    my $self = shift;
    return $self->{'_error_msg'};
}

# Gets the WebService::TestSystem::Metrics object (creating it if needed)
sub _metrics {
    my $self = shift;

    if (! defined $self->{metrics}) {
        $self->{metrics} = new WebService::TestSystem::Metrics(app => $self);
    }

    return $self->{metrics};
}

# Gets the WebService::TestSystem::Request object (creating it if needed)
sub _request {
    my $self = shift;

    if (! defined $self->{_request}) {
	$self->{_request} = new WebService::TestSystem::Request(app => $self);
    }

    return $self->{_request};
}

##################
# Authentication / Login management 

# Override for how long to allow tickets to last
sub ticket_duration {
    my $self = shift;
    my $username = shift;

    # Give everyone 24 hour logins
    return 24*60*60;
}

sub login {
    my $self = shift;

    return $self->SUPER::login(@_);
}


###################
# These just redirect into the _metrics sub-object.

sub metrics_requests_per_month {
    my $self = shift;
    return $self->_metrics()->metrics_requests_per_month(@_);
}

sub metrics_test_run_time {
    my $self = shift;
    return $self->_metrics()->metrics_test_run_time(@_);
}

sub metrics_distros_tested_per_month {
    my $self = shift;
    return $self->_metrics()->metrics_distros_tested_per_month(@_);
}

sub metrics_test_request_status_totals {
    my $self = shift;
    return $self->_metrics()->metrics_test_request_status_totals(@_);
}

sub metrics_queue_lengths {
    my $self = shift;
    return $self->_metrics()->metrics_queue_lengths(@_);
}

sub metrics_host_type_test_status_totals {
    my $self = shift;
    return $self->_metrics()->metrics_host_type_test_status_totals(@_);
}

sub metrics_queue_age {
    my $self = shift;
    return $self->_metrics()->metrics_queue_age(@_);
}

sub metrics_patches_queued {
    my $self = shift;
    return $self->_metrics()->metrics_patches_queued(@_);
}

sub metrics_monthly_tests_per_host {
    my $self = shift;
    return $self->_metrics()->metrics_monthly_tests_per_host(@_);
}

################
# Test request and validation

sub get_validation_errors {
    my $self = shift;
    return $self->_request()->get_validation_errors();
}

sub validate_test_request {
    my $self = shift;
    
    return $self->_request()->validate_test_request(@_);
}

sub request_test { 
    my $self = shift;
    my $request = shift;

    # Validate the request
    if (! $self->validate_test_request($request) ) {
        $self->_set_error("Test request failed validation.  "
                          . $self->get_error());
        return undef;
    }

    my $test_request_id = $self->_request()->request_test($request);

    if (! $test_request_id) {
	$self->_set_error($self->_request()->get_error());
	return undef;
    }

    return $test_request_id;
}

sub cancel_test_request {
    my $self = shift;
    my $id = shift;

    # TODO

    return "Unimplemented";
}

sub change_test_request {
    my $self = shift;
    my $request = shift;

    # TODO

    return "Unimplemented";
}

sub get_test_request {
    my $self = shift;
    my $id = shift;

    # TODO

    return "Unimplemented";
}

################
# Eventually, everything after this line should be moved into sub modules

sub get_tests {
    my $self = shift;

    my $sql = qq|
		SELECT uid as id, descriptor, description, category, code_location, 
	    	    configuration_notes, status, environment_default, lilo_default,
	    	    repeat_safe
                FROM test
		|;
    my $dbh = $self->_get_dbh() or return undef;
    my $sth = $dbh->prepare($sql);
    $sth->execute;

    my @tests = ();
    while (my $test = $sth->fetchrow_hashref) {
        push @tests, $test;
    }

    return \@tests;
}

sub get_hosts {
    my $self = shift;

    my $sql = qq|
		SELECT host.uid as id, 
	       	       host.descriptor as host, 
	       	       host_type.descriptor as host_type,
	       	       host_type.cpu as cpu,
	       	       host_type.ram_qty as ram_qty,
	       	       host_type.storage_space as storage_space,
                              host_type.spindle_qty as spindle_qty,
	       	       host_type.eth100 as eth100,
	       	       host_type.eth1000 as eth1000,
	       	       host_state.descriptor as host_state,
                              host_state.available as available,
	       	       host_state.schedulable as schedulable
		FROM host, host_type, host_state
		WHERE host.host_type_uid = host_type.uid
		AND host.host_state_uid = host_state.uid
		ORDER BY host.uid
		|;

    my $dbh = $self->_get_dbh() or return undef;
    my $sth = $dbh->prepare($sql);
    $sth->execute;

    my @hosts = ();
    while (my $host = $sth->fetchrow_hashref) {
        push @hosts, $host;
    }

    return \@hosts;
}

sub get_images {
    my $self = shift;

    my $sql = qq|
                SELECT uid as id, descriptor, status 
                FROM distro_tag 
		WHERE status='Available'
		|;
    my $dbh = $self->_get_dbh() or return undef;
    my $sth = $dbh->prepare($sql);
    $sth->execute;

    my @images = ();
    while (my $image = $sth->fetchrow_hashref) {
        push @images, $image;
    }

    return \@images;
}

sub get_software_types {
    my $self = shift;

    my $sql = qq|
		SELECT DISTINCT software_type
		FROM patch_tag
		|;
    my $dbh = $self->_get_dbh() or return undef;
    my $sth = $dbh->prepare($sql);
    $sth->execute;

    my @packages = ();
    while (my $package = $sth->fetchrow_hashref) {
        push @packages, $package;
    }

    return \@packages;
}

# TODO:  I think this returns one row per patch_tag record...  
#        Perhaps it should return this info as a nested structure?
sub get_requests {
    my ($self, %args) = @_;

    if ($self->{_debug} >1) {
	while (my ($key, $value) = each %args) {
	    warn " '$key' = '$value'\n";
	}
    }

    # limit can only be between 0-1000 and must be a number.
    my $limit = $args{limit} || 20;
    if ($limit !~ /^\d+$/ || $limit > 1000) {
        $self->set_error("Invalid limit '$limit'.  ".
                         "Must be a number in the range 0-1000.");
        return undef;
    } else {
        delete $args{limit};
    }

    # Order field must be alphanumeric
    my $order_by = $args{order_by} || 'test_request.uid';
    if ($order_by !~ /^[\.\w]+$/) {
        $self->_set_error("Invalid order_by field '$order_by'.  ".
                          "Must be an alphanumeric field name.");
        return undef;
    } else {
        delete $args{order_by};
    }

    # Rest of the arguments can only be alphanumeric values
    foreach my $key (keys %args) {
        if ($key !~ m/^\w+$/) {
            my $err = "Invalid key '$key' specified.  ".
                "Only alphanumeric characters may be used.";
            warn "Error:  $err\n" if ($self->{_debug} > 1);
            $self->_set_error($err);
            return undef;
        } elsif ($args{$key} !~ m/^\w+$/) {
            my $err = "Invalid value '$args{'$key'}' specified for '$key'.  "
                ."Only alphanumeric characters may be used.";
            $self->_set_error($err);
            warn "Error:  $err\n" if ($self->{_debug} > 1);
            return undef;
        }
    }

    my $sql = qq|
SELECT 
        test_request.uid AS id,
        test_request.created_by AS created_by,
        DATE_FORMAT(test_request.created_date, '%Y-%m-%d') AS created_date,
        test_request.status AS status,
        DATE_FORMAT(test_request.completion_date, '%Y-%m-%d') AS completion_date,
        test_request.test_priority AS priority,
        test_request.started_date AS started_date,

        test_request.distro_tag_uid AS distro_tag_id,
        test_request.test_uid AS test_id,
        test_request.host_uid AS host_id,
        test_request.host_type_uid AS host_type_id,
        test_request.project_uid AS project_id,

        distro_tag.descriptor AS distro,
        test.descriptor AS test,
        host.descriptor AS host,
        host_type.descriptor AS host_type,
        EIDETIC.user.descriptor AS username,
        EIDETIC.project.descriptor AS project,

        test_request_to_patch_tag.patch_tag_uid AS patch_tag_id,
        patch_tag.descriptor AS patch
FROM 
        test_request, 
        distro_tag, 
        test, 
        host, 
        host_type, 
        test_request_to_patch_tag, 
        patch_tag, 
        EIDETIC.user, 
        EIDETIC.project
WHERE 1
        AND test_request.distro_tag_uid = distro_tag.uid
        AND test_request.test_uid = test.uid
        AND (test_request.host_uid = host.uid OR (test_request.host_uid=0 AND host.uid=1))
        AND test_request.host_type_uid = host_type.uid
        AND test_request.project_uid = EIDETIC.project.uid
        AND test_request.uid = test_request_to_patch_tag.test_request_uid
        AND test_request_to_patch_tag.patch_tag_uid = patch_tag.uid
        AND test_request.created_by = EIDETIC.user.uid
|;

    if (defined $args{'distro'}) {
        $sql .= qq|    AND distro_tag.descriptor LIKE "$args{'distro'}"\n|;
    }
    if (defined $args{'test'}) {
        $sql .= qq|    AND test.descriptor LIKE "$args{'test'}"\n|;
    }
    if (defined $args{'host'}) {
        $sql .= qq|    AND host.descriptor LIKE "$args{'host'}"\n|;
    }
    if (defined $args{'host_type'}) {
        $sql .= qq|    AND host.descriptor LIKE "$args{'host_type'}"\n|;
    }
    if (defined $args{'project'}) {
        $sql .= qq|    AND EIDETIC.project.descriptor LIKE "$args{'project'}"\n|;
    }
    if (defined $args{'priority'}) {
        $sql .= qq|    AND test_request.test_priority = $args{'priority'}\n|;
    }
    if (defined $args{'status'}) {
        $sql .= qq|    AND test_request.status = "$args{'status'}"\n|;
    }
    if (defined $args{'patch_id'}) {
        if ($args{'patch_id'} !~ m/^\d+$/) {
            $self->_set_error("Invalid patch ID '$args{'patch_id'}' specified.  ".
                              "Must be a positive integer.");
            return undef;
        }
        $sql .= qq|    AND test_request_to_patch_tag.patch_tag_uid = $args{'patch_id'}\n|;
    }
    if (defined $args{'patch'}) {
        $sql .= qq|    AND patch_tag.descriptor LIKE '$args{'patch'}'|;
    }
    if (defined $args{'created_by'}) {
        if ($args{'created_by'} !~ m/^\d+$/) {
            $self->_set_error("Invalid created_by ID '$args{'created_by'}'.  ".
                              "Must be a positive integer.");
            return undef;
        }
        $sql .= qq|    AND test_request.created_by=$args{'created_by'}\n|;
    }
    if (defined $args{'username'}) {
        $sql .= qq|    AND EIDETIC.user.descriptor LIKE "$args{'username'}"\n|;
    }

    $sql .= qq|ORDER BY $order_by DESC\n|;
    $sql .= qq|LIMIT $limit\n|;

    warn "sql = '$sql'\n" if ($self->{_debug} > 2);

    my $dbh = $self->_get_dbh() or return undef;
    my $sth = $dbh->prepare($sql);
    $sth->execute;

    my @test_requests = ();
    while (my $tr = $sth->fetchrow_hashref) {
        push @test_requests, $tr;
    }

    return \@test_requests;
}

sub get_request_queue {
    my $self = shift;
    my $host = shift;

    my $sql = qq|
		SELECT test_request.uid as id, 
		patch_tag.descriptor as patch, 
		test_request.status, 
		host_type.descriptor as host_type, 
		test_request.created_date 
		FROM test_request, patch_tag, test_request_to_patch_tag, host_type 
		WHERE test_request.status = 'Queued'
		AND test_request.uid = test_request_to_patch_tag.test_request_uid 
		AND test_request_to_patch_tag.patch_tag_uid = patch_tag.uid 
		AND test_request.host_type_uid = host_type.uid 
                |;
    if ($host) {
	if ($host =~ /^\d+$/) {
	    $sql .= "	AND host_type.uid = $host\n";
	} else {
	    $sql .= "	AND host_type.descriptor = '$host'\n";
	}
    }
    warn "sql = '$sql'\n" if ($self->{_debug} > 2);

    my $dbh = $self->_get_dbh() or return undef;
    my $sth = $dbh->prepare($sql);
    $sth->execute;

    my @queue = ();
    while (my $tr = $sth->fetchrow_hashref) {
        push @queue, $tr;
    }

    return \@queue;
}

sub get_patches {
    my $self = shift;
    my $patch_regex = shift;
    my $limit = shift || 100;

    my $sql = qq|
		SELECT uid as id, descriptor, software_type, autotest_state
		FROM patch_tag 
		LIMIT $limit
		ORDER BY descriptor
		|;
    my $dbh = $self->_get_dbh() or return undef;
    my $sth = $dbh->prepare($sql);
    $sth->execute;

    my @patches = ();
    while (my $patch = $sth->fetchrow_hashref) {
        push @patches, $patch;
    }

    return \@patches;
}

sub add_test {
    my $self = shift;
    my $name = shift;
    my $properties = shift;

    # Assumptions:
    #  * Test code has already been inserted into bitkeeper
    #  * Test code has been tagged stp_deploy, etc. as per web directions

    # Data structure:
    #   test_name
    #   description
    #   lilo_default
    #   code_location
    #   configuration_notes
    #   environment_default
    #   category
    #   status
    #   repeat_safe
    #   test_parameters (array of hashrefs):
    #     + descriptor
    #     + description
    #     + data_type ('string' or 'int')
    #   distros (array of distro id's)
    #   host_types (array of host_type id's)
    #   software_types (array of software strings 'linux', 'postgresql', etc.)

    # Algorithm:
    #
    #  * Exit if the test name already exists in the database
    #  * Validate information in $properties
    #     + descriptor must be alphanumeric (no default - error if not provided)
    #     + lilo_default (default '')
    #     + environment_default (default '')
    #     + category must be alphanumeric (default General)
    #     + status must be either 'Available' or 'Unavailable' (default Available) 
    #     + repeat_safe must be either 0 or 1 (default 0)
    #     + Validate each test parameter
    #     + Validate distro list - they must exist in the table
    #     + Validate host_type's - they must exist in the table
    #     + Validate software_types - they must be alphanumeric
    #  * Invoke SQL call to insert the information into the test table
    #     + insert it with status='Inserting'
    #     insert into test (
    #          rsf,descriptor,created_by,created_date,description,code_location,category,status,repeat_safe ) VALUES ( 1, 'lhms-regression', 3125, now(),'Linux Hotplug Memory Support Regression Test', 'bk://developer.osdl.org/stp-test/lhms-regression', 'General', 'Available', 0 );
    #     + retrieve the test_uid just inserted
    #  * For each parameter, insert into parameters test_parameter
    #     + test_uid
    #     + descriptor
    #     + description
    #     + data_type ('string' or 'int')
    
    #  * Add test into test_to_distro_tag
    #     distro_tag_uid, test_uid
    #     insert into test_to_distro_tag ( rsf, distro_tag_uid, test_uid ) VALUES ( 1, 4, 87 );
    #  * Add test into test_to_host_type
    #     host_type_uid, test_uid
    #     insert into test_to_host_type ( host_type_uid, test_uid, rsf ) VALUES ( 81, 87, 1 );
    #  * Add test into test_to_software:
    #     test_uid, software_type, install_priority
    #   > INSERT into test_to_software ( rsf, test_uid, software_type, install_priority) VALUES ( 1, 87, 'linux', 0 );
    #   > INSERT into test_to_software ( rsf, test_uid, software_type, install_priority ) VALUES ( 1, 87, 'sysstat', 0 );
    #  * Update test record and change status to 'Available' or 'Unavailable'
    #    as appropriate


    # On failure, back out the test insertion

    return "Not implemented\n";
}

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

    return "Not implemented\n";
}

sub update_test {
    my $self = shift;
    my $name = shift;
    my $properties = shift;

    return "Not implemented\n";
}


#### These API routines need implemented

sub activate_host {
    my $self = shift;
    my $host_id = shift;

    return "Not implemented\n";
}

sub checkout_host {
    my $self = shift;
    my $host_criteria = shift;
    my $notification = shift;
    my $preparation = shift;

    # Use host_criteria to find matching set of systems
    # Store request for checking out those systems
    # TODO:  Need separate routine for reviewing checkout requests
    # Set a time-out for when to return machine to queue

    return "Not implemented\n";
}

sub change_host_reservation {
    my $self = shift;
    my $host_id = shift;
    my $timeout = shift;

    # TODO
    return "Not implemented\n";
}

sub add_software_type {
    my $self = shift;
    my $type = shift;

    # TODO
    return "Not implemented\n";
}

sub update_software {
    my $self = shift;
    my $type = shift;
    my $properties = shift;

    # TODO
    return "Not implemented\n";
}

1;