view release on metacpan or  search on metacpan

config/dumpDB.pl  view on Meta::CPAN

#!/usr/bin/env perl
use strict;
use warnings;
use Getopt::Long;
use Data::Dumper;
use DBM::Deep;
use File::Path ();
use File::Spec;
use Digest::MD5 'md5_base64';

sub usage {
  warn "$_[0]\n" if defined $_[0];
  warn <<HERE;
Usage: $0 [--verbose] DBFILE
Usage: $0 DBFILE DistOrModuleRegex
Usage: $0 --html DBFILE
HERE
  exit(1);
}

my ($verbose, $toHTML);
GetOptions(
  'h|help' => \&usage,
  'v|verbose' => \$verbose,
  'h|html' => \$toHTML,
);

my $datafile = shift @ARGV;
usage("File does not exist") if not defined $datafile or not -f $datafile;
my $regex = shift @ARGV;
$regex = qr/$regex/ if defined $regex;

my $db = DBM::Deep->new($datafile);
if ($toHTML) {
  to_html($db);
}
elsif (defined $regex) {
  my %dists = 
    map {($_ => 1)}
    grep { /$regex/ }
    (keys %$db);
    #(keys %$db, (map {$_->{module}} values %$db));

  die "Multiple results selected: \n" . join("\n", keys %dists) . "\n"
    if keys(%dists) > 1;
  die "No results selected\n" if not keys %dists;

  my @dists = keys %dists;
  my $dist = $db->{$dists[0]};
  print $dist->{diff};
}
elsif ($verbose) {
  print Dumper $db;
}
else {
  foreach my $k (keys %$db) {
    my $s = $db->{$k}{status};
    print "$k - $s\n";
  }
}

sub to_html {
  my $db = shift;

  my $dir = 'dld-html';