Script to Rename MP3′s

Author: fREW Schmidt

31 May

I recently got a new car stereo due to the other one being stolen. I am almost entirely happy with the model that I ended up purchasing, but one thing that it does, which is really obnoxious, is that it doesn’t sort the files correctly unless the track number is early on in the file name. Even if all tracks are “FooBarBaz 01 – name.mp3″ it seems to ignore the number unless it’s the very beginning of the file name. Anyway, easy fix:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35

#!perl
use strict;
use warnings;
use feature ':5.10';

use Music::Tag;
use File::Find::Rule;
use File::Basename "fileparse";
use File::Copy "move";
use File::Spec;
my $directory = shift || '.';

my @songs
= File::Find::Rule->file()->name( '*.mp3' )
->in( $directory );

foreach my $song (@songs) {
my $info = Music::Tag->new($song);
$info->get_tag;
my $track = $info->track;
my $title = $info->title;
my (undef, $dir, $suffix) =
fileparse($song, qr/\.[^.]*/);
$info->close;
if ($track and $title) {
my $newfilename = File::Spec->catfile(
$dir,
sprintf "%02d %s%s", $track, $title, $suffix
);
if ($song ne $newfilename) {
say "renaming $song to $newfilename";
move $song, $newfilename;
}
}
}

It doesn’t really deal with illegal characters, it just doesn’t rename those files. Eventually I’ll get around to doing that. Anyway, just figured someone might be interested/want to copy paste this.

3 Comments

Filed under: perl

DBIC’d

Author: fREW Schmidt

21 May

This is a blogish version of a message I posted to the DBIC Mailing list recently.

First off, this is my table structure:

User has many Roles (Role belongs to User)
Role has many Permissions (Permission belongs to Role)
Permissions has many Screens (Screens has many Permissions)
Screens belongs to Section (Section has many Screens)

So I thought I could do this:

1
2
3
4
5

my @sections = $user->roles
->related_resultset('permissions')
->related_resultset('screens')
->related_resultset('section')
->all;

But related_resultset doesn’t work with many_to_many because it’s not a “real” relation (I’d like to hear about why that is at some point.)

The following is close to what I wanted

1
2
3
4
5
6
7

my @sections = $user->roles
->related_resultset('role_permissions')
->related_resultset('permission')
->related_resultset('permission_screens')
->related_resultset('screen')
->related_resultset('section')
->all;

But it turns out it returns a section per role, which often means duplicates.

So I figured I could do a distinct, so I finally tried this:

1
2
3
4
5
6
7

And it worked! How cool is that?

I actually later on ended up only getting the screens and then getting the sections based on that, otherwise we got false positives on the sections. Anyway, now we have a nice roles/permission based tree getting built on our app for the navigation.

And this next little trick could be an entire post in itself, but my Draft queue is getting pretty huge, so I’ll just include it here:

1
2
3
4
5
6
7

$cd_rs->search({
artist_id => {
in => $artists_rs->search({
name => { like => '%beat%'},
})->get_column( 'id' )->as_query
},
});

So basically what this does is a subselect. DBIC is very much strives to be consistent throughout, which brings us the amazing new as_query method. This turns the given resultset into a data structure, which can then be passed to other resultsets searchs to create subselects. The above search will find all of the CD’s by artists with the string ‘beat’ somewhere in their names.

Anyway, hope you enjoyed this post. My brother is getting married in a week and my sister is graduating highschool on Tuesday. I say this because I doubt I will be able to post much next week. So worst case scenario I will post again on the first of June.

1 Comment

Filed under: Uncategorized

Don’t Repeat Yourself: JSON

Author: fREW Schmidt

18 May

With DBIx::Class we typically have a TO_JSON method which returns a hashref of the data you want in your json. Here’s an example:

1
2
3
4
5
6
7
8
9
10
11
12
13
14

sub TO_JSON {
my $self = shift;
return {
id => $self->id,
name => $self->name,
comments => $self->comments,
email => $self->email,
job => $self->job,
ok => $self->ok,
i_cant => $self->i_cant,
think_of => $self->think_ok,
anymore => $self->anymore,
};
}

Here’s the shorter version mst inspired me to write:

