The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/env perl
use strict;
use warnings;
use Net::Stomp::MooseHelpers::ReadTrace;
use Net::Stomp::Producer;
use Getopt::Long;
use Pod::Usage;
use Cwd;
use Time::HiRes 'sleep';

my ($trace_basedir,$host,$port,$time_divisor)=
    (getcwd(),'localhost',61613,1);
my ($help,$verbose,$pretend);

Getopt::Long::Configure(
    qw(posix_default bundling no_ignore_case),
);
GetOptions(
    'tracedir|d=s' => \$trace_basedir,
    'host|H=s' => \$host,
    'port|P=i' => \$port,
    'divisor|t=f' => \$time_divisor,
    'pretend|p' => \$pretend,
    'verbose|v' => \$verbose,
    'help|h' => \$help,
) or pod2usage(
    -msg=>'bad options',
    -exitval=>2,
    -verbose=>2,
);
pod2usage(
    -exitval => 0,
    -verbose => 1,
) if $help;
$time_divisor ||= 1; # 0 would be a bad divisor

my $reader = Net::Stomp::MooseHelpers::ReadTrace->new({
    trace_basedir => $trace_basedir,
});
my $sender = Net::Stomp::Producer->new({
    servers => [ { hostname => $host, port => $port } ],
});

print "Reading from $trace_basedir\n" if $verbose;

my @file_names= $reader->sorted_filenames();
unless (@file_names) {
    warn "No frames found under $trace_basedir!\n";
}

my $current_timestamp;

for my $file_name (@file_names) {
    my $frame = $reader->read_frame_from_filename($file_name);

    if ($frame->command ne 'MESSAGE') {
        warn "Skipping $file_name, it's not a received message\n";
        next;
    }

    my ($this_timestamp) = ($file_name =~ m{/(\d+\.\d+)-[^/]+\z});
    if ($current_timestamp) {
        my $original_delay = $this_timestamp - $current_timestamp;
        my $desired_delay = $original_delay / $time_divisor;
        if ($desired_delay > 0) {
            print "Sleeping $desired_delay seconds\n" if $verbose;
            sleep($desired_delay);
        }
    }
    $current_timestamp = $this_timestamp;

    if ($pretend) {
        print "Pretend sending $file_name\n";
    }
    else {
        print "Sending $file_name\n" if $verbose;

        $sender->send(
            undef, # no need to override the destination
            $frame->headers,
            $frame->body,
        );
    }
}

__END__

=head1 NAME

replay-trace -- read a trace directory and re-send the messages in it

=head1 SYNOPSIS

  replay-trace -d /tmp/trace-dir

=head1 OPTIONS

=over 4

=item C<--tracedir>, C<-d>

The directory to read messages from. It should have been populated by
L<Net::Stomp::MooseHelpers::TracerRole>, via
L<Net::Stomp::MooseHelpers::TraceStomp> or
L<Net::Stomp::MooseHelpers::TraceOnly>.

=item C<--host>, C<--port>, C<-H>, C<-P>

Hostname and port of the STOMP server to send messages to.

=item C<--divisor>, C<-t>

Factor to I<divide> time intervals by. By default, the program will
sleep between messages by the same amount of time they were separated
by when they were dumped. If you say C<-t 2> it will sleep I<half>
that time; if you say C<-t 0.5> it will sleep I<twice as long>.

=item C<--pretend>, C<-p>

Don't really send messages, just print a line to STDOUT.

=item C<--verbose>, C<-v>

Print progress to STDOUT.

=item C<--help>, C<-h>

Print this help.

=back