#!/usr/bin/perl

use strict;

my $fileName = 'Documents and Settings/My Documents/TEST';
create_dirs( $fileName);
open (List, '>', $fileName);

sub create_dirs
  { my $filename= shift;
    my $dir;
    while(  $filename=~ m{(/?[^/]+)(?=/)}g)
      { $dir .= $1;
        next if( -d $dir);
        mkdir( $dir) or die "cannot create $dir: $!";
      }
  }