view release on metacpan or  search on metacpan

script/tkpp  view on Meta::CPAN

	my $entry_newfiledir = $widget_addfile->Entry(
		-background => 'white',
		-width      => 50,
		-validate   => 'key',
	);

	$entry_filedir->configure(
		-validatecommand => sub {
			my ( $value, $char, $last_value, $type_insertion ) = @_;

			my $newfiledir = $entry_newfiledir->get();
			if ( $value =~ m/^\s*$/ ) {
				$addfile = '';
				$option  = '--addfile=""';
			}
			elsif ( defined $newfiledir and $newfiledir !~ m/^\s*$/ ) {
				$addfile = $value . ';' . $newfiledir;
				$option  = '--addfile="' . $addfile . '"';
			}
			else {
				$addfile = $value;
				$option  = '--addfile="' . $addfile . '"';
			}
		}
	);

	$entry_newfiledir->configure(
		-validatecommand => sub {
			my ( $value, $char, $last_value, $type_insertion ) = @_;

			my $filedir = $entry_filedir->get();
			if ( defined $filedir and $filedir !~ m/^\s*$/ and $value !~ m/^\s*$/ ) {
				$addfile = $filedir . ';' . $value;
				$option  = '-addfile="' . $filedir . ";$value" . '"';
			}
			elsif ( $value =~ m/^\s*$/ ) {
				$addfile = $filedir;
				$option  = '-addfile="' . $filedir . '"';
			}
			else {
				$addfile = '';
				$option  = '-addfile=""';
			}
		}
	);

	# To see addfile configuration
	my $label_addfile = $widget_addfile->Label(
		-textvariable => \$option,
		-font         => '{Arial} 10',
		-wraplength   => 400,
	);

	# To see addfile configuration
	my $valid_button = $widget_addfile->ColoredButton(
		-text    => 'Validation',
		-autofit => 1,
		-font    => '{Arial} 12 bold',
		-command => sub { $ok = 1; },
	);
	$label_explanation->grid(qw/ -row 0 -columnspan 2 -padx 5 -pady 5 /);
	$label_filedir->grid(qw/ -row 1 -column 0 -sticky w -padx 10 -pady 2 /);
	$entry_filedir->grid(qw/ -row 1 -column 1 -sticky we -padx 10 -pady 2 /);
	$label_newfiledir->grid(qw/ -row 2 -column 0 -sticky w -padx 10 -pady 2 /);
	$entry_newfiledir->grid(qw/ -row 2 -column 1 -sticky we -padx 10 -pady 2 /);
	$label_addfile->grid(qw/ -row 3 -columnspan 2 -sticky nswe -padx 10 -pady 2 /);
	$valid_button->grid(qw/ -row 4 -columnspan 2 -pady 10 /);

	center_widget($widget_addfile);
	$widget_addfile->grab;
	$widget_addfile->focusForce;
	$widget_addfile->waitVariable( \$ok );
	$widget_addfile->destroy;

	return if ( not defined $addfile or $addfile =~ m/^\s*$/ );
	return $addfile;
}

# get_dir($widget);
sub get_dir {
	my ($widget) = @_;

	if ( -e $last_filedir ) {
		open my $fh_read, '<', $last_filedir or die "Unable to read $last_filedir\n";
		$current_dir = <$fh_read>;
		close $fh_read or die "Unable to colse $last_filedir\n";
	}

	my $dir = $widget->chooseDirectory(
		-title      => 'Select directory',
		-initialdir => $current_dir,
		-mustexist  => 1,
	);

	# Windows
	if ( $OSNAME eq 'MSWin32' ) { $dir = encode( 'iso-8859-1', $dir ); }
	if ( defined $dir ) {
		$dir         = File::Spec->catdir($dir);
		$current_dir = $dir;
		open my $fh_write, '>', $last_filedir or die "Unable to write $last_filedir\n";
		print {$fh_write} $current_dir;
		close $fh_write or die "Unable to colse $last_filedir\n";
	}
	return $dir;
}

# get_file($widget, [ 'Perl Files', [ '.par', '.pl', '.pm' ] ]);
sub get_file {
	my ( $widget, $ref_file_type, $multiple ) = @_;

	if ( -e $last_filedir ) {
		open my $fh_read, '<', $last_filedir or die "Unable to read $last_filedir\n";
		$current_dir = <$fh_read>;
		close $fh_read or die "Unable to colse $last_filedir\n";
	}

	$multiple = defined $multiple ? 1 : 0;
	my %options = ( -multiple => $multiple, -title => 'Select files', -initialdir => $current_dir, );
	my @files_type = ( [ 'All Files', ['*'] ] );
	if ( defined $ref_file_type ) {
		unshift @files_type, $ref_file_type;
		$options{-filetypes} = \@files_type;
	}

	my @files = $widget->getOpenFile(%options);

	# Windows