Hi monks,

I have written a code, where I need to select a directory and also retrieve the name of the directory when the push button is pressed. I want to give the user an extra functionality of creating a new directory (which he can name) also in whichever path he selects. I want to preferably provide this extra functionality once he hits the select key and the choose a directory tab opens. Note: I need to retrieve the path when I push the push button, as I am doing now.

Could you kindly help me with this.

To summarise. Objective is to allow the user to create/select a directory at any path where they have write access. Currently only select is implemented.

#!/usr/local/bin/perl
#
# Uses pack for the Label Frames so it behaves nicely on window resizi
#+ng
#
use strict;
#use warnings;

use Tk;
#use Tk::widgets qw(LabFrame JFileDialog); # RadiobuttonGroup
use Tk::widgets qw(LabFrame);
use File::Spec::Functions qw(canonpath);
#use File::chdir
#use Tk::DirSelect;
#use File::HomeDir;

# Global Variables
my $a_no_widths    = 10;
my $a_processoption = "180nm";
my $a_gdsname;
my $a_dirname;

my $a_mw = MainWindow->new;
my $a_file_lfdir = $a_mw->LabFrame(
    -label      => 'Directory name (optional)',
    -labelside  => 'acrosstop',
    -foreground => 'blue',
);
$a_file_lfdir->pack(
    -expand => 0,
    -fill   => 'x',
);

# Directory

my $a_entdir = $a_file_lfdir->Entry(
    -width => 35,
)->grid(
    -row => 0, -column => 0,
    -padx => 5,
    -pady => 5,
);

my $a_file_btn_dir = $a_file_lfdir->Button(
    -text => 'Select',
    -command => sub { a_get_dir() },
)->grid(
    -row => 0, -column => 1,
    -padx => 5,
    -pady => 5,
);

# Run

my $a_run_lf = $a_mw->LabFrame(
    -label      => 'Run',
    -labelside  => 'acrosstop',
    -foreground => 'blue',
);
$a_run_lf->pack(
    -expand => 1,
    -fill   => 'both',
);


my $a_but = $a_run_lf->Button(
    -text => "Go!",
    -command => \&a_push_button,
)->pack;

# clear



my $a_but_clear = $a_run_lf->Button(
    -text => "Clear Text Box",
    -command => \&a_clearme,
)->pack;


my $a_txt = $a_run_lf->Scrolled(
    'Text',
    -width      => 40,
    -height     => 15,
    -wrap       => 'word',
    -scrollbars => 'e',
    -background => 'white',
);
$a_txt->pack(
    -expand => 1,
    -fill   => 'both',
    -padx   => 5,
    -pady   => 5,
);




MainLoop;

# Functions
sub a_clearme {
$a_txt-> delete("1.0",'end');
}

sub a_push_button {

    $a_dirname = $a_entdir->get();
    $a_dirname ||= '?';
    
    if ($a_dirname eq '?') {


 my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(
+time); 
 my $ymd = sprintf("%04d_%02d_%02d_%02d_%02d",$year+1900,$mon+1,$mday,
+$hour,$min);
 $a_dirname = $ymd;
$a_txt->insert( 'end', "We are autocreating the directory in your curr
+ent folder. Directory name will be $a_dirname\n");
    }

mkdir($a_dirname, 0700) unless(-d $a_dirname );
#system ("cd  $a_dirname");
chdir ("$a_dirname");
#$CWD = $a_dirname;

my $a_filedum = "dummy.txt";
unlink $a_filedum;
           # open O, '>', 'out' .  $o_i++ or die $!;
            open my $a_fileHandle2, ">>", "dummy.txt" or die "Can't op
+en 'dummy.txt'\n";

print $a_fileHandle2 'This is just a dummy text, which is just a model
+ to other scripts that will be inside here.';
close $a_fileHandle2;

$a_txt->insert( 'end', "Directory chosen is $a_dirname \n");



}

sub a_get_dir {
    # JFileDialog works better on Windows XP ;)

#my @a_types = (["Layout files", [qw/.gds .oas .oas.gz .gds.gz/]]);
  my $a_dir_dlg = $a_mw->chooseDirectory(-initialdir => '~',
                                   -title => 'Choose a directory');
  print "$a_dir_dlg selected as directory\n";
  #return($a_file_dlg);

    # Use getOpenFile if that's not important
#    my $a_file_dlg = $a_mw->JFileDialog(
#        -Title   => 'File name',
#        -Create  => 0,
#        -Path    => File::HomeDir->my_documents,
#        -FPat    => '*.txt',
#        -ShowAll => 'NO'
#    );
#    my $a_file = $a_file_dlg->Show(-Horiz => 1);
    my $a_dir = $a_dir_dlg;
    unless ($a_dir) {
        print "cancelled...\n";
        return;
    }
    $a_dir = canonpath($a_dir);
    a_update_dir($a_dir);
    return($a_dir);
}

sub a_update_dir {
    my $a_value_dir = shift;
    $a_entdir->delete( 0, 'end' );
    $a_entdir->insert( 0, $a_value_dir ) if defined $a_value_dir;
    return;
}

[download]

In reply to ability to create a directory in perl TK by Anonymous Monk

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post, it's "PerlMonks-approved HTML":


  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.