#!/usr/bin/perl

use strict;

$| = 1;

# to be on the safe side:
binmode STDIN;
binmode STDOUT;
binmode STDERR;

my %cache;

while () {
   alarm 30;
   4 == read STDIN, my $len, 4
      or exit 0;
   $len = unpack "N", $len;
   $len < 10000 or die;
   $len == read STDIN, my $path, $len
      or die;
   alarm 0;

   # shorten path
   my @short;

   for (split /\//, $path) {

      if (255 < length) {
         # remove short-enough extension
         s/((?:\..{1,5}){0,3})\z//s;
         my $ext = $1;

         while (255 < length "$_$ext") {
            # remove a single utf-8 char from the end
            s/(?:[\x01-\x7f]|[\xc0-\xff][\x80-\xbf]+|.)\z//s;
         }

         $_ .= $ext;
      }

      push @short, $_;
   }

   my $short = join "/", @short;

   warn "shorten:\n$path\n$short\n" if $ENV{ENAMETOOLONG_VERBOSE};

   print pack "N/a", $short;
}