view release on metacpan or  search on metacpan

Prima/sys/gtk/FileDialog.pm  view on Meta::CPAN

{
	return $_[0]->{fileMustExist} unless $#_;
	$_[0]->{fileMustExist} = $_[1];
}

sub noTestFileCreate
{
	return $_[0]->{noTestFileCreate} unless $#_;
	$_[0]->{noTestFileCreate} = $_[1];
}

sub createPrompt
{
	return $_[0]->{createPrompt} unless $#_;
	$_[0]->{createPrompt} = $_[1];
}

sub noReadOnly
{
	return $_[0]->{noReadOnly} unless $#_;
	$_[0]->{noReadOnly} = $_[1];
}

# dummies
sub sorted { 1 }
sub showHelp { 0 }

# mere callbacks if someone wants these to inherit
sub ok {}
sub cancel {}

sub execute
{
	my $self = $_[0];

	DIALOG: while ( 1) {
		Prima::Application-> sys_action( "gtk.OpenFile.$_=". $self-> {$_})
			for qw(multi_select overwrite_prompt show_hidden);
		Prima::Application-> sys_action( 'gtk.OpenFile.filters=' .
			join("\0", map { "$$_[0] ($$_[1])\0$$_[1]" } @{$self->{filter}}) . "\0\0");
		Prima::Application-> sys_action( 'gtk.OpenFile.filterindex=' .
			($self->{filterIndex}));
		Prima::Application-> sys_action( 'gtk.OpenFile.directory=' .
			$self->{directory});
		Prima::Application-> sys_action( 'gtk.OpenFile.title=' .
			(defined $self->{text} ? $self->{text} : ''));
		my $ret = Prima::Application-> sys_action( 'gtk.OpenFile.'.
			($self->{openMode}?'open':'save'));
		if ( !defined $ret) {
			$self-> cancel;
			return wantarray ? () : undef;
		}
		$self-> {directory}   = Prima::Application-> sys_action( 'gtk.OpenFile.directory');
		$self-> {directory}  .= '/' unless $self-> {directory} =~ /\/$/;
		$self-> {fileName}    = $ret;
		$self-> {filterIndex} = Prima::Application-> sys_action( 'gtk.OpenFile.filterindex');

		for (qw(directory fileName)) {
			local $SIG{__DIE__};
			my $p;
			eval { $p = Encode::decode('UTF-8', $self->{$_}, Encode::FB_CROAK ) };
			next if $@;
			$self->{$_} = $p;
		}

		# emulate some flags now
		if ( $self-> {pathMustExist}) {
			unless ( -d $self-> {directory}) {
				message_box( $self-> text, "Directory $self->{directory} does not exist", mb::OK | mb::Error);
				next DIALOG;
			}
		}

		for my $file ( $self-> fileName) {
			if ( $self-> {fileMustExist}) {
				next if -f $file;
				message_box( $self-> text, "File $file does not exist", mb::OK | mb::Error);
				next DIALOG;
			}

			if ( $self-> {openMode}) {
				if ( $self-> {createPrompt}) {
					if ( Prima::MsgBox::message_box( $self-> text,
						"File $file does not exists. Create?",
						mb::OKCancel|mb::Information
					) != mb::OK) {
						$self-> cancel;
						return wantarray ? () : undef;
					}
				}
			} else {
				if ( $self-> {noReadOnly} && !(-w $file)) {
					message_box(
						$self-> text,
						"File $file is read only",
						mb::OK | mb::Error
					);
					next DIALOG;
				}

				if ( not $self-> {noTestFileCreate}) {
					if ( open FILE, ">>$file") {
						close FILE;
					} else {
						message_box( $self-> text,
							"Cannot create file $file: $!", mb::OK | mb::Error);
						next DIALOG;
					}
				}
			}
		}

		last;
	}
	$self-> ok;
	return $self-> fileName;
}

package Prima::sys::gtk::OpenDialog;
use vars qw(@ISA);
@ISA = qw(Prima::sys::gtk::FileDialog);