#! perl use strict; use warnings; my (@old, @new); while (my $file = ) { chomp $file; @old = split /-/, $file; @new = (); posA () or next; dv () or next; device(); floor (); state (); print join('-', @old, @new), "\n"; } sub posA { my $field = shift @old; if ($field =~ /^(\d*)(lc|pp)$/i) { my $num = (length $1 == 0) ? '#' : (length $1 == 1) ? '0' . $1 : $1; push @new, $num . uc($2); return 1; } warn "Malformed posA: $field\n"; return 0; } sub dv { my $field = shift @old; if ($field =~ /^(\d+)([a-z]?)$/i) { my $code = (length $2 == 0) ? '#' : $2; push @new, $1 . uc($code); return 1; } warn "Malformed dv: $field\n"; return 0; } sub device { for my $i (0 .. $#old) { if ($old[$i] =~ /^(?:rt|fw|sw)\d+$/i) { push @new, uc(splice @old, $i, 1); return; } } push @new, 'DEVICE#'; } sub floor { for my $i (0 .. $#old) { if ($old[$i] =~ /^(\d+)fl$/i) { splice(@old, $i, 1); push @new, (length $1 == 1 ? '0' : '') . "$1FL"; return; } } push @new, '#FL'; } sub state { for my $i (0 .. $#old) { if ($old[$i] =~ /^[a-z]{2}$/i) { push @new, uc(splice @old, $i, 1); return; } } push @new, 'STATE'; } __DATA__ 1lc-2621s-RT02-9FL 2pp-3524-7FL PP-800c-RT1-TX 10lc-7206-3FL-SW02-ny LC-6509r-SW1