1
2
3
4
5
6
7
8

sub TO_JSON {
my $self = shift;
return {
map { $_ => self->$_ }
qw{ id name comments email job
ok i_cant think_of anymore },
};
}

Anyway, not very complex, but still awesome.

2 Comments

Filed under: perl

Perl 5 to Perl 6 Rewrite

Author: fREW Schmidt

15 May

My coworker Wes asked me if there could be a nice refactor for the following function which checks CAS Numbers to ensure their validity. After struggling for 30 minutes I gave up trying to make it a little bit nicer with reduce.

1
2
3
4
5
6
7
8
9
10
11
12
13
14

sub cas_old {
my $cas = shift;
if ($cas =~ /\d{1,8}-\d\d-\d/) {
my @ary = grep { $_ ne '-' } split(//, $cas);
my $check = pop @ary;
my $count = @ary;
my $sum;
for (@ary){
$sum += $_ * $count--;
}
return $sum % 10 == $check;
}
return;
}

Let’s take a look at this and figure it out. The crunchy bit is the for loop, so I’ll go through that. Basically we are summing each item times a weight that is inversely proportional to it’s location in the list. Or to be more explicit, let’s do an example on the board (7732-18-5.) 5 is the check digit.

$_	$count	$_ * $count	$sum
7	6	42	42
7	5	35	77
3	4	12	89
2	3	6	95
1	2	2	97
8	1	8	105

So basically we are making a special summation. The thing that’s unusual is that we have a decrementing counter along with it. If I had the control structure which I am about to show you in my mind already the solution might have jumped out sooner.

So I asked about it in #perl6 and it turns out there is a very nice Perl 6 version. It takes advantage of the mystical hyperoperator (>>infix op<<); that is, it takes two lists and performs an operation on each element together. Think SIMD. It also uses reduce ([infix op]) which I have mentioned before. Check it out!

1
2
3
4
5
6
7
8
9
10

sub cas(Str $cas) {
if $cas ~~ /(\d ** 1..8)\-(\d\d)\-(\d)/ {
my @digits = $0~$1.split '';
my $check = $2;
return ([+] @digits.reverse
>>*<<
(1..@digits)) % 10 == $check;
}
return Bool::False;
}

This does the same thing as above. Or to put it in English, we take our digits, reverse them, and then multiply each digit (hyperoperator, >>*<<) by the respective integer in the other list, that is, 1 to the size of the list. We then sum (reduce, [+]) that new list, and get the modulus 10 of it.

Very elegant, no?

Update: Turns out there is also a very elegant version in p5, according to mst. Check it out!

1
2
3
4
5
6
7
8
9
10
11
12

sub cas_old {
use List::Util 'sum';
my $cas = shift;
if ($cas =~ /(\d{1,8})-(\d\d)-(\d)/) {
my @digits = split(//, $1.$2);
my $count = @digits;
my $check = $3;
return (sum map $_ * $digits[-$_],
1 .. $count) % 10 == $check;
}
return;
}

It’s very similar to the p6 version, just using fewer generalized operators, so you should be able to follow it fairly well.

0 Comments

Filed under: perl

Dallas.p6m: May 2009

Author: fREW Schmidt

14 May

We had the second Dallas.p6m on May 12, 2009. Along with me there were two of my coworkers, s1n, Graham Barr, and Patrick Michaud. We discussed a lot of things. One of which was the difference between subs and methods in Perl6. And the fact that you can’t imply self. This should explain it:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48

class A {

sub foo {
say 'foo';
}

method bar($o:) {

# much to s1n's chagrin, you can't
# have baz() imply self.baz. These
# are his options

say 'bar';
self.baz;
$o.baz;

# great for when you have a lot
# of object methods close by

given self { .baz; }

# this is the same as above but it's
# not scoped. Good for short methods

$_ = self;
.baz;

# not really recommended as it
# doesn't seem to be for anything
# but attributes.
$.baz;
}

method baz {
say 'baz';
}
}

my $a = A.new;
A::foo;
#A::bar; # dies

#$a.foo; # dies
$a.bar;
A.bar;
# note: there may be a distinction between
# class and instance methods, but for now
# you use the same method for both

I also asked Patrick if he thought that Perl 5 in Perl 6 would really happen and if so how. He said it would happen, but probably not soon. There are really three options. The first is to embed Perl 5 in Parrot. This is really the “best” option as it would have 100% compatibility (except weird XS stuff,) and I think Patrick said that it had been prototyped, so that’s encouraging. The next option would be to reimplement most of Perl 5 in Perl 6. This would never get close to 100% but it would still be an option. The last option would be to have major parts of CPAN reimplemented in Perl 6, thus making compatibility far less important. Important CPAN modules would be DBI, a good templating system, a web framework (in progress), and some form of GUI toolkit.

Somehow we got into a discussion about Mojo, the framework Graham uses at $work. It is modeled after Rails and is supposed to be simple to port to Perl 6. The most important thing about it, as far as I can tell, is that it has no dependencies. Graham made it sound like a lightweight framework, but I guess he just meant the no deps thing. CGI-Application (what I use) totals to 7k lines. Mojo, on the other hand, totals to 50k. Not exactly lightweight, but low dependencies is an interesting goal.

And then two thirds of us are going to YAPC::NA, so we talked about that some. Very exciting things coming up!

0 Comments

Filed under: perl

What I want from the Perl 5 support policy

Author: fREW Schmidt

13 May

This is in response to chromatic’s post Writing Perl 5′s Support Policy

I want to be able to use the support policy as a reason to convince customers with lots of Perl installs that they need to update. A big part of this means an easy upgrade.

Probably most of the people using Perl 5 are in Unix. That makes it easier for you folks. On Windows installing Perl is no simple task, either ActivePerl or Strawberry Perl.

For example, at $work we use Apache/mod_perl. (I don’t wanna hear your “FastCGI! FastCGI! FastCGI!”, none of you people have actually helped me so far!) Let’s say I want to use the shiny new Perl 5.11. I install it. Awesome. Wait! mod_perl doesn’t work! Ok, reinstall that. Oh wait! All of my XS/compiled modules don’t work! etc etc. I understand the fact that Windows is a second class citizen here, but in Unix you probably have the same issue. You just made some kind of package to install it all at once or something. That’s great, but does it help me? Is updating really supported?

On a side note a point that my boss made when we discussed this issue is the fact that the community may not support Perl 5.8 in the future, but if companies will pay for it, ActiveState will probably support it. This is good for the customers and helps the community, so I’d say that’s really a win-win.

Anyway, those are my thoughts. Take ‘em or leave ‘em.

3 Comments

Filed under: perl

Profilers or more specifically NYTProf

Author: fREW Schmidt

12 May

At work one of our customers is having us revamp one of the major sections of the site. We are moving in the “Web Application” direction; that is, very little HTML, and almost all Javascript. The section of the site that my coworker was working on recently does a lot of calculation. On the old HTML page a customer would log in, ask for a certain report, and I guess go get a cup of coffee. The report took something like five minutes to run; not impossibly long, but long enough that you don’t want to leave it like that and turn the output into JSON.

So we took a look at the module that does the calculation. First off, it was a little long (four thousand lines,) so just eyeballing it wouldn’t easily point us to what was causing the slowdown. Fortunately my coworker Neil, who wrote the module, had also written a simple to execute perl script, as opposed to everything being in a cgi script. So with that in hand, we fired up NYTProf.

NYTProf is a profiler that was written for use at the (wait for it) New York Times. After installation using it was extremely easy:

1	perl -d:NYTProf calc.pl

That generates a database of what went down. Next we ran:

1	nytprofhtml

Which turned everything into nicely formatted html files. It creates profiles for all of the files used and has some nice javascript sorting built in to the tables etc. It showed us that we were calling a certain heavyweight function more than we should have (DBI::st::execute .) And then there were other things that we did (simple caching for example: if (!$self->{foo}) { $self->{foo} = …;} return $self->{foo}) which sped things up something like 70% in the profile.

Anyway, if you find yourself hitting a speed wall, NYTProf isn’t hard to use at all. The only problem you may run into is not having a simple to run test script. This is another reason to split business logic into modules; you can easily use the modules in your controllers, test scripts, and profilers.

Have fun!

0 Comments

Filed under: perl

Concert of the Month: Astronautalis

Author: fREW Schmidt

11 May

Saturday night my roommate and another friend went to see Astronautalis. He was actually sandwiched between Valina and The Paper Chase. Valina was a generic rock band that I can’t imagine ever going to see just for them. They just didn’t seem to bring anything special to the table. The Paper Chase were Dissonant Rock and most of their songs sounded the same. We left after their fourth song I think.

But Astronautalis’ show was awesome. I’ve never been to a rap concert per se, so some of the things that I note are probably typical, but on the other hand, Astronautalis’ music isn’t like most rap (evidenced by the fact that I like it.) He first came on stage and greeted us all. He has a little routine he does around the songs, which isn’t that unusual, except for the fact that his routines turn into freestyle rap sometimes, which was pretty cool. He gave us advice that to survive in these tough economic times we should steal from people, or more specifically, family and friends, because unlike strangers, family and friends won’t ask questions. It was pretty hilarious. So then he went on to do various recorded songs, most of them from Pomegranate.

Basically he would play the track from his laptop and rap/sing the song. He had a ton of energy while he was performing. He looked like he was gonna get an aneurysm and moved his hands around a lot to symbolize the lyrics. It was awesome.

About halfway through the show he did a freestyle (and asked the audience for topics) and nailed it. I was surprised that his lyrical style (very much like that of Collin Melloy’s: almost mythical, with a moral to the story) came through loud and clear despite the fact that he was making up the lyrics on the spot. Again, this may be typical of rap music, but I was still surprised.

It was a really cheap show too, $14 at the door, so that was awesome. When we left The Paper Chase we went to talk to Astronautalis where he was selling merch. He seemed like a cool guy and we all got to shake his hand and buy a couple of his albums. Next time he is in Dallas I am definitely going to see him again. It was a great show.

1 Comment

Filed under: music

Friday Refactor

Author: fREW Schmidt

8 May

It’s Friday, so a long post is not in order. With that in mind, a simple refactor for your pattern matching skulls and skills:

before:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15

my @files = File::Find::Rule->file()->name('*.t')
->maxdepth( 1 )->in(
File::Spec->catdir(
$self->get_directory, 't'
) );

my @total_results;

foreach my $file (@files) {
push @total_results,
"<span class='file'>$file</span>";
push @total_results,
@{ $self->test( $file ) };
}
return join "\n", @total_results;

Do you see what I see? We’re iterating over a list and generating a new list… And then we are just doing a join on that. Enjoy the nice and functional rewrite.

after:

1
2
3
4
5
6
7
8

return join "\n", map {
( "<span class='file'>$_</span>",
@{ $self->test( $_ ) } );
} File::Find::Rule->file()->name('*.t')
->maxdepth( 1 )->in(
File::Spec->catdir(
$self->get_directory, 't'
) )

0 Comments

Filed under: perl

Album of the Week: Space Revolver

Author: fREW Schmidt

7 May

I have had quite the love affair with prog-rock. One of the bands that led to this affair was The Flower Kings. I think the third album of theirs that I got was Space Revolver
. Space Revolver is very much prog and very much Flower Kings. For instance, the first song, I Am The Sun (part one) has lots of noise and even a weird (but awesome) sub-song that most bands certainly wouldn’t do.

It has a lot of the gorgeous guitar thanks to Roine Stolt head man as well as a lot of really amazing “soundscapes”, or very instrument driven sections of songs. I think that the soundscapes come from Tomas Bodin, who has had a few solo albums himself.

The album also has some of the standard FloKi’s Doom and Gloom in Monster Within. To expound upon that, despite their standard message of love (see band name,) they also have this interesting feeling of judgment in their lyrics. Here’s an example:

So you say that you cannot sleep, you’re not into counting sheep
All the monsters are for real, something out there, the way you feel
Grown up man, you’re still losing sleep, aliens hiding in the deep
Nights of terror and gates of hell, can’t get rid of that brimstone smell

They have a lot of other really great albums, but you have to start somewhere right Anyway, hopefully you will enjoy this album as much as I do.