#!/bin/perl -w
use strict;

my $fileName = "dir1/dir2/dir3/filename.txt";
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: $!";
      }
  }