App-orgadb
view release on metacpan or search on metacpan
lib/App/orgadb.pm view on Meta::CPAN
$re_field = $args{field_match_mode} =~ /-ci/ ? qr/^$re_field$/i : qr/^$re_field$/;
} elsif (ref $field_term eq 'Regexp') {
$re_field = $field_term;
} else {
$re_field = quotemeta($field_term);
$re_field = qr/$re_field/i;
}
$expr_field .= " =~ " . Data::Dmp::dmp($re_field) . "]";
push @re_field, $re_field;
}
log_trace "CSel expression for selecting fields: <$expr_field>";
}
@matching_fields = Data::CSel::csel({
class_prefixes => ["Org::Element"],
}, $expr_field, $entry);
log_trace "Number of matching fields for entry #$i: %d", scalar(@matching_fields);
if ($args{num_fields} && @matching_fields > $args{num_fields}) {
splice @matching_fields, $args{num_fields};
}
next ENTRY unless @matching_fields;
}
unless ($args{hide_entry}) {
$res->[2] .= "** ";
unless ($args{hide_category}) {
$res->[2] .= _highlight(
$clrtheme_obj,
$re_category,
$entry->parent->title->as_string) . "/";
}
$res->[2] .= _highlight(
$clrtheme_obj,
$re_entry,
$entry->title->as_string,
);
$res->[2] .= "\n";
}
my $re_field;
$re_field = join "|", @re_field if @re_field;
if ($args{detail}) {
my $str = $entry->children_as_string;
$str = _highlight(
$clrtheme_obj,
$re_field,
$str) if defined $re_field;
$res->[2] .= $str;
} elsif (@matching_fields) {
for my $field (@matching_fields) {
my $field_name0 = $field->desc_term->text;
unless ($args{hide_field_name}) {
my $field_name = '';
$field_name = _highlight(
$clrtheme_obj,
$re_field,
$field->bullet . ' ' . $field_name0,
) . " ::";
unless ($args{clipboard} && $args{clipboard} eq 'only') {
$res->[2] .= $field_name;
}
}
my $field_value_formatter_from_rules;
my $field_value_formatter_filters_from_rules;
SET_FIELD_VALUE_FORMATTERS_FROM_RULES:
{
last if $args{no_field_value_formatters};
last if $field_value_formatter_from_args;
last unless $args{field_value_formatter_rules} && @{ $args{field_value_formatter_rules} };
$field_value_formatter_filters_from_rules = [];
my $field_value_formatters_from_rules = [];
unless (@parsed_field_value_formatter_rules) {
my $i = -1;
for my $r0 (@{ $args{field_value_formatter_rules} }) {
$i++;
my $r;
if (!ref($r0) && $r0 =~ /\A\{/) {
require JSON::PP;
$r = JSON::PP::decode_json($r0);
} else {
$r = {%$r0};
}
# precompile regexes
require Regexp::From::String;
if (defined $r->{field_name_matches}) {
$r->{field_name_matches} = Regexp::From::String::str_to_re({case_insensitive=>1}, $r->{field_name_matches});
}
if ($r->{formatters} && @{ $r->{formatters} }) {
my @filter_names;
for my $f (@{ $r->{formatters} }) {
if ($f =~ /\A\[/) {
require JSON::PP;
$f = JSON::PP::decode_json($f);
} else {
if ($f =~ /(.+)=(.*)/) {
my ($modname, $args) = ($1, $2);
# normalize / to :: in the module name part
$modname =~ s!/!::!g;
$f = [$modname, { split /,/, $args }];
} else {
# normalize / to ::
$f =~ s!/!::!g;
}
}
push @filter_names, $f;
}
require Data::Sah::Filter;
$r->{formatter} = Data::Sah::Filter::gen_filter(
filter_names => \@filter_names,
return_type => 'str_errmsg+val',
);
push @{ $field_value_formatter_filters_from_rules }, \@filter_names;
} else {
die "Field value formatting rules [$i] does not have non-empty formatters: %s", $r;
}
lib/App/orgadb.pm view on Meta::CPAN
# do the filtering
my $i = -1;
RULE:
for my $r (@parsed_field_value_formatter_rules) {
$i++;
my $matches = 1;
if (defined $r->{field_name_matches}) {
$field_name0 =~ $r->{field_name_matches} or do {
$matches = 0;
log_trace "Skipping field_value_formatter_rules[%d]: field_name_matches %s doesn't match %s", $i, $r->{field_name_matches}, $field_name0;
next RULE;
};
}
if (defined $r->{hide_field_name}) {
if ($args{hide_field_name} xor $r->{hide_field_name}) {
$matches = 0;
log_trace "Skipping field_value_formatter_rules[%d]: hide_field_name condition (%s) doesn't match actual hide_field_name option (%s)", $i, ($r->{hide_field_name} ? 'true':'false'), ($args{hide_field_name} ? 'true':...
next RULE;
}
}
log_trace "Adding field value formatters from field_value_formatter_rules[%d] (%s) for field name %s", $i, $r->{formatters}, $field_name0;
push @$field_value_formatters_from_rules, $r->{formatter};
}
# combine default formatters
last unless @$field_value_formatters_from_rules;
if (@$field_value_formatters_from_rules > 1) {
$field_value_formatter_from_rules = sub {
my $val = shift;
my $res;
for my $i (0 .. $#{$field_value_formatters_from_rules}) {
$res = $field_value_formatters_from_rules->[$i]->($val);
return $res if $res->[0];
$val = $res->[1];
}
$res;
};
} else {
$field_value_formatter_from_rules = $field_value_formatters_from_rules->[0];
}
} # SET_FIELD_VALUE_FORMATTERS_FROM_RULES
my $field_value0 = $field->children_as_string;
my ($prefix, $field_value, $suffix) = $field_value0 =~ /\A(\s+)(.*?)(\s*)\z/s;
my ($field_value_formatter, $field_value_formatter_filters);
if ($field_value_formatter_from_args) {
$field_value_formatter = $field_value_formatter_from_args;
$field_value_formatter_filters = $field_value_formatter_filters_from_args;
} elsif ($field_value_formatter_from_rules) {
$field_value_formatter = $field_value_formatter_from_rules;
$field_value_formatter_filters = $field_value_formatter_filters_from_rules;
}
if ($field_value_formatter) {
my ($ferr, $fres) = @{ $field_value_formatter->($field_value) };
if ($ferr) {
log_warn "Field value formatting error: formatter=%s, field value=%s, errmsg=%s", $field_value_formatter_filters, $field_value, $ferr;
$field_value = "$field_value # CAN'T FORMAT: $ferr";
} else {
$field_value = $fres;
}
}
unless ($args{clipboard} && $args{clipboard} eq 'only') {
$res->[2] .= ($args{hide_field_name} ? "" : $prefix) . $field_value . $suffix;
}
push @outputted_field_values, $field_value;
}
}
}
}
COPY_TO_CLIPBOARD: {
last unless $args{clipboard};
last unless @outputted_field_values;
require Clipboard::Any;
log_info "Copying matching field values to clipboard ...";
my $res = Clipboard::Any::add_clipboard_content(content => join "\n", @outputted_field_values);
if ($res->[0] != 200) {
log_warn "Cannot copy to clipboard: $res->[0] - $res->[1]";
last;
}
}
$res;
}
sub _select_shell {
my %args = @_;
require App::orgadb::Select::Shell;
my $shell = App::orgadb::Select::Shell->new(
main_args => \%args,
);
$shell->cmdloop;
[200];
}
$SPEC{select} = {
v => 1.1,
summary => 'Select Org addressbook entries/fields/subfields',
args => {
%App::orgadb::Common::argspecs_common,
%App::orgadb::Common::argspecs_select,
},
'x.envs' => {
'ORGADB_COLOR_THEME' => {
summary => 'Set default color theme',
schema => 'perl::colortheme::modname_with_optional_args*',
description => <<'MARKDOWN',
Color theme is Perl module name under the `ColorTheme::Search::` namespace,
without the namespace prefix. The default is `Light`. You can set color theme
using the `--color-theme` command-line option as well as this environment
variable.
MARKDOWN
},
},
};
sub select {
my %args = @_;
return [400, "Please specify at least one file"] unless @{ $args{files} || [] };
my $code_parse_files = sub {
my @filenames = @_;
my @trees;
my @tree_filenames;
require Org::Parser;
my $parser = Org::Parser->new;
for my $filename (@filenames) {
my $doc;
if ($filename eq '-') {
binmode STDIN, ":encoding(utf8)";
$doc = $parser->parse(join "", <>);
lib/App/orgadb.pm view on Meta::CPAN
} else {
my ($trees, $tree_filenames) = $code_parse_files->(@{ $args{files} });
_select_single(
%args,
_trees => $trees,
_tree_filenames => $tree_filenames,
);
}
}
1;
# ABSTRACT: An opinionated Org addressbook toolset
__END__
=pod
=encoding UTF-8
=head1 NAME
App::orgadb - An opinionated Org addressbook toolset
=head1 VERSION
This document describes version 0.020 of App::orgadb (from Perl distribution App-orgadb), released on 2025-06-19.
=head1 SYNOPSIS
=head1 DESCRIPTION
This distribution includes the following CLI's:
=over
=item * L<orgadb-sel>
=back
=head1 FUNCTIONS
=head2 select
Usage:
select(%args) -> [$status_code, $reason, $payload, \%result_meta]
Select Org addressbook entriesE<sol>fieldsE<sol>subfields.
This function is not exported.
Arguments ('*' denotes required arguments):
=over 4
=item * B<category> => I<str_or_re>
Find entry by string or regex search against the category title.
=item * B<clipboard> => I<str>
Whether to copy matching field values to clipboard.
If set to C<tee>, then will display matching fields to terminal as well as copy
matching field values to clipboard.
If set to C<only>, then will not display matching fields to terminal and will
only copy matching field values to clipboard.
Mnemonic for short option C<-y> and C<-Y>: I<y>ank as in Emacs (C<C-y>).
=item * B<color> => I<str> (default: "auto")
Whether to use color.
=item * B<color_theme> => I<perl::colortheme::modname_with_optional_args>
(No description)
=item * B<count> => I<true>
Return just the number of matching entries instead of showing them.
=item * B<detail> => I<bool>
Instead of showing matching field values, display the whole entry.
Mnemonic for shortcut option C<-l>: the option C<-l> is usually used for the short
version of C<--detail>, as in I<ls> Unix command.
=item * B<entry> => I<str_or_re>
Find entry by string or regex search against its title.
=item * B<entry_match_mode> => I<str> (default: "default")
How entry should be matched.
The default matching mode is as follow:
str Substring matching
/re/ Regular expression matching
If matching mode is set to C<exact>, then matching will be done by string
equality test. This mode is basically a shorter alternative to having to
specify:
/^\Qre\E$/
Matching mode C<exact-ci> is like C<exact> except case-insensitive. It is
equivalent to:
/^\Qre\E$/i
=item * B<field_match_mode> => I<str> (default: "default")
How entry should be matched.
The default matching mode is as follow:
str Substring matching
/re/ Regular expression matching
If matching mode is set to C<exact>, then matching will be done by string
equality test. This mode is basically a shorter alternative to having to
specify:
/^\Qre\E$/
( run in 1.672 second using v1.01-cache-2.11-cpan-df04353d9ac )