#!/usr/bin/perl use strict; use warnings; use v5.10; use Scalar::Util qw(blessed looks_like_number); use File::Information; # Check which types we, only request data for installed modules. my @as_types = qw(bool mediatype raw); unshift(@as_types, 'DateTime') if eval { require DateTime; 1 }; unshift(@as_types, 'Data::Identifier') if eval { require Data::Identifier; 1 }; my $instance; { my %settings; while (scalar(@ARGV) && $ARGV[0] =~ /^--./) { my $opt = shift(@ARGV); if ($opt eq '--database' && scalar(@ARGV)) { my $dsn = shift(@ARGV); require Data::TagDB; $settings{db} = Data::TagDB->new($dsn); unshift(@as_types, 'Data::TagDB::Tag'); } else { die 'Invalid option: '.$opt; } } $instance = File::Information->new(%settings); } shift(@ARGV) if scalar(@ARGV) && $ARGV[0] eq '--'; foreach my $filename (@ARGV) { my $link = $instance->for_link(path => $filename, symlinks => 'follow'); say $filename; say '-' x length($filename); eval {$link->deep}; dump_base($link); dump_base(scalar eval {$link->inode}); dump_base(scalar eval {$link->deep}); dump_base(scalar eval {$link->filesystem}); dump_base($_) foreach eval {$link->tagpool}; } sub dump_base { my ($base) = @_; my File::Information $instance; my @hashes; my @properties; my $max_len = 0; my %verify_a_b; return unless defined $base; $instance = $base->instance; @hashes = sort map {$_->{name}} $base->digest_info; @properties = sort map {$_->{name}} $base->property_info; { my $title = ref($base) =~ s/^.*:://r; say ' ', $title; say ' ', '-' x length($title); } { # Figure out the witdh of the key column. outer: foreach my $key (@properties) { foreach my $lifecycle ($instance->lifecycles) { my @values = $base->get($key, lifecycle => $lifecycle, list => 1, default => [], as => 'raw'); if (scalar @values) { my $l = length($key); $max_len = $l if $l > $max_len; next outer; } } } outer: foreach my $algo (@hashes) { my $key = sprintf('digest <%s> unsafe', $algo); foreach my $lifecycle ($instance->lifecycles) { my $value = $base->digest($algo, lifecycle => $lifecycle, default => undef); if (defined $value) { my $l = length($key); $max_len = $l if $l > $max_len; next outer; } } } } # Print properties: foreach my $key (@properties) { foreach my $lifecycle ($instance->lifecycles) { my $first = 1; my @values; my $type; foreach my $as (@as_types) { @values = $base->get($key, lifecycle => $lifecycle, list => 1, default => [], as => $as); $type = $as; last if scalar @values; } next unless scalar @values; foreach my $value (@values) { if (blessed($value)) { if ($value->isa('Data::Identifier')) { my $id = $value; $value = sprintf('%s / %s', $id->type->displayname, $id->id); if (defined(my $displayname = $id->displayname(no_defaults => 1, default => undef))) { $value .= sprintf(' (%s)', $displayname); } } elsif ($value->isa('Data::TagDB::Tag')) { my $tag = $value; $value = sprintf('Tag <%s>', $tag->ise); if (defined(my $displayname = $tag->displayname(no_defaults => 1, default => undef))) { $value .= sprintf(' (%s)', $displayname); } } elsif ($value->isa('Data::URIID::Barcode')) { $value = sprintf('Barcode <%s>', $value->data); } } elsif ($type eq 'bool') { $value = $value ? 'true' : 'false'; } elsif (looks_like_number($value)) { # no-op } else { $value = sprintf('\'%s\'', $value); } if ($first) { printf(" %7s :: %-*s = %s\n", $lifecycle, $max_len, $key, $value); $first = undef; } else { printf("%s & %s\n", ' ' x ($max_len + 7 + 6), $value); } } } } # Print digests: foreach my $algo (@hashes) { my $key = sprintf('digest <%s>', $algo); $key .= ' unsafe' if $instance->digest_info($algo)->{unsafe}; foreach my $lifecycle ($instance->lifecycles) { my $value = $base->digest($algo, lifecycle => $lifecycle, default => undef); next unless defined $value; printf(" %7s :: %-*s = %s\n", $lifecycle, $max_len, $key, $value); } } foreach my $lifecycle_from ($instance->lifecycles) { foreach my $lifecycle_to ($instance->lifecycles) { my $verify_key = join('::', sort ($lifecycle_from, $lifecycle_to)); next if $verify_a_b{$verify_key}; $verify_a_b{$verify_key} = 1; if ($lifecycle_from ne $lifecycle_to) { my $result = $base->verify(lifecycle_from => $lifecycle_from, lifecycle_to => $lifecycle_to); unless ($result->has_no_data) { my $displaykey = sprintf('%7s :: verify', $lifecycle_to); printf(" %7s :: %-*s = %s\n", $lifecycle_from, $max_len, $displaykey, $result->status); } } } } } #ll