Sorting LC Call Numbers

This is the routine I use to sort LC call numbers. The regex breaks the call number into it's component parts, class letters, class numbers, cutter letters, cutter numbers, etc., then does a successive series of sorts to put everything in the correct order.
I call the routine with something like:

@sortedcalls = sort sortcall @calls;

Here's the routine:

sub sortcall
        {
        ($ap1, $ap2, $ap3, $ap4, $ap5) = ($a =~ /\s*([a-zA-Z]+)\s*(\d+\.*\d*)\s*\.*([A-Z]+)\s*([0-9]+)\s*(.*)/i);

        ($bp1, $bp2, $bp3, $bp4, $bp5) = ($b =~ /\s*([a-zA-Z]+)\s*(\d+\.*\d*)\s*\.*([A-Z]+)\s*([0-9]+)\s*(.*)/i);


        if ($ap1 ne $bp1)                       # The class letters
                {
                return ($ap1 cmp $bp1);
                }
        elsif ($ap2 != $bp2)                    # The classnumbers
                {
                return ($ap2 <=> $bp2);
                }
        elsif ($ap3 ne $bp3)                    # The cutter letters
                {
                return ($ap3 cmp $bp3);
                }
        elsif ($ap4 != $bp4)                    # The cutter numbers
                {
                return ($ap4 <=> $bp4);
                }
        elsif ($ap5 ne $bp5)                    # The leftovers
                {
                return ($ap5 cmp $bp5);
                }
        else
                {
                return 0;
                }
        }

Or you can view it as a text file here.

A note regarding the regex: this version assumes a decimal point between the class and cutter numbers, if your call numbers display without a decimal you will probably have to adjust the regex to fit your situation.