view release on metacpan or  search on metacpan

lib/App/Wallflower.pm  view on Meta::CPAN

    # aggregate all child todo into ours and save it as __TODO__
    local *ARGV;
    @ARGV = ( $TODO, glob $self->{_ipc_dir_}->child('todo-*') );
    no warnings 'inplace';    # some files may already be gone
    my $fh = File::Temp->new(
        TEMPLATE => "__TODO__-XXXX",
        DIR      => $self->{_ipc_dir_},
    );
    print $fh uniqstr @ARGV ? <> : (), map "$_\n", @items;
    close $fh;
    rename "$fh", $TODO
      or die "Can't rename $fh to $TODO: $!";

    # the parent to-do list is always empty
    $self->{todo} = [];

    # fork all kids
    if ( !$self->{_forked_} ) {
        for ( 1 .. $self->{option}{parallel} ) {
            if ( not my $pid = fork ) {
                $self->{_pidfile_} = Path::Tiny->tempfile(
                    TEMPLATE => "pid-$$-XXXX",
                    DIR      => $self->{_ipc_dir_},
                );
                delete $self->{_seen_fh_};    # will reopen
                return;
            }
            elsif ( !defined $pid ) {
                warn "Couldn't fork: $!";
            }
            else {
                $self->{_forked_}++;
            }
        }
        sleep 1;    # give them time to settle
    }
}

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

    # save the child todo
    my $fh = File::Temp->new(
        TEMPLATE => "todo-$$-XXXX",
        DIR      => $self->{_ipc_dir_},
    );
    print $fh map "$_\n", @{ $self->{todo} };
    close $fh;
    $self->{_todo_fh_} = $fh;    # deletes previous one
}

# returns a boolean indicating if the update can be trusted
sub _update_todo {
    my ($self) = @_;
    my $todo   = $self->{todo};
    my $TODO   = $self->{_ipc_dir_}->child('__TODO__');
    my $SEEN   = $self->{_ipc_dir_}->child('__SEEN__');

    return if !-e $TODO;
    my $certainty =    # this update can be trusted if __TODO__ is the
      ( stat $TODO )[9] > max( 0, map +(stat)[9] || 0,    # most recent
        $SEEN, glob $self->{_ipc_dir_}->child('todo-*')); # file of all

    # read from the shared todo
    open my $fh, '<', $TODO or die "Can't open $TODO: $!";
    @$todo = <$fh>;
    chomp(@$todo);

    return $certainty;
}

sub _next_todo {
    my ($self) = @_;
    my $seen   = $self->{seen};
    my $todo   = $self->{todo};
    my $next;

    if ( $self->{option}{parallel} ) {

       # in parallel mode, the parent does not render anything
       return if $self->{_parent_} == $$;

      TODO:

        # read from the shared seen file
        my $SEEN = $self->{_ipc_dir_}->child('__SEEN__');
        my $seen_fh = $self->{_seen_fh_} ||= do {
            open my $fh, -e $SEEN ? '+<' : '+>', $SEEN
              or die "Can't open $SEEN in read-write mode: $!";
            $fh->autoflush(1);
            $fh;
        };
        flock( $seen_fh, LOCK_EX() ) or die "Cannot lock $SEEN: $!\n";
        seek( $seen_fh, 0, SEEK_CUR() );
        while (<$seen_fh>) { chomp; $seen->{$_}++; }

        # find a todo item not seen
        ( $next, @$todo ) = uniqstr grep !$seen->{$_}, @$todo;

        # or update todo and try again
        if ( !defined $next ) {
            my $certain = $self->_update_todo;
            ( $next, @$todo ) = uniqstr grep !$seen->{$_}, @$todo;

            # if we can't trust the update, try the entire thing again
            if ( !defined $next && !$certain ) {
                flock( $seen_fh, LOCK_UN() ) or die "Cannot unlock $SEEN: $!\n";
                sleep 1;
                goto TODO;
            }
        }

        # write to the shared seen file
        if ( defined $next ) {    # /!\ NOT ELSE /!\
            seek( $seen_fh, 0, SEEK_END() );
            print $seen_fh "$next\n";
        }
        flock( $seen_fh, LOCK_UN() ) or die "Cannot unlock $SEEN: $!\n";
    }
    else {
        ( $next, @$todo ) = uniqstr grep !$seen->{$_}, @$todo;
    }

    # nothing to do
    return undef if !defined $next;

    $seen->{$next}++;
    return URI->new($next);
}