while (my $file = ) { chomp $file; my @old = split /-/, $file; my @new; for my $old_field (@old) { # analyse $old_field # construct $new_field push @new, $new_field; } print join('-', @new), "\n"; } #### 1lc-2621s-RT02-9FL #### 10lc-7206-3FL-SW02 #### #! 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 #### 17:20 >perl 1051_SoPW.pl 01LC-2621S-RT02-09FL-STATE 02PP-3524#-DEVICE#-07FL-STATE #PP-800C-RT1-#FL-TX 10LC-7206#-SW02-03FL-NY #LC-6509R-SW1-#FL-STATE 17:20 >