#!/usr/bin/perl
# script is based on  
# Daktari MIDI, a Midi file dumper.  Version 1m 
# Time-stamp: "1998-06-15 19:20:51 MDT sburke@alf8.speech.cs.cmu.edu" 
#  

# stripped down by zentara to only calculate midi playtime 
# this code and the original is GPL 

#Notice , only valid for midifiles with 96 ticks per 
#quarternote. :-(

# the playtime is computed by cycling thru the tracks and 
# getting the longest sigma t out of the tracks 

# playtime = (sigma_t_max)/(ticks_per_quarternote * 2)  in seconds 
my $sigma_t_max = 0;

######################################################################
+##### 
#Data tables follow 

%meta_event_types = (
 0x00, "Set sequence number",
 0x01, "Text event",
 0x02, "Copyright text event",
 0x03, "Track name",
 0x04, "Instrument name",
 0x05, "Lyric",
 0x06, "Marker",
 0x07, "Cue point",
 0x2F, "End-track event",
 0x51, "Set tempo",
 0x58, "Time signature",
 0x59, "Key signature",
 0x7F, "Seq-specific information",
);

%event_types = (
 0x80, "Note off",
 0x90, "Note on",
 0xA0, "Key after-touch",
 0xB0, "Control change",
 0xC0, "Program (patch) change",
 0xD0, "Channel after-touch",
 0xE0, "Pitch wheel change",
);


die "No arguments\n" unless @ARGV;

die "Can't open $ARGV[0] \: $!\n"  unless open(MIDI, "<$ARGV[0]");
binmode(MIDI);
print "File: $ARGV[0]\n";

die "can't read header" unless read(MIDI, $in, 14); # the header lengt
+h 

($id, $length, $format, $tracks, $ticks) = unpack('A4Nnnn', $in);

die "Almost definitely not a MIDI file\n" unless $id eq 'MThd';
print "Unexpected header length ($length)!\n" unless $length == 6;

printf "Format: %d\nTracks: %d\nTicks per quarter note: %d\n",
       $format, $tracks, $ticks;

