1use Prima; 2use strict; 3use warnings; 4 5package Prima::sys::win32::FileDialog; 6use vars qw(@ISA); 7@ISA = qw(Prima::Component); 8use Prima::Utils; 9use Encode; 10 11return 1 if Prima::Application-> get_system_info->{apc} != apc::Win32; 12 13sub profile_default 14{ 15 return { 16 %{$_[ 0]-> SUPER::profile_default}, 17 18 defaultExt => '', 19 fileName => '', 20 filter => [[ 'All files' => '*.*']], 21 filterIndex => 0, 22 directory => '.', 23 24 createPrompt => 0, 25 multiSelect => 0, 26 noReadOnly => 0, 27 noTestFileCreate => 0, 28 overwritePrompt => 1, 29 pathMustExist => 1, 30 fileMustExist => 1, 31 showHelp => 0, 32 33 openMode => 1, 34 text => undef, 35 } 36} 37 38sub init 39{ 40 my $self = shift; 41 my %profile = $self-> SUPER::init(@_); 42 $self-> {flags} = { 43 HIDEREADONLY => 1, 44 EXPLORER => 1, 45 }; 46 for ( qw( filterIndex openMode)) { $self->{$_}=$profile{$_} } 47 for ( qw( defaultExt filter directory multiSelect 48 createPrompt fileMustExist noReadOnly noTestFileCreate 49 overwritePrompt pathMustExist showHelp 50 )) { $self->$_($profile{$_}) } 51 return %profile; 52} 53 54sub quoted_split 55{ 56 my @ret; 57 $_ = $_[0]; 58 s/(\\[^\\\s])/\\$1/g; 59 study; 60 { 61 /\G\s+/gc && redo; 62 /\G((?:[^\\\s]|\\.)+)\s*/gc && do { 63 my $z = $1; 64 $z =~ s/\\(.)/$1/g; 65 push(@ret, $z); 66 redo; 67 }; 68 /\G(\\)$/gc && do { push(@ret, $1); redo; }; 69 } 70 return @ret; 71} 72 73sub filter 74{ 75 if ( $#_) { 76 my $self = $_[0]; 77 my @filter = @{$_[1]}; 78 @filter = [[ '' => '*']] unless scalar @filter; 79 my @exts; 80 my @mdts; 81 for ( @filter) { 82 push @exts, $$_[0]; 83 push @mdts, $$_[1]; 84 } 85 $self-> {filterIndex} = scalar @exts - 1 86 if $self-> { filterIndex} >= scalar @exts; 87 $self-> {filter} = \@filter; 88 } else { 89 return @{$_[0]-> {filter}}; 90 } 91} 92 93sub filterIndex 94{ 95 if ( $#_) { 96 $_[0]-> {filterIndex} = $_[1]; 97 } else { 98 return $_[0]-> {filterIndex}; 99 } 100} 101 102sub directory 103{ 104 return $_[0]->{directory} unless $#_; 105 $_[0]->{directory} = $_[1]; 106} 107 108sub createPrompt 109{ 110 return $_[0]->{flags}->{CREATEPROMPT} unless $#_; 111 $_[0]->{flags}->{CREATEPROMPT} = $_[1]; 112} 113 114sub multiSelect 115{ 116 return $_[0]->{flags}->{ALLOWMULTISELECT} unless $#_; 117 $_[0]->{flags}->{ALLOWMULTISELECT} = $_[1]; 118} 119 120sub noReadOnly 121{ 122 return $_[0]->{flags}->{NOREADONLYRETURN} unless $#_; 123 $_[0]->{flags}->{NOREADONLYRETURN} = $_[1]; 124} 125 126sub noTestFileCreate 127{ 128 return $_[0]->{flags}->{NOTESTFILECREATE} unless $#_; 129 $_[0]->{flags}->{NOTESTFILECREATE} = $_[1]; 130} 131 132sub overwritePrompt 133{ 134 return $_[0]->{flags}->{OVERWRITEPROMPT} unless $#_; 135 $_[0]->{flags}->{OVERWRITEPROMPT} = $_[1]; 136} 137 138sub pathMustExist 139{ 140 return $_[0]->{flags}->{PATHMUSTEXIST} unless $#_; 141 $_[0]->{flags}->{PATHMUSTEXIST} = $_[1]; 142} 143 144sub fileMustExist 145{ 146 return $_[0]->{flags}->{FILEMUSTEXIST} unless $#_; 147 $_[0]->{flags}->{FILEMUSTEXIST} = $_[1]; 148} 149 150sub showHelp 151{ 152 return $_[0]->{flags}->{SHOWHELP} unless $#_; 153 $_[0]->{flags}->{SHOWHELP} = $_[1]; 154} 155 156sub fileName 157{ 158 unless ( $#_) { 159 return $_[0]->{fileName} unless $_[0]->multiSelect; 160 my @s = quoted_split( $_[0]-> {fileName}); 161 return $s[0] unless wantarray; 162 return @s; 163 } 164 $_[0]->{fileName} = $_[1]; 165} 166 167sub defaultExt 168{ 169 return $_[0]->{defaultExt} unless $#_; 170 $_[0]->{defaultExt} = $_[1]; 171} 172 173sub openMode 174{ 175 return $_[0]->{openMode} unless $#_; 176 $_[0]->{openMode} = $_[1]; 177} 178 179sub text 180{ 181 return $_[0]->{text} unless $#_; 182 $_[0]->{text} = $_[1]; 183} 184 185# dummies 186sub sorted { 1 } 187sub showDotFiles { 1 } 188 189# mere callbacks if someone wants these to inherit 190sub ok {} 191sub cancel {} 192 193sub _set 194{ 195 my @cmd = @_; 196 for my $c ( @cmd ) { 197 unless ( Encode::is_utf8($c)) { 198 my $v = Prima::Utils::local2sv($c); 199 $c = $v if defined $v; 200 } 201 $c = Encode::encode('utf-8', $c); 202 } 203 my $cmd = shift @cmd; 204 Prima::Application-> sys_action( "win32.OpenFile.$cmd=".join('', @cmd)); 205} 206 207sub _get 208{ 209 my $cmd = shift; 210 $cmd = Prima::Application-> sys_action( "win32.OpenFile.$cmd"); 211 return Encode::decode('utf-8', $cmd); 212} 213 214sub execute 215{ 216 my $self = $_[0]; 217 218 _set( flags => join(',', grep { $self->{flags}->{$_}} keys %{$self->{flags}})); 219 _set( filters => join("\0", map { "$$_[0] ($$_[1])\0$$_[1]" } @{$self->{filter}}) . "\0"); 220 _set( filterindex => ($self->{filterIndex}+1)); 221 my $dir = $self->{directory}; 222 $dir =~ s/\//\\/g; 223 224 _set( directory => $dir); 225 _set( defext => $self->{defaultExt}); 226 _set( title => $self->{text} // 'NULL'); 227 my $ret = _get($self->{openMode} ? 'open' : 'save'); 228 if ( !defined $ret) { 229 $self-> cancel; 230 return wantarray ? () : undef; 231 } 232 $self-> {directory} = $ret; 233 $self-> {directory} =~ s/(\\|\/)[^\\\/]+$//; 234 $self-> {directory} =~ s/\\/\//g; 235 $self-> {directory} =~ s/\s+$//; 236 $self-> {directory} .= '/' unless $self-> {directory} =~ /\/$/; 237 $self-> {fileName} = $ret; 238 if ( $self-> multiSelect) { 239 $self-> {fileName} = join( ' ', map { 240 s/\\/\//g; 241 $_ = $self->{directory} . $_ unless m/^\w\:/; # win32 absolute path, if any 242 s/([\\\s])/\\$1/g; 243 $_; 244 } quoted_split($self-> {fileName})); 245 } else { 246 $self-> {fileName} =~ s/\\/\//g; 247 } 248 $self-> {filterIndex} = _get('filterindex')-1; 249 $self-> ok; 250 return $self-> fileName; 251} 252 253package Prima::sys::win32::OpenDialog; 254use vars qw(@ISA); 255@ISA = qw(Prima::sys::win32::FileDialog); 256 257package Prima::sys::win32::SaveDialog; 258use vars qw(@ISA); 259@ISA = qw(Prima::sys::win32::FileDialog); 260 261sub profile_default 262{ 263 return { %{$_[ 0]-> SUPER::profile_default}, 264 openMode => 0, 265 fileMustExist => 0, 266 } 267} 268 2691; 270 271=head1 NAME 272 273Prima::sys::win32::FileDialog - Windows file system dialogs. 274 275=head1 DESCRIPTION 276 277The module mimics Prima file dialog classes C<Prima::Dialog::OpenDialog> 278and C<Prima::Dialog::SaveDialog>, defined in L<Prima::Dialog::FileDialog>. The 279class names registered in the module are the same, but in C<Prima::sys::win32> 280namespace. 281 282=head1 AUTHOR 283 284Dmitry Karasik, E<lt>dmitry@karasik.eu.orgE<gt>. 285 286=head1 SEE ALSO 287 288L<Prima::Dialog::FileDialog> 289 290=cut 291 292 293