Group
Extension

Couch-DB/lib/Couch/DB/Util.pm

# Copyrights 2024-2025 by [Mark Overmeer].
#  For other contributors see ChangeLog.
# See the manual pages for details on the licensing terms.
# Pod stripped from pm file by OODoc 2.03.
# SPDX-FileCopyrightText: 2024 Mark Overmeer <mark@overmeer.net>
# SPDX-License-Identifier: Artistic-2.0

package Couch::DB::Util;{
our $VERSION = '0.200';
}

use parent 'Exporter';

use warnings;
use strict;

use Log::Report 'couch-db';
use Data::Dumper ();
use Scalar::Util qw(blessed);

our @EXPORT_OK   = qw/flat pile apply_tree simplified/;
our %EXPORT_TAGS = ( all => \@EXPORT_OK );

sub import
{	my $class  = shift;
	$_->import for qw(strict warnings utf8 version);
	$class->export_to_level(1, undef, @_);
}


sub flat(@) { grep defined, map +(ref eq 'ARRAY' ? @$_ : $_), @_ }


sub pile(@) { +[ flat @_ ] }


#XXX why can't I find a CPAN module which does this?

sub apply_tree($$);
sub apply_tree($$)
{	my ($tree, $code) = @_;
	    ! ref $tree          ? $code->($tree)
	  : ref $tree eq 'ARRAY' ? +[ map apply_tree($_, $code), @$tree ]
	  : ref $tree eq 'HASH'  ? +{ map +($_ => apply_tree($tree->{$_}, $code)), keys %$tree }
	  : ref $tree eq 'CODE'  ? "$tree"
	  :                        $code->($tree);
}


sub simplified($$)
{	my ($name, $data) = @_;

	my $v = apply_tree $data, sub ($) {
		my $e = shift;
		    ! blessed $e         ? $e
		  : $e->isa('DateTime')  ? "DATETIME($e)"
		  : $e->isa('Couch::DB::Document') ? 'DOCUMENT('.$e->id.')'
		  : $e->isa('JSON::PP::Boolean')   ? ($e ? 'BOOL(true)' : 'BOOL(false)')
		  : $e->isa('version')   ? "VERSION($e)"
		  : 'OBJECT('.(ref $e).')';
	};

	Data::Dumper->new([$v], [$name])->Indent(1) ->Quotekeys(0)->Sortkeys(1)->Dump;
}

1;


Powered by Groonga
Maintained by Kenichi Ishigaki <ishigaki@cpan.org>. If you find anything, submit it on GitHub.