view release on metacpan or  search on metacpan

lib/App/GnuCash/MembershipUtils.pm  view on Meta::CPAN

            "The config has the following %s\n  * %s",
            ((scalar(@errors) == 1) ? "error" : "errors"),
            join("\n  * ", @errors),
        );
        return ($error, $config);
    }
    if ($debug) {
        printf STDERR "Before applying defaults\n%s\n", pp( $config );
    }

    ## Load defaults
    for my $key (keys %DEFAULT_CONFIG_VALUES) {
        ## Only load them if the current key is undefined
        $config->{GnuCash}{$key} //= $DEFAULT_CONFIG_VALUES{$key};    
    }
    
    if ($debug) {
        printf STDERR "After applying defaults\n%s\n", pp( $config );
    }

    return (undef, $config);
}

=head2 get_gnucash_filename($override, $config)

    my $filename = get_filename_from_config($override, $config);

Returns the C<GnuCash.file> from the given C<$config>.

=cut

sub get_gnucash_filename {
    my $override = shift // "";
    my $config   = shift // {};

    return $override if length($override);
    if (exists($config->{GnuCash})) {
        return $config->{GnuCash}{file} // "";
    }
    return "";
}

=head2 open_gnucash($filename)

    my ($error, $schema) = open_gnucash($filename);

Returns an C<$error> if the given C<$filename> cannot be opened.
If C<$error> is undef, then C<$schema> will be a C<GnuCash::Schema>
object.

=cut

sub open_gnucash {
    my $filename = shift // "";

    return ("filename '$filename' does not exist", undef) unless -f $filename;

    my $schema = GnuCash::Schema->connect(
        "dbi:SQLite:$filename",     # dsn
        undef,                      # user
        undef,                      # password
        {                           # dbi params
            sqlite_open_flags => DBD::SQLite::OPEN_READONLY,
        }
    );

    return (undef, $schema);
}

=head2 get_all_members($args)

    my @members = get_all_members($args);


Accepts a HASHREF of C<$args> whose keys are as follows:

=over

=item config

=item schema

=item active_only

=back

Returns an ARRAY of HASHREFs whose keys are as follows:

=over

=item name

=item id

=item notes

=item active

=item membership_type

=item membership_account

=item membership_amount

=back

=cut

sub get_all_members {
    my $args = shift;

    my $active_only = delete $args->{active_only};
    my $schema      = delete $args->{schema};
    my $config      = delete $args->{config};
    my $debug       = delete $args->{debug} // 0;
    if (my @unused = sort(keys(%$args))) {
        carp(
            sprintf(
                "WARNING: The following unused %s provided: '%s'",
                (scalar(@unused) == 1 ? "parameter was" : "parameters were"),
                join("', '", @unused),