I don't know if you consider this an improved version, it is at least a bit different:

my ($min,$max,@newlist);
@list = sort { $a <=> $b } @list;
$min=$max=shift @list;
while (@list) {
  $_= shift @list;
  if (not $_ == ++$max) {
    --$max;
    push @newlist, "$min-$max";
    $min=$max=$_;
  }
}
push @newlist, "$min-$_" if (defined $_);
print join(',',map {s/(\d+)-\1/$1/} @newlist);
[download]

UDPATE: Corrected two bugs, a missing '=' and it didn't print the last value or range.