The London Perl and Raku Workshop takes place on 26th Oct 2024. If your company depends on Perl, please consider sponsoring and/or attending.
#!/usr/bin/perl -w

use lib qw(. lib dclib);
use DiaColloDB;
use Getopt::Long qw(:config no_ignore_case);
use Pod::Usage;
use File::Basename qw(basename);
use strict;

##----------------------------------------------------------------------
## Globals
##----------------------------------------------------------------------

##-- program vars
our $prog       = basename($0);
our $verbose    = 1;
our ($help,$version);


our %log   = (level=>'TRACE', rootLevel=>'FATAL');
our $file  = undef;
our $class = undef;
our %opts  = qw();

our $outfile = '-';

##----------------------------------------------------------------------
## Command-line processing
##----------------------------------------------------------------------
GetOptions(##-- general
	   'help|h' => \$help,
	   'version|V' => \$version,
	   'verbose|v=i' => \$verbose,

	   ##-- I/O options
	   'class|c=s' => \$class,
	   'option|opt|O=s' => \%opts,
	   'output|out|o=s' => \$outfile,

	   ##-- general
	   'log-level|level|ll=s' => sub { $log{level} = uc($_[1]); },
	  );

pod2usage({-exitval=>0,-verbose=>0}) if ($help);
pod2usage({-exitval=>0,-verbose=>0,-msg=>"No input file(s) specified"}) if (!@ARGV);

if ($version || $verbose >= 2) {
  print STDERR "$prog version $DiaColloDB::VERSION by Bryan Jurish\n";
  exit 0 if ($version);
}


##----------------------------------------------------------------------
## MAIN
##----------------------------------------------------------------------

##-- setup logger
DiaColloDB::Logger->ensureLog();

##-- input file
my $infile = shift(@ARGV);
if (!$class && -f "$infile.hdr") {
  ##-- no class specified; try to read header
  my $hdr = DiaColloDB::Utils::loadJsonFile("$infile.hdr");
  $class = $hdr->{class};
}
die("$0: no -class specified and not found in header") if (!$class);

##-- sanitize class
$class = "DiaColloDB::$class" if ($class !~ /^DiaColloDB::/ && !UNIVERSAL::can($class,'new'));
die("$0: no 'new' method for class '$class'") if (!UNIVERSAL::can($class,'new'));

##-- load object
my $obj = $class->new(%opts)
  or die("$0: could not create object of class '$class' for '$infile': $!");
$obj->open($infile)
  or die("$0: could not open '$infile' via object of class '$class': $!");

##-- dump
$obj->info("saving object to '$outfile'");
$obj->saveTextFile($outfile)
  or die("$0: saveTextFile() failed for object of class '$class' from '$infile': $!");


__END__

###############################################################
## pods
###############################################################

=pod

=head1 NAME

dcdb-dump.perl - dump a text representation of a DiaColloDB sub-index

=head1 SYNOPSIS

 dcdb-dump.perl [OPTIONS] OBJFILE

 General Options:
   -help
   -version
   -verbose LEVEL

 Dump Options:
   -log-level LEVEL     ##-- set log-level (default=TRACE)
   -class CLASS         ##-- specify object class (default=guess from header)
   -option OPT=VALUE    ##-- set object option
   -output OUTFILE      ##-- specify output file (default=STDOUT)

=cut

###############################################################
## OPTIONS
###############################################################
=pod

=head1 OPTIONS

=cut

###############################################################
# General Options
###############################################################
=pod

=head2 General Options

=over 4

=item -help

Display a brief help message and exit.

=item -version

Display version information and exit.

=item -verbose LEVEL

Set verbosity level to LEVEL.  Default=1.

=back

=cut


###############################################################
# Other Options
###############################################################
=pod

=head2 Other Options

=over 4

=item -someoptions ARG

Example option.

=back

=cut


###############################################################
# Bugs and Limitations
###############################################################
=pod

=head1 BUGS AND LIMITATIONS

Probably many.

=cut


###############################################################
# Footer
###############################################################
=pod

=head1 ACKNOWLEDGEMENTS

Perl by Larry Wall.

=head1 AUTHOR

Bryan Jurish E<lt>moocow@cpan.orgE<gt>

=head1 SEE ALSO

perl(1).

=cut