Track_Chunk:
until(eof(MIDI)) {
   $sum_t = 0;
   read(MIDI, $track_header, 8) || die "Can't read track header\n";

   ($id, $length) = unpack('A4N', $track_header);
   print "\nTrack chunk of $length bytes\n"; #!# 
   read(MIDI, $track_chunk, $length);
   unless($id eq 'MTrk') {
     print " Unknown track-chunk type $id of length $length\n";
     next Track_Chunk; # leave this track unanalyzed 
   }

   print "Track chunk is short by ", ($length - length($track_chunk)),
+ " bytes\n"
      if $length != length($track_chunk);

  Event: # analyze the event stream 
    while(length($track_chunk)){ # while there's anything to analyze 

     # <MTrk event> = <delta-time> <event> 
     # <event> = <midi event | sysex event | meta-event> 

     $event = '';

     # Slice off the delta time code, and analyze it 
     if( $track_chunk =~ s/^([\x80-\xFF]*[\x00-\x7F])// ) {
       $time_code = $1; # This is a valid time-code. 
       $event .= $1;
     } else { # didn't get sliced off; must be bad 
       print " Bad track-chunk data format.  No time code found.\n";
       next Track_Chunk;
     }
     $time = &read_variable_length($time_code);
     $sum_t += $time;
     $formatted_time = sprintf("%06st\: ", $time);

     ####################### 
     # Now let's see what we can make of the command 
     $first_byte = ord(substr($track_chunk,0,1));

     if ($first_byte < 0xF0) { # a MIDI event ####################### 
       if($track_chunk =~ s/^([\x80-\xEF])// ) {
         $last_event_code = $event_code = $1;
         $event .= $1;
       } else { # it's a running status mofo. 
         $event_code = $last_event_code;
       }
       $command = ord($event_code) & 0xF0;

       if ($command == 0xC0 || $command == 0xD0) { # pull off the 1-by
+te argument 
         $parameter = substr($track_chunk, 0, 1);
         substr($track_chunk, 0, 1) = '';
       } else { # pull off the 2-byte argument 
         $parameter = substr($track_chunk, 0, 2);
         substr($track_chunk, 0, 2) = '';
       }
       next Event;

       $channel = ord($event_code) & 0x0F;
       $event .= $parameter;
       print "$formatted_time $event_types{$command} ::  Channel $chan
+nel.  ";


     } elsif($first_byte == 0xFF) { # It's a meta-event! ############ 
       unless($track_chunk =~ /^\xFF(.)([\x80-\xFF]*[\x00-\x7F])/) {
         print "$formatted_time Meta-event format error\n";
         next Track_Chunk;
       }
       $command = $1;
       $length = $2;
       print "$formatted_time Meta-event type \$", unpack("H2", $comma
+nd),
             ' (', ($meta_event_types{ord($command)} || '?'),
             ') of length ', &read_variable_length($length), "\n";
       $data = substr($track_chunk,
               2 + length($length), # skip the FF, the command, and th
+e length bytes 
               &read_variable_length($length) ); # the length of the d
+ata 
       # now slice it out 
       substr($track_chunk, 0,
              2 + length($length) + length($data) ) = '';


     } elsif($first_byte == 0xF0   # It's a SYSEX ################### 
         || $first_byte == 0xF7) {

       unless($track_chunk =~ /^([\xF0\xF7])([\x80-\xFF]*[\x00-\x7F])/
+) {
         print "$formatted_time Sysex format error\n";
         next Track_Chunk;
       }
       $command = $1;
       $length = $2;
       print "$formatted_time Sysex type ", unpack("H2", $command),
             ' of length ', &read_variable_length($length), "\n";
       $data = substr($track_chunk,
               1 + length($length), # skip the F7/F0 and the length by
+tes 
               &read_variable_length($length) ); # the length of the d
+ata 
       # now slice it out 
       substr($track_chunk, 0,
              1 + length($length) + length($data) ) = '';

     } elsif($command == 0xF2) { # It's a Song Position ############# 
       print "$formatted_time Song Position (F2).\n";
        substr($track_chunk, 0, 3 ) = ''; # itself, and 2 data bytes 

     } elsif($command == 0xF3) { # It's a Song Select ############### 
       print "$formatted_time Song Select (F3).\n";
        substr($track_chunk, 0, 2 ) = ''; # itself, and 1 data byte 

     } elsif($command == 0xF6) { # It's a Tune Request! ############# 
       print "$formatted_time Tune Request (F6) [!!].\n";
       # what the sam scratch would a tune request be doing in a MIDI 
+/file/? 
       substr($track_chunk, 0, 1 ) = ''; # itself 

     } else { # fall thru 
       if($track_chunk =~ s/^([\x00-\x7F]+)//) {
         if ($1 eq "\x00") {
           print "$formatted_time   skipping a null\n";
         } else {
           print "$formatted_time  Skipping strange data of length ", 
+length($1), "\n";
         }
       } else {
         print "$formatted_time  Unanalyzable data of length ", length
+($track_chunk), "\n";
          last Event;
       }
     }
  }
} continue {
  print "Sigma t = ", $sum_t, "\n";
  if($sum_t > $sigma_t_max){ $sigma_t_max = $sum_t }

}

print "sigma_t_max = $sigma_t_max\n";

my $play_seconds = ($sigma_t_max)/($ticks * 2);
print "seconds->$play_seconds\n";

my $minutes = int($play_seconds/60);
print "minutes->$minutes\n";

my $secs = $play_seconds - ($minutes * 60);
print "secs->$secs\n";

$secs = sprintf("%.1f", $secs);

print "Playtime MM::SS-> $minutes".'::'."$secs\n";

exit;
######################################################################
+### 

sub read_variable_length {
  local($byte, $value, @bytes) = ('',0);

  return 0 unless length($_[0]);
  # not that we should ever be fed a null string anyway 

  if($_[0] =~ /^([\x80-\xFF]*[\x00-\x7F])/) {
    @bytes = unpack('C*', $1);
  } else {
    print "bad VL format error\n";
    return 0;
  }

  while(@bytes) {
    $byte = shift @bytes;
    #!# print "Byte read: $byte\n"; 
    $value = ($value << 7) | ($byte & 0x7f);

    if ($value > 0xFFF_FFFF) { # shouldn't ever happen 
      print "variable-length value goes out of range\n";
      return $value >> 7; # some attempt at rectification 
    }

    last unless $byte & 0x80; # a clear 7th bit ends the encoding 
  }

  return $value;
}


######################################################################
+#####
[download]