view release on metacpan or  search on metacpan

lib/File/Information.pm  view on Meta::CPAN

sub digest_info {
    my ($self, @algos) = @_;
    my @ret;

    if (scalar(@algos) == 1 && $algos[0] =~ /^v0m / && wantarray) {
        while ($algos[-1] =~ s#^v0m (\S+) bytes [0-9]+-[0-9]*/(?:[0-9]+|\*) [0-9a-f\.]+ ##) {
            unshift(@algos, $1);
        }
    }

    unless ($self->{hash_info}) {
        my %hashes = map {$_ => {
                name => $_,
                bits => int(($_ =~ /-([0-9]+)$/)[0]),
                aliases => [],
                %{$File::Information::Base::_digest_info_extra{$_}//{}},
            }} (
            values(%File::Information::Base::_digest_name_converter),
            qw(md-4-128 ripemd-1-160 tiger-1-192 tiger-2-192),
        );
        $self->{hash_info} = \%hashes;

        $hashes{$_}{unsafe} = 1 foreach qw(md-4-128 md-5-128 sha-1-160);
        push(@{$hashes{$File::Information::Base::_digest_name_converter{$_}}{aliases}}, $_) foreach keys %File::Information::Base::_digest_name_converter;
    }

    @algos = keys %{$self->{hash_info}} unless scalar @algos;

    croak 'Request for more than one hash in scalar context' if !wantarray && scalar(@algos) != 1;

    @ret = map{
        $self->{hash_info}{$_} ||
        $self->{hash_info}{$File::Information::Base::_digest_name_converter{fc($_)} // ''} ||
        croak 'Unknown digest: '.$_
    } map { s#^v0 (\S+) bytes [0-9]+-[0-9]*/(?:[0-9]+|\*) [0-9a-f\.]+$#$1#r } @algos;

    if (wantarray) {
        return @ret;
    } else {
        return $ret[0];
    }
}

# ----------------

sub _home {
    my ($self) = @_;
    my $home;

    return $self->{home} if defined $self->{home};

    if ($^O eq 'MSWin32') {
        return $self->{home} = $home if defined($home = $ENV{USERPROFILE}) && length($home);
        if (defined($ENV{HOMEDRIVE}) && defined($ENV{HOMEPATH})) {
            $home = $ENV{HOMEDRIVE}.$ENV{HOMEPATH};
            return $self->{home} = $home if length($home);
        }
        return $self->{home} = 'C:\\';
    } else {
        return $self->{home} = $home if defined($home = $ENV{HOME}) && length($home);
        return $self->{home} = $home if defined($home = eval { [getpwuid($>)]->[7] }) && length($home);
        return $self->{home} = File::Spec->rootdir;
    }

    croak 'BUG';
}

sub _path {
    my ($self, $xdg, $type, @el) = @_;
    my $base;

    if (defined $xdg) {
        $base = $ENV{$xdg} // $self->{$xdg};
        if (!defined($base) || !length($base)) {
            if ($xdg eq 'XDG_CACHE_HOME') {
                $base = File::Spec->catdir($self->_home, qw(.cache));
            } elsif ($xdg eq 'XDG_DATA_HOME') {
                $base = File::Spec->catdir($self->_home, qw(.local share));
            } elsif ($xdg eq 'XDG_CONFIG_HOME') {
                $base = File::Spec->catdir($self->_home, qw(.config));
            } elsif ($xdg eq 'XDG_STATE_HOME') {
                $base = File::Spec->catdir($self->_home, qw(.local state));
            } else {
                croak 'Unknown XDG path: '.$xdg;
            }

            $self->{$xdg} = $base;
        }
    } else {
        $base = $self->_home;
    }

    if ($type eq 'file') {
        return File::Spec->catfile($base, @el);
    } else {
        return File::Spec->catdir($base, @el);
    }
}

sub _tagpool_locate {
    my ($self) = @_;
    my %candidates;

    return unless $HAVE_FILE_VALUEFILE;

    unless (defined $self->{tagpool_rc}) {
        # Set defaults:
        $self->{tagpool_rc} = ['/etc/tagpoolrc', $self->_path(undef, file => '.tagpoolrc')]; # Values taken from tagpool as is. Should be updated.
    }

    unless (defined $self->{tagpool_path}) {
        # Set defaults:
        $self->{tagpool_path} = []; # none at this point.
    }

    $self->{tagpool_rc} = [$self->{tagpool_rc}] unless ref $self->{tagpool_rc};
    $self->{tagpool_path} = [$self->{tagpool_path}] unless ref $self->{tagpool_path};

    %candidates = map {$_ => undef} grep {defined} @{$self->{tagpool_path}};

    foreach my $tagpool_rc_path (@{$self->{tagpool_rc}}) {