Meadow.pm 3.53 KB
Newer Older
1 2 3 4 5 6 7 8 9 10 11 12 13 14
=pod 

=head1 NAME

    Bio::EnsEMBL::Hive::Meadow;

=head1 DESCRIPTION

    Meadow is an abstract interface to the queue manager.

    A Meadow knows how to check&change the actual status of Workers on the farm.

=head1 LICENSE

15
    Copyright [1999-2015] Wellcome Trust Sanger Institute and the EMBL-European Bioinformatics Institute
Matthieu Muffato's avatar
Matthieu Muffato committed
16
    Copyright [2016-2018] EMBL-European Bioinformatics Institute
17 18 19 20 21 22 23 24 25 26 27 28

    Licensed under the Apache License, Version 2.0 (the "License"); you may not use this file except in compliance with the License.
    You may obtain a copy of the License at

         http://www.apache.org/licenses/LICENSE-2.0

    Unless required by applicable law or agreed to in writing, software distributed under the License
    is distributed on an "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
    See the License for the specific language governing permissions and limitations under the License.

=head1 CONTACT

29
  Please subscribe to the Hive mailing list:  http://listserver.ebi.ac.uk/mailman/listinfo/ehive-users  to discuss Hive-related questions or to be notified of our updates
30 31 32

=cut

33 34 35 36

package Bio::EnsEMBL::Hive::Meadow;

use strict;
37 38
use warnings;

39 40
use base ('Bio::EnsEMBL::Hive::Configurable');

41

42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72
# -------------------------------------- <versioning of the Meadow interface> -------------------------------------------------------

our $MEADOW_MAJOR_VERSION = '1';                # Make sure you change this number whenever an incompatible change is introduced


sub get_meadow_major_version {

    return $MEADOW_MAJOR_VERSION;               # fetch the declared $MEADOW_MAJOR_VERSION of the interface
}


sub get_meadow_version {
    my $self = shift @_;

    return $self->VERSION // 'unversioned';     # fetch the declared $VERSION of a specific Meadow implementation
}


sub check_version_compatibility {
    my $self = shift @_;

    my $mmv = $self->get_meadow_major_version();
    my $mv  = $self->get_meadow_version();
#    warn "$self :  MVC='$mmv', MV='$mv'\n";

    return ($mv=~/^$mmv\./) ? 1 : 0;
}

# -------------------------------------- </versioning of the Meadow interface> ------------------------------------------------------


73
sub new {
74 75 76 77 78
    my ($class, $config) = @_;

    my $self = bless {}, $class;

    $self->config( $config );
79
    $self->context( [ 'Meadow', $self->type, $self->name ] );
80

81
    return $self;
82 83
}

84

85 86
sub type { # should return 'LOCAL' or 'LSF'
    my $class = shift @_;
87

88
    $class = ref($class) if(ref($class));
89

90
    return (reverse split(/::/, $class ))[0];
91 92
}

93

94
sub signature {
95 96
    my $self = shift @_;

97
    return $self->type.'/'.$self->name;
98 99 100
}


101 102 103 104 105
sub pipeline_name { # if set, provides a filter for job-related queries
    my $self = shift @_;

    if(@_) { # new value is being set (which can be undef)
        $self->{'_pipeline_name'} = shift @_;
106
    }
107
    return $self->{'_pipeline_name'};
108 109
}

110

111 112 113
sub job_name_prefix {
    my $self = shift @_;

114
    return ($self->pipeline_name() ? $self->pipeline_name().'-' : '') . 'Hive-';
115 116
}

117

Leo Gordon's avatar
Leo Gordon committed
118
sub generate_job_name {
119
    my ($self, $worker_count, $iteration, $rc_name) = @_;
Leo Gordon's avatar
Leo Gordon committed
120

121
    return $self->job_name_prefix()
122
        ."${rc_name}-${iteration}"
Leo Gordon's avatar
Leo Gordon committed
123
        . (($worker_count > 1) ? "[1-${worker_count}]" : '');
Leo Gordon's avatar
Leo Gordon committed
124 125
}

126

127 128 129
sub responsible_for_worker {
    my ($self, $worker) = @_;

130
    return ($worker->meadow_type eq $self->type) && ($worker->meadow_name eq $self->name);
131 132
}

133

134
sub check_worker_is_alive_and_mine {
135 136 137 138 139
    my ($self, $worker) = @_;

    die "Please use a derived method";
}

140

141 142 143 144 145 146 147
sub kill_worker {
    my ($self, $worker) = @_;

    die "Please use a derived method";
}

1;