Prima
view release on metacpan - search on metacpan
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);
view all matches for this distributionview release on metacpan - search on metacpan
( run in 0.342 second using v1.00-cache-2.02-grep-82fe00e-cpan-503542c4f10 )