001 #!/usr/local/bin/perl -w
002 use strict;
003 use Log::Log4perl qw(:easy);
004 use DBI qw(:sql_types);
005 use DBD::SQLite;
006 use Sysadm::Install qw(tap);
007 use URI::Escape;
008 use File::Temp qw(tempfile);
009 use POSIX;
010 
011 my $SAMPLE_RATE = 10_000;
012 my $OFFSET      = 60;
013 my $SAMPLE_SECS = 30;
014 my $MIN_SIZE    = 500;
015 my $MIN_DROP    = 0.7;
016 my $NWINDOWS    = 20;
017 
018 Log::Log4perl->easy_init({ level => $INFO, 
019                     category => "main" });
020 my $db  = glob 
021           "~/.config/banshee-1/banshee.db";
022 my $dbh = DBI->connect( "dbi:SQLite:$db", 
023     "", "", { RaiseError => 1, 
024               AutoCommit => 1 });
025 bpm_update( $dbh );
026 $dbh->disconnect();
027 
028 ###########################################
029 sub bpm_update {
030 ###########################################
031   my( $dbh ) = @_;
032 
033   my $sth = $dbh->prepare( 
034       "SELECT Uri FROM CoreTracks" );
035   $sth->execute();
036 
037   my $upd_sth = $dbh->prepare(
038     "UPDATE CoreTracks SET BPM=? " .
039     "WHERE Uri = ?");
040 
041   while( (my $uri) = 
042          $sth->fetchrow_array() ) {
043     my $file = uri_unescape( $uri );
044     $file =~ s#^file://##;
045     INFO "Updating $uri";
046     $upd_sth->execute( bpm( $file ),
047                        $uri );
048   }
049   $upd_sth->finish();
050   $sth->finish();
051 }
052 
053 ###########################################
054 sub bpm {
055 ###########################################
056   my( $file ) = @_;
057 
058   my $rawfile;
059 
060   if( $file =~ /\.raw$/ ) {
061     $rawfile = $file;
062   } else {
063     $rawfile = File::Temp->new( 
064        SUFFIX => ".raw", UNLINK => 1 );
065       
066     my($stdout, $stderr, $rc) = 
067       tap "sox", $file, "-r", $SAMPLE_RATE, 
068         "-c", 2, "-b", 16, "-t", "raw", 
069         "-e", "signed", $rawfile, 
070         "bandpass", 100, 1, 
071         "trim", $OFFSET, $SAMPLE_SECS;
072       
073     if( $rc ) {
074       LOGWARN "sox $file: $stderr";
075       return 0;
076     }
077   }
078 
079   return raw_bpm( 
080            samples( $rawfile->filename ) );
081 }
082 
083 ###########################################
084 sub samples {
085 ###########################################
086   my( $file ) = @_;
087 
088   my @vals = ();
089   sysopen FILE, "$file", O_RDONLY 
090       or LOGDIE "$file: $!";
091 
092   while( sysread( FILE, my $val, 4 ) ) {
093     my($c1, $c2) = unpack 'ss', $val;
094     $c1 = 0 if $c1 < $MIN_SIZE;
095     push @vals, $c1;
096   }
097   close FILE;
098   return @vals;
099 }
100 
101 ###########################################
102 sub raw_bpm {
103 ###########################################
104   my(@samples) = @_;
105 
106   my $win   = scalar @samples / 
107               ($NWINDOWS*$SAMPLE_SECS);
108   my($bumps, $pmax, $slope) = (0, 0, "up");
109 
110   for( my $o = 0; $o <= $#samples - $win; 
111        $o += $win ) {
112     my $max = 0;
113     for( my $i = $o; $i <= $o + $win; 
114          $i++ ) {
115       if( $samples[$i] > $max ) {
116         $max = $samples[$i];
117       }
118     }
119 
120     if( $slope eq "up" ) {
121       if( $max < $MIN_DROP * $pmax ) {
122         $slope = "down";
123         $bumps++;
124       }
125     } else {
126       $slope = "up" if  $max > $pmax;
127     }
128     $pmax = $max;
129   }
130 
131   return int($bumps / $SAMPLE_SECS * 60.0);
132 }