view release on metacpan or  search on metacpan

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

    my @renames;
    my $rename_sub;
    if (exists $opts{filename_conversion})
    {
        if (ref $opts{filename_conversion} and
            ref $opts{filename_conversion} eq 'CODE')
        {
            $rename_sub = $opts{filename_conversion};
        }
        else
        {
            @renames =
                ref $opts{filename_conversion} ? @{$opts{filename_conversion}} : $opts{filename_conversion};
            die "filename_conversion is not as long as files"
                unless scalar @files == scalar @renames;
        }
    }

    require File::stat;
    foreach my $f (@files)
    {
        my $fullname = $f;
        if ($opts{basedir})
        {
            $fullname = File::Spec->catfile($opts{basedir}, $fullname);
        }
        my $repositoryname = $f;
        if (@renames)
        {
            $repositoryname = shift @renames;
        }
        elsif ($rename_sub)
        {
            local $_ = $repositoryname;
            $rename_sub->();
            $repositoryname = $_;
        }

        if (-l $fullname)
        {
            $self->add_symlink(
                               tag => $opts{tag},
                               filename => $repositoryname,
                               target => readlink($fullname),
                              ) or return 0;
        }
        else
        {
            my $s = File::stat::stat($fullname);
            my $fh = IO::File->new($fullname, 'r') or do {
                warn "Can't open $fullname: $!";
                return 0;
            };
            binmode $fh;
            my %file_opts = (
                             filename => $repositoryname,
                             filehandle => $fh,
                             mode => $s->mode(),
                             owner => $s->uid(),
                             group => $s->gid(),
                            );
            $self->add_filehandle(tag => $opts{tag}, %file_opts) or return 0;
        }
        unlink($f) if $opts{move};
    }
    1;
}

=item add_filehandle

Adds a file to the repository.

Parameters:

=over 4

=item tag

Mandatory identifier for the group of files.  If the tag already exists,
any files will be added to the tag by default.

=item filehandle

You can pipe your data directly into
the repository.  This filehandle can be any perl-ish filehandle object:
a GLOB, an IO::Handle (including an IO::String), or anything else that works
like a file handle to be read from.  Note that perl can open from a string
reference in v5.8, so that is viable as well.

The filehandle will be read from, and the data written directly to the
repository, and should be done in a loop such that the entire file need
not be brought into memory.  For example, during an FTP transfer, the
filehandle will be read so that it can be put directly to the server.

The filename that is used is the C<filename> parameter.

Note that only one filehandle can be added at a time.

=item filename

The filename for the filehandle.  Again, this filename may include
subdirectories, but cannot be an absolute path nor include the updir
string.

=item mode

Attributes for the file.  Normally these would be read directly from the input
file, but cannot be read from a filehandle, so this will need to be provided.

=item owner

The UID for the owner of the file.  Note that without root authority,
this may fail.  Default is the file's owner, or the current user if the source
is a filehandle.

=item group

The GID for the owner of the file.  Note that without root authority,
this may fail.  Default is the file's owner, or the current group if the source
is a filehandle.