view release on metacpan or  search on metacpan

lib/Archive/BagIt.pm  view on Meta::CPAN

    my $rel_path = File::Spec->abs2rel( $self->payload_path, $self->bag_path ) ;
    return $rel_path;
}

sub _build_metadata_path_arr {
    my ($self) = @_;
    my @split_path = File::Spec->splitdir($self->metadata_path);
    return @split_path;
}

sub _build_rel_metadata_path {
    my ($self) = @_;
    my $rel_path = File::Spec->abs2rel( $self->metadata_path, $self->bag_path ) ;
    return $rel_path;
}

sub _build_checksum_algos {
    my($self) = @_;
    my @checksums = keys %{ $self->manifests() };
    return \@checksums;
}

sub _build_manifest_files {
    my($self) = @_;
    my @manifest_files;
    foreach my $algo (@{$self->checksum_algos}) {
        my $manifest_file = File::Spec->catfile($self->metadata_path, "manifest-$algo.txt");
        if (-f $manifest_file) {
            push @manifest_files, $manifest_file;
        }
    }
    return \@manifest_files;
}

sub _build_tagmanifest_files {
    my ($self) = @_;
    my @tagmanifest_files;
    foreach my $algo (@{$self->checksum_algos}) {
        my $tagmanifest_file = File::Spec->catfile($self->metadata_path,"tagmanifest-$algo.txt");
        if (-f $tagmanifest_file) {
            push @tagmanifest_files, $tagmanifest_file;
        }
    }
    return \@tagmanifest_files;
}

sub __handle_nonportable_local_entry {
    my $self = shift;
    my $local_entry = shift;
    my $dir = shift;
    if ($local_entry !~ m/^[a-zA-Z0-9._-]+$/) {
        my $local_entry_utf8 = decode("UTF-8", $local_entry);
        if ((!$self->has_force_utf8)) {
            my $hexdump = "0x" . unpack('H*', $local_entry);
            $local_entry =~m/[^a-zA-Z0-9._-]/; # to find PREMATCH, needed nextline
            ## no critic (Variables::ProhibitMatchVars)
            # the slowdown using prematch is accepatable, because only triggered in failure path
            my $prematch_position = $`;
            carp "possible non portable pathname detected in $dir,\n",
                "got path (hexdump)='$hexdump'(hex),\n",
                "decoded path='$local_entry_utf8'\n",
                "              "." "x length($prematch_position)."^"."------- first non portable char\n";
        }
        $local_entry = $local_entry_utf8;
    }
    return $local_entry;
}


# own implementation, because File::Find has problems with UTF8 encoded Paths under MSWin32
# finds recursively all files in given directory.
# if $excludedir is defined, the content will be excluded
sub __file_find { ## no critic (CognitiveComplexity::ProhibitExcessCognitiveComplexity)
    my ($self,$dir, $excludedir) = @_;
    if (defined $excludedir) {
        $excludedir = File::Spec->rel2abs( $excludedir);
    }
    my @file_paths;
    my $finder;
    $finder = sub {
        my ($current_dir) = @_; #absolute path
        my @todo;
        my @tmp_file_paths;
        opendir( my $dh, $current_dir);
        my @paths = File::Spec->no_upwards ( readdir $dh );
        closedir $dh;
        foreach my $local_entry (@paths) {
            my $path_entry = File::Spec->catdir($current_dir, $self->__handle_nonportable_local_entry($local_entry, $dir));
            if ((defined $excludedir) && ($path_entry eq $excludedir)) {
                # ignore it, because excluded
            } elsif (-f $path_entry) {
                push @tmp_file_paths, $path_entry;
            } elsif (-d $path_entry) {
                push @todo, $path_entry;
            } else {
                croak "not a file nor a dir found '$path_entry'";
            }
        }
        push @file_paths, sort @tmp_file_paths;
        foreach my $subdir (sort @todo) {
            &$finder($subdir);
        }
    };
    my $absolute = File::Spec->rel2abs( $dir );
    &$finder($absolute);
    @file_paths = map { File::Spec->abs2rel( $_, $dir)} @file_paths;
    return @file_paths;
}

sub _build_payload_files{
    my ($self) = @_;
    my $payload_dir = $self->payload_path;
    my $reldir = File::Spec->abs2rel($payload_dir, $self->bag_path());
    $reldir =~ s/^\.$//;
    my @payload = map {
        $reldir eq "" ? $_ : File::Spec->catfile($reldir, $_)
    } $self->__file_find($payload_dir, File::Spec->rel2abs($self->metadata_path));
    return wantarray ? @payload : \@payload;
}