Skip to content
Snippets Groups Projects
Select Git revision
  • 202b133f03c785f725ac8414d59b45ce9c9414de
  • master default protected
  • diag
  • version1.3-archivematica
  • version1.2-archivematica
  • version1.1-archivematica
  • version1.0-archivematica
  • version1.0-rosetta
8 results

permanent.pm

Blame
  • permanent.pm 3.45 KiB
    package SLUB::LZA::TA::Command::permanent;
    use SLUB::LZA::TA -command;
    use v5.36;
    use SLUB::LZA::TA::Archivematica::Elasticsearch;
    use SLUB::LZA::TA::Output;
    use Archive::BagIt;
    use Date::Calc qw(Today);
    use File::Find;
    use namespace::autoclean;
    # VERSION
    
    # ABSTRACT: check permanent volumes via ta-tool
    
    sub abstract {return "check permanent storage of Archival Information System (AIS)";}
    
    my $description=<<"DESCR";
    Reports checks about AIS' permanent storage
    
    DESCR
    
    sub description {
        return "$description"
    }
    sub opt_spec {
        my @global_opts= SLUB::LZA::TA::common_global_opt_spec();
        my @local_opts = (
            [ 'output-format' => hidden => {
                one_of => [
                    [ 'output-as-csv|C' => 'prints output as Comma Separated Values (CSV)' ],
                    [ 'output-as-raw|R' => 'print raw hash output of elasticsearch response' ],
                    [ 'output-as-rsv|r' => 'prints output as Raw Strings Values (RSV)' ],
                    [ 'output-as-asciidoc|a' => 'prints output as human readable AsciiDoc (default)' ],
                ],
            }
            ],
        );
        return (@global_opts, [], @local_opts);
    }
    sub validate_args {
        my ($self, $opt, $args) = @_;
        SLUB::LZA::TA::common_global_validate($self, $opt, $args);
        # no args allowed but options!
        $self->usage_error("No args allowed") if @$args;
        if (!exists $opt->{output_format}) { $opt->{output_format} = 'output_as_asciidoc';}
        return 1;
    }
    
    sub execute {
        my ($self, $opt, $args) = @_;
    
        my @candidates;
        my $wanted = sub {
            my ($dev, $ino, $mode, $nlink, $uid, $gid);
            (($dev, $ino, $mode, $nlink, $uid, $gid) = lstat($_))
                and (-d _)
                and (-f "$_/bagit.txt")
                and ($File::Find::prune = 1)
                and push @candidates, $File::Find::name;
        };
        say STDERR "scanning volumes: ".join(" ", @{ $SLUB::LZA::TA::config{permanent_volume} });
        File::Find::find(
            {wanted => $wanted},
            @{ $SLUB::LZA::TA::config{permanent_volume} }
        );
        my @results = map {
            my $candidate = $_;
            my $bag = Archive::BagIt->new($candidate);
            # explicite SHA loading, because
            # Archivematica only use SHA512, but have version 0.97
            $bag->use_plugins('Archive::BagIt::Plugin::Algorithm::SHA512');