use Modern::Perl qw/2015/;
use File::Spec;

while ( my $fullfile = <DATA> ) {
    chomp $fullfile;
    my ( $volume, $directories, $file ) = File::Spec->splitpath($fullfile);
    $file =~ /^([^.]+).*(\.[^.]+)/;
    say File::Spec->catpath( $volume, $directories, "$1$2" );
}

__DATA__
9781437706734\BODY\B978143770673410006X\B978143770673410006X.xml1.xml.xml
9781437706734\BODY\B9781437706734100010\B9781437706734100010.xml1.xml.xml
9781437706734\REAR\B9781437706734102000\B9781437706734102000.xml1.xml.xml
9781437706734\REAR\B9781437706734102050\B9781437706734102050.xml1.xml.xml
9781437706734\REAR\B9781437706734102051\B9781437706734102051.xml1.xml.xml
a\funny\file\path\with_too_many.file.extensions.in.the.file.name.txt