view release on metacpan or  search on metacpan

lib/Document/Repository.pm  view on Meta::CPAN

any problem.

=cut
sub content {
    my $self = shift;
    my $filename = shift || return undef;
    my $doc_id = shift || return undef;
    my $revision = shift;

    my $doc_path = $self->repository_path($doc_id) || return undef;

    # Default $revision to current revision if not specified
    $revision ||= $self->current_revision($doc_id, $doc_path);

    my $file = catfile($doc_path,
		       sprintf("%03d", $revision),
		       $filename);
    if (-d $file) {
	my @files;
	opendir(DIR, $file) or return undef;
	while (defined(my $dir_content = readdir(DIR))) {
	    push @files, $dir_content;
	}
	return @files;
    }

    if (! -e $file) {
	return undef;
    }

    if (! open(FILE, "< $file")) {
	$self->_set_error("Could not open file '$file': $?\n");
	return undef;
    }

    # Open the file and read in the content from it
    my $content = '';
    while (<FILE>) {
	$content .= $_;
    }
    close(FILE);

    return $content;
}

=head2 update( $filename, $doc_id, $content[, $append] )

This routine alters a file within the repository without creating a new 
revision number to be generated.  This is not intended for regular use
but instead for adding comments, updating metadata, etc.

By default, update() replaces the existing file.  If $append is defined,
however, update() will append $content onto the end of the file (such as
for logs).  Note that no separation characters are inserted, so make sure
to add newlines and record delimiters if you need them.

Returns a true value if the file was successfully updated, or undef on 
any error.  Retrieve the error via get_error();

=cut
sub update {
    my $self = shift;
    my $filename = shift || return undef;
    my $doc_id = shift || return undef;
    my $content = shift;
    my $append = shift;

    if (! defined $content) {
	$self->_set_error("Undefined content not allowed\n");
	return undef;
    }

    my $doc_path = $self->repository_path($doc_id) || return undef;

    # Default $revision to current revision if not specified
    my $revision = $self->current_revision($doc_id, $doc_path);

    my $file = catfile($doc_path,
		       sprintf("%03d", $revision),
		       $filename);

    my $w = ($append)? ">>" : ">";
    if (! open(FILE, "$w $file")) {
	$self->_set_error("Could not open '$file' for writing:  $?\n");
	return undef;
    }
    print FILE $content;
    return close(FILE);    
}

# Recursively iterates through the document repository, running the
# given function '$func' against document ids it finds.
sub _iterate_doc_ids {
    my $self = shift;
    my $dir = shift;
    my $func = shift;
    my $prefix = shift || '';

    if (! opendir(DIR, $dir)) {
	$self->_set_error("Could not open directory '$dir': $!\n");
	return undef;
    }
    while (defined(my $subdir = readdir DIR)) {
	if ($subdir =~ /^\d+$/) {
	    # This is a document subdir, so we process
	    if (! &$func("$prefix$subdir")) {
		$self->_set_error("Error running function while iterating '$subdir'");
		return undef;
	    }
	} elsif ($subdir =~ /^[Mk](\d+)$/) {
	    # This is a thousands (k) or millions (M) dir, so it contains
	    # additional subdirs for documents within it.  We recurse into
	    # this directory and continue processing...
	    if (! $self->_iterate_doc_ids(catdir($dir,$subdir), $func, $1)) {
		$self->_set_error("Error descending into '$subdir'");
		return undef;
	    }
	}
    }
    close(DIR);