view release on metacpan or  search on metacpan

lib/Data/Downloader/File.pm  view on Meta::CPAN

        my $loaded = $self->load(speculative => 1);
        DEBUG $loaded ? "Found file in db" : "File not yet in db";
    }

    # Compute the URL.
    defined($self->url) or $self->_store_url(%args); # may die
    DEBUG "downloading url is ".$self->url;

    my $request_time = DateTime->now();
    if ( $self->_already_downloaded ) {
        DEBUG "File has already been downloaded";
        $self->add_log_entries({
                requested_at => $request_time,
                cache_hit    => 1,
                completed_at => $request_time,
                prog         => $0,
                pid          => $$,
                uid          => $<,
                note         => $ENV{DATA_DOWNLOADER_LOG_NOTE},
            }) if $ENV{DATA_DOWNLOADER_GATHER_STATS};
        return $self;
    }
    return $self;
}

=item listlinks

List all the symlinks for a file

=cut

sub listlinks {
    my $self = shift;
    return unless($self->symlinks);
    for my $e (@{$self->symlinks}) {
		 print $e->linkname,"\n";
    }
  
}

=item remove

Remove this file from the disk, set "on_disk" to false
and remove any symlinks too.

=cut

sub remove {
    my $self = shift;
    my $args = validate( @_, { purge => 0 } );
    my $tries = 0;
    my $success;
    my $errors;

    # For SQLite:
    # Force an exclusive transaction.  This is necessary when doing WAL
    # journaling.  Without this, the first statement, which is a select
    # on symlinks will force a SHARED lock.  When it then tries to DELETE
    # the symlinks it will not be able to upgrade to an EXCLUSIVE lock
    # if another process already has an EXCLUSIVE lock, so it will fail
    # without doing the busy timeout.
    local $self->db->dbh->{sqlite_use_immediate_transaction} = 1;

    while (!$success && $tries++ < 10) {
        $success = $self->db->do_transaction(sub {
            if ($self->on_disk) {
                for my $symlink ($self->symlinks) {
                    DEBUG "removing symlink ".$symlink->linkname;
                    -l $symlink->linkname and do {
                        unlink $symlink->linkname
			    or WARNDIE "failed to remove symlink ".$symlink->linkname." : $!";
                    };
                    $symlink->delete
			or WARNDIE "failed to remove symlink from db : ".$symlink->error;
                }
                -e $self->storage_path and do {
                    unlink $self->storage_path
			or WARNDIE "failed to unlink ".$self->storage_path." : $!";
                };
            }
            if ($args->{purge}) {
                DEBUG "purging file ".$self->id;
                $self->delete(cascade => 1)
		    or WARNDIE "failed to purge file: ".$self->error;
            } else {
                DEBUG "removing file ".$self->id;
                $self->on_disk(0);
                $self->disk(undef);
                $self->disk_obj(undef);
                $self->save(changes_only => 1) 
		    or WARNDIE "failed to save changes ".$self->error;
            }
        });
        if (!$success) {
            $errors = $self->db->error;
            TRACE "remove file failed : $errors, attempt number $tries/10";
        }
        sleep $tries if $tries > 1;
    }
    if (!$success) {
	ERROR "failed to remove file ".$self->id." : $errors";
	return;
    }
    return 1;
}

=item purge

Remove this file and any information stored about it.

=cut

sub purge {
    my $self = shift;
    $self->remove(purge => 1);
}

=item check

Check a file and its symlinks and ensure that the database
information represents what is stored on disk.