view release on metacpan or  search on metacpan

lib/Convert/Pheno/HTTP/Jobs.pm  view on Meta::CPAN

    $maximum //= $MAX_CONCURRENT_JOBS;
    die "Maximum concurrent jobs must be an integer from 1 to $maximum\n"
      unless defined($value) && !ref($value) && "$value" =~ /\A[1-9][0-9]*\z/
      && $value <= $maximum;
    return 0 + $value;
}

sub _metadata_lock {
    my ($file, $mode) = @_;
    # Lock a stable sibling, not the JSON inode replaced by atomic writes.
    # Windows readers must not overlap replacement (including its backup gap).
    # Keep this file in place: unlinking it could create two independent locks.
    my $lockfile = path($file)->parent->child('.metadata.lock');
    open my $lock, '>>', $lockfile
      or die "Cannot open job metadata lock <$lockfile>: $!\n";
    flock($lock, $mode)
      or die "Cannot lock job metadata <$lockfile>: $!\n";
    return $lock;
}

sub _write {

lib/Convert/Pheno/IO/Atomic.pm  view on Meta::CPAN

            my $mode = $stat[2] & 07777;
            chmod $mode, $staged
              or die "Could not preserve permissions for staged output <$staged>: $!\n";
        }
    }

    return 1 if rename $staged, $target;
    my $rename_error = $!;

    # Windows cannot replace an existing path with rename(). Keep a recoverable
    # backup until the fully written staged file has taken its place.
    # The Windows replacement fallback is valid only for an existing regular
    # file. Never move a directory or symbolic link out of the way.
    if ( $^O eq 'MSWin32' && -f $target && !-l $target ) {
        my $backup = create_staged_path($target);
        unlink $backup
          or die "Could not prepare backup path for <$target>: $!\n";
        rename $target, $backup
          or die "Could not preserve existing output <$target>: $!\n";

        if ( rename $staged, $target ) {
            warn "Could not remove output backup <$backup>: $!\n"
              unless unlink $backup;
            return 1;
        }

        my $replacement_error = $!;
        rename $backup, $target
          or die "Could not replace <$target> ($replacement_error) or restore it ($!)\n";
        die "Could not replace output <$target>: $replacement_error\n";
    }

    die "Could not replace output <$target>: $rename_error\n";
}

sub write_atomically {
    my ( $target, $writer ) = @_;
    die "Atomic output writer must be a code reference\n"