view release on metacpan or  search on metacpan

bin/gc-members-list  view on Meta::CPAN

  ## See if there were any unknown parameters on the command line
  if (@ARGV && !$allow_extra_args)
  {
    display_usage_and_exit("\n\nERROR: Invalid "
        . (scalar(@ARGV) > 1 ? "arguments" : "argument") . ":\n  "
        . join("\n  ", @ARGV)
        . "\n\n");
  }

  return ($TRUE);
}

##----------------------------------------------------------------------------
##     @fn display_usage_and_exit($message, $filenameexitval)
##  @brief Display the usage with the given message and exit with the given
##         value
##  @param $message - Message to display. DEFAULT: ""
##  @param $exitval - Exit vaule DEFAULT: 1
## @return NONE
##   @note
##----------------------------------------------------------------------------
sub display_usage_and_exit
{
  my $message = shift // qq{};
  my $exitval = shift // 1;

  pod2usage(
    -input   => \*DATA,
    -message => $message,
    -exitval => $exitval,
    -verbose => 1,
  );

  return;
}

##----------------------------------------------------------------------------
## MAIN
##----------------------------------------------------------------------------
## Set STDOUT to autoflush
$| = 1;    ## no critic (RequireLocalizedPunctuationVars)

## Parse the command line
process_commandline();

my ($error, $config) = get_config($gOptions{config});

if ($error) {
  printf STDERR "Error getting config: %s\n", $error;
  exit(1);
}

my $schema;
($error, $schema) = open_gnucash(get_gnucash_filename($gOptions{file}, $config));
if ($error) {
  printf STDERR "Error opening GnuCahs file: %s\n", $error;
  exit(1);
}

my $warning;
($error, $warning) = validate_accounts_in_config({
  schema => $schema,
  config => $config,
});
say STDERR $warning if ($warning);
if ($error) {
  say STDERR $error;
  exit(1);
}


my @members = get_all_members({
  active_only => !$gOptions{all},
  schema      => $schema,
  config      => $config,
  debug       => $gOptions{debug},
});

if ($gOptions{debug}) {
  say pp(\@members);
}

my @columns = qw( name );
push(@columns, qw( active )) if ($gOptions{all});
push(@columns, qw( membership_type membership_amount));

my @widths;
for my $column (@columns) {
  say "Assembling values for the '$column' field..." if ($gOptions{debug});
  my @values = ( 
    map { $_->{$column} } @members
  );
  push(@values, $column);

  say pp(\@values) if ($gOptions{debug});

  push(@widths, max_length(@values));
}

my $header = "",
my $uline  = "";
for my $idx (0 .. $#columns) {
  $header .= sprintf("%*s  ", -1 * $widths[$idx], title_case($columns[$idx]));
  $uline  .= ("-" x $widths[$idx]) . "  ";
}
say $header;
say $uline;

for my $member (@members) {
  my $line = "";
  for my $idx (0 .. $#columns) {
    $line .= sprintf("%*s  ", -1 * $widths[$idx], $member->{$columns[$idx]});
  }
  say $line;
}

exit(0);

__END__

__DATA__