From 75808db17caf8b960b351e3408e74142f4c85aac Mon Sep 17 00:00:00 2001 From: Daniel Baumann Date: Sun, 14 Apr 2024 15:42:30 +0200 Subject: Adding upstream version 2.117.0. Signed-off-by: Daniel Baumann --- lib/Lintian/Storage/MLDBM.pm | 128 +++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 128 insertions(+) create mode 100644 lib/Lintian/Storage/MLDBM.pm (limited to 'lib/Lintian/Storage') diff --git a/lib/Lintian/Storage/MLDBM.pm b/lib/Lintian/Storage/MLDBM.pm new file mode 100644 index 0000000..f58cb8c --- /dev/null +++ b/lib/Lintian/Storage/MLDBM.pm @@ -0,0 +1,128 @@ +# -*- perl -*- Lintian::Storage::MLDBM +# +# Copyright (C) 2022 Felix Lechner +# +# This program is free software; you can redistribute it and/or modify it +# under the terms of the GNU General Public License as published by the Free +# Software Foundation; either version 2 of the License, or (at your option) +# any later version. +# +# This program is distributed in the hope that it will be useful, but WITHOUT +# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +# FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for +# more details. +# +# You should have received a copy of the GNU General Public License along with +# this program. If not, see . + +package Lintian::Storage::MLDBM; + +use v5.20; +use warnings; +use utf8; + +use BerkeleyDB; +use Const::Fast; +use MLDBM qw(BerkeleyDB::Btree Storable); +use Path::Tiny; +use Syntax::Keyword::Try; +use Unicode::UTF8 qw(encode_utf8 decode_utf8); + +const my $EMPTY => q{}; +const my $HYPHEN => q{-}; + +use Moo; +use namespace::clean; + +=head1 NAME + +Lintian::Storage::MLDBM - store multi-level hashes on disk + +=head1 SYNOPSIS + + use Lintian::Storage::MLDBM; + +=head1 DESCRIPTION + +Lintian::Storage::MLDBM provides an interface to store data on disk to preserve memory. + +=head1 INSTANCE METHODS + +=over 4 + +=item tempfile + +=item tied_hash + +=cut + +has tempfile => (is => 'rw'); +has tied_hash => (is => 'rw', default => sub { {} }); + +=item create + +=cut + +sub create { + my ($self, $description) = @_; + + $description //= $EMPTY; + + $description .= $HYPHEN + if length $description; + + my $stem = "mldbm-$description"; + + my $tempfile + = Path::Tiny->tempfile(TEMPLATE => $stem . 'XXXXXXXX', UNLINK => 0); + $self->tempfile($tempfile); + + try { + tie( + %{$self->tied_hash}, 'MLDBM', + -Filename => $tempfile->stringify, + -Flags => DB_CREATE + ); + + } catch { + die encode_utf8("Cannot create database in $tempfile: $@"); + }; + + return; +} + +=item DEMOLISH + +=cut + +sub DEMOLISH { + my ($self, $in_global_destruction) = @_; + + untie %{$self->tied_hash}; + + $self->tempfile->remove + if defined $self->tempfile; + + return; +} + +=back + +=head1 AUTHOR + +Originally written by Felix Lechner for +Lintian. + +=head1 SEE ALSO + +lintian(1) + +=cut + +1; + +# Local Variables: +# indent-tabs-mode: nil +# cperl-indent-level: 4 +# End: +# vim: syntax=perl sw=4 sts=4 sr et -- cgit v1.2.3