view release on metacpan or  search on metacpan

lib/PkgForge/Job.pm  view on Meta::CPAN

    documentation => 'The date/time the job was submitted',
);

has 'size' => (
    traits  => ['PkgForge::Serialise'],
    is      => 'rw',
    isa     => Int,
    builder => '_job_size',
    lazy    => 1,
    documentation => 'The total size of the source packages in bytes',
);

sub _job_size {
    my ($self) = @_;

    my $total = 0;
    for my $pkg ($self->packages) {
        $total += $pkg->size;
    }

    return $total;
}

has 'packages' => (
    traits     => [ 'Array', 'PkgForge::Serialise' ],
    is         => 'ro',
    isa        => SourcePackageList,
    auto_deref => 1,
    default    => sub { [] },
    handles    => {
        add_packages    => 'push',
        count_packages  => 'count',
        filter_packages => 'grep',
        packages_list   => 'elements',
    },
    pack       => sub { PkgForge::SourceUtils::pack_packages($_[0]) },
    unpack     => sub { PkgForge::SourceUtils::unpack_packages($_[0]) },
    documentation => 'The set of source packages to be built',
);

after 'add_packages' => sub {
    my ($self) = @_;
    $self->update_job_size;
    return;
};

sub update_job_size {
    my ($self) = @_;

    $self->size( $self->_job_size );

    return;
}

has 'submitter' => (
    traits   => ['PkgForge::Serialise'],
    is       => 'rw',
    isa      => UserName,
    required => 1,
    coerce   => 1,
    default  => sub { getpwuid($<) },
    documentation => 'The name of the person who submitted this job',
);

has 'report' => (
    traits      => ['PkgForge::Serialise','Getopt','Array'],
    is          => 'rw',
    isa         => EmailAddressList,
    coerce      => 1,
    cmd_aliases => 'r',
    predicate   => 'report_required',
    handles     => {
        report_list => 'elements',
    },
    documentation => 'Email addresses to which build reports will be sent',
);

has 'verbose' => (
    traits      => ['Getopt'],
    is          => 'rw',
    isa         => Bool,
    default     => 0,
    documentation => 'Verbose output',
);

around 'new_from_yamlfile' => sub {
  my $orig = shift;
  my $class = shift;

  my $obj = $class->$orig(@_);

  if ( $obj->has_directory ) {
    my $dir = $obj->directory;

    for my $package ($obj->packages_list) {
      $package->basedir($dir);
    }
  }

  return $obj;
};

no Moose;
__PACKAGE__->meta->make_immutable;

sub stringify {
    my ($self) = @_;
    return $self->id;
}

sub clone {
    my ($self) = @_;

    require Storable;
    my $clone = Storable::dclone($self);

    return $clone;
}

sub process_build_targets {
    my ( $self, @available ) = @_;

lib/PkgForge/Job.pm  view on Meta::CPAN

        my $fullpath = $package->fullpath;
        if ( $self->verbose ) {
            warn "Copying '$fullpath' to '$new_dir'\n";
        }
        $ok = File::Copy::copy( $fullpath, $new_dir );
        last if !$ok;
        $package->basedir($new_dir);
    }

    if (!$ok) {
        _transfer_failure( $new_dir, "Failed to transfer some packages for job $id" );
    }

    eval {
        my $build_file = File::Spec->catfile( $new_dir, 'build.yml' );
        $new_obj->yamlfile($build_file);
        $new_obj->directory($new_dir);
        $new_obj->store_in_yamlfile();
    };
    if ($EVAL_ERROR) {
        _transfer_failure( $new_dir, "Failed to load transferred job $id" );
    }

    if ( $self->verbose ) {
        warn "Copy finished, will now validate.\n";
    }
    my $valid = eval { $new_obj->validate() };
    if ( !$valid || $EVAL_ERROR ) {
        _transfer_failure( $new_dir, "Failed to validate transfer of job $id" );
    }

    return $new_obj;
}

sub _transfer_failure {
    my ( $dir, $msg ) = @_;

    if ( -d $dir ) {
        PkgForge::Utils::remove_tree($dir);
    }

    die "$msg\n";
}

sub overdue {
    my ( $self, $timeout ) = @_;

    my $now = time;
    return ( ($now - $timeout) > $self->subtime );
}

sub new_from_qentry {
    my ( $class, $qentry ) = @_;

    my $dir = $qentry->path;

    my $obj = $class->new_from_dir($dir);

    # Submitter
    my $uid = $qentry->owner;
    my $owner = getpwuid($uid);
    $obj->submitter( $owner || $uid );

    # Submission time
    $obj->subtime($qentry->timestamp);

    return $obj;
}

sub new_from_dir {
    my ( $class, $dir ) = @_;

    if ( !-d $dir ) {
        die "Build job directory '$dir' does not exist\n";
    }

    my $build_file = File::Spec->catfile( $dir, 'build.yml' );

    if ( !-f $build_file ) {
        die "Build job file '$build_file' does not exist\n";
    }

    return $class->new_from_yamlfile( yamlfile  => $build_file,
                                      directory => $dir );
}

sub scrub {
    my ( $self, $options ) = @_;

    PkgForge::Utils::remove_tree( $self->directory, $options );

    undef $self;

    return;
}

1;
__END__

=head1 NAME

PkgForge::Job - Represents a build job for the LCFG Package Forge

=head1 VERSION

This documentation refers to PkgForge::Job version 1.4.8

=head1 SYNOPSIS

     use PkgForge::Job;
     use PkgForge::Source::SRPM;

     my $job = PkgForge::Job->new( bucket   => "lcfg",
                                   archs    => ["i386","x86_64"],
                                   platform => ["sl5"] );

     my $package =
        PkgForge::Source::SRPM->new( file => "foo-1.2.src.rpm");

     $job->add_packages($package);