The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/perl -w
my $RCS_Id = '$Id: mp3cat.pl,v 1.5 2006/06/21 19:39:30 jv Exp $ ';

# Skeleton for Getopt::Long.

# Author          : Johan Vromans
# Created On      : Mon Jul 14 20:31:56 2003
# Last Modified By: Johan Vromans
# Last Modified On: Wed Jun 21 21:39:25 2006
# Update Count    : 24
# Status          : Unknown, Use with caution!

################ Common stuff ################

use strict;

# Package name.
my $my_package = 'Sciurix';
# Program name and version.
my ($my_name, $my_version) = $RCS_Id =~ /: (.+).pl,v ([\d.]+)/;
# Tack '*' if it is not checked in into RCS.
$my_version .= '*' if length('$Locker:  $ ') > 12;

use FindBin;
use lib $FindBin::Bin;

################ Command line parameters ################

my $output;			# output to?
my $verbose = 1;		# more verbosity

# Development options (not shown with --help).
my $debug = 0;			# debugging
my $trace = 0;			# trace (show process)
my $test = 0;			# test mode.

# Process command line options.
app_options();

# Post-processing.
$trace |= ($debug || $test);

################ Presets ################

my $TMPDIR = $ENV{TMPDIR} || $ENV{TEMP} || '/usr/tmp';

################ The Process ################

use MPEG::Audio::Frame 0.04;

if ( defined $output) {
    open (STDOUT, ">$output") || die("$output: $!\n");
}
binmode(STDOUT);

my $tlen = 0;
my $tframes = 0;

foreach my $file ( @ARGV ) {
    open (STDIN, $file) || die("$file: $!\n");
    binmode(STDIN);

    my $len = 0;
    my $frames = 0;

    my $frame;
    while ( $frame = MPEG::Audio::Frame->read(\*STDIN) ) {
	$len += $frame->seconds;
	print STDOUT $frame->asbin;
	$frames++;
    }
    warn("$file: ", dpsecs($len), ", $frames frames\n") if $verbose;

    $tlen += $len;
    $tframes += $frames;
}

warn(defined $output ? $output : "TOTAL",
     ": ", dpsecs($tlen), ", $tframes frames\n") if @ARGV > 1 && $verbose;

################ Subroutines ################

sub dpsecs {
    my $secs = shift;
    my ($mm, $ss);
    $secs *= 100;
    $mm = int($secs / 6000);
    $secs %= 6000;
    $ss = int($secs / 100);
    $secs %= 100;
    sprintf ("%d:%02d:%02d", $mm, $ss, $secs);
}

################ Command Line Options ################

use Getopt::Long 2.33;		# will enable help/version

sub app_options {

    GetOptions(ident	=> \&app_ident,
	       'verbose|v'	=> \$verbose,
	       silent   => sub { $verbose = 0 },

	       # application specific options go here
	       'output=s' => \$output,

	       # development options
	       test	=> \$test,
	       trace	=> \$trace,
	       debug	=> \$debug)
      or Getopt::Long::HelpMessage(2);
}

sub app_ident {
    print STDOUT ("This is $my_package [$my_name $my_version]\n");
}

__END__

=head1 NAME

mp3cat - concatenate MP3 files

=head1 SYNOPSIS

mp3cat [options] [file ...]

Options:

   --output=XXX		output to this file
   --ident		show identification
   --help		brief help message
   --verbose		verbose information

=head1 OPTIONS

=over 8

=item B<--verbose>

More verbose information (default).

=item B<--silent>

Less verbose information.

=item B<--version>

Print a version identification to standard output and exits.

=item B<--help>

Print a brief help message to standard output and exits.

=item B<--ident>

Prints a program identification.

=item I<file>

Input file(s), which must be valid MP3 files.

=back

=head1 DESCRIPTION

B<This program> will read the given MP3 files and concatenates the
audio frames to the output. If no B<--output> has been specified this
will be standard output, otherwise output will be written to the named file.

=head1 REQUIREMENTS

L<MPEG::Audio::Frame> 0.04 or later.

=head1 DISCLAIMER

Audio data can be copied incorrectly. Always check your resultant
files. Never throw away the original data. USE AT YOUR OWN RISK.

=head1 AUTHOR

Johan Vromans <jvromans@squirrel.nl>

=head1 COPYRIGHT

This programs is Copyright 2003, 2006 Squirrel Consultancy.

This program is free software; you can redistribute it and/or modify
it under the terms of the Perl Artistic License or the GNU General
Public License as published by the Free Software Foundation; either
version 2 of the License, or (at your option) any later version.

=cut