source: gs2-extensions/parallel-building/trunk/src/perllib/cpan/Win32/Shortcut.pm@ 24626

Last change on this file since 24626 was 24626, checked in by jmt12, 13 years ago

An (almost) complete copy of the perllib directory from a (circa SEP2011) head checkout from Greenstone 2 trunk - in order to try and make merging in this extension a little easier later on (as there have been some major changes to buildcol.pl commited in the main trunk but not in the x64 branch)

File size: 8.8 KB
Line 
1package Win32::Shortcut;
2#######################################################################
3#
4# Win32::Shortcut - Perl Module for Shell Link Interface
5# ^^^^^^^^^^^^^^^
6# This module creates an object oriented interface to the Win32
7# Shell Links (IShellLink interface).
8#
9# Version: 0.03 (07 Apr 1997)
10#
11#######################################################################
12
13require Exporter; # to export the constants to the main:: space
14require DynaLoader; # to dynuhlode the module.
15
16@ISA= qw( Exporter DynaLoader );
17@EXPORT = qw(
18 SW_SHOWMAXIMIZED
19 SW_SHOWMINNOACTIVE
20 SW_SHOWNORMAL
21);
22
23
24#######################################################################
25# This AUTOLOAD is used to 'autoload' constants from the constant()
26# XS function. If a constant is not found then control is passed
27# to the AUTOLOAD in AutoLoader.
28#
29
30sub AUTOLOAD {
31 my($constname);
32 ($constname = $AUTOLOAD) =~ s/.*:://;
33 #reset $! to zero to reset any current errors.
34 local $! = 0;
35 my $val = constant($constname, @_ ? $_[0] : 0);
36 if ($! != 0) {
37
38 # [dada] This results in an ugly Autoloader error
39
40 #if ($! =~ /Invalid/) {
41 # $AutoLoader::AUTOLOAD = $AUTOLOAD;
42 # goto &AutoLoader::AUTOLOAD;
43 #} else {
44
45 # [dada] ... I prefer this one :)
46
47 ($pack, $file, $line) = caller;
48 undef $pack; # [dada] and get rid of "used only once" warning...
49 die "Win32::Shortcut::$constname is not defined, used at $file line $line.";
50
51 #}
52 }
53 eval "sub $AUTOLOAD { $val }";
54 goto &$AUTOLOAD;
55}
56
57
58#######################################################################
59# STATIC OBJECT PROPERTIES
60#
61$VERSION = "0.03";
62
63#######################################################################
64# PUBLIC METHODS
65#
66
67#======== ### CLASS CONSTRUCTOR
68sub new {
69#========
70 my($class, $file) = @_;
71 my $self = {};
72 my $ilink = 0;
73 my $ifile = 0;
74
75 ($ilink, $ifile) = _Instance();
76
77 if($ilink and $ifile) {
78 $self->{'ilink'} = $ilink;
79 $self->{'ifile'} = $ifile;
80 bless $self;
81 # Initialize properties
82 $self->{'File'} = "";
83 $self->{'Path'} = "";
84 $self->{'Arguments'} = "";
85 $self->{'WorkingDirectory'} = "";
86 $self->{'Description'} = "";
87 $self->{'ShowCmd'} = 0;
88 $self->{'Hotkey'} = 0;
89 $self->{'IconLocation'} = "";
90 $self->{'IconNumber'} = 0;
91
92 $self->Load($file) if $file;
93
94 } else {
95 return undef;
96 }
97 $self;
98}
99
100#=========
101sub Load {
102#=========
103 my($self, $file) = @_;
104 return undef unless ref($self);
105
106 my $result = _Load($self->{'ilink'}, $self->{'ifile'}, $file);
107
108 if(defined($result)) {
109
110 # fill the properties of $self
111 $self->{'File'} = $file;
112 $self->{'Path'} = _GetPath($self->{'ilink'}, $self->{'ifile'},0);
113 $self->{'ShortPath'} = _GetPath($self->{'ilink'}, $self->{'ifile'},1);
114 $self->{'Arguments'} = _GetArguments($self->{'ilink'}, $self->{'ifile'});
115 $self->{'WorkingDirectory'} = _GetWorkingDirectory($self->{'ilink'}, $self->{'ifile'});
116 $self->{'Description'} = _GetDescription($self->{'ilink'}, $self->{'ifile'});
117 $self->{'ShowCmd'} = _GetShowCmd($self->{'ilink'}, $self->{'ifile'});
118 $self->{'Hotkey'} = _GetHotkey($self->{'ilink'}, $self->{'ifile'});
119 ($self->{'IconLocation'},
120 $self->{'IconNumber'}) = _GetIconLocation($self->{'ilink'}, $self->{'ifile'});
121 }
122 return $result;
123}
124
125
126#========
127sub Set {
128#========
129 my($self, $path, $arguments, $dir, $description, $show, $hotkey,
130 $iconlocation, $iconnumber) = @_;
131 return undef unless ref($self);
132
133 $self->{'Path'} = $path;
134 $self->{'Arguments'} = $arguments;
135 $self->{'WorkingDirectory'} = $dir;
136 $self->{'Description'} = $description;
137 $self->{'ShowCmd'} = $show;
138 $self->{'Hotkey'} = $hotkey;
139 $self->{'IconLocation'} = $iconlocation;
140 $self->{'IconNumber'} = $iconnumber;
141 return 1;
142}
143
144
145#=========
146sub Save {
147#=========
148 my($self, $file) = @_;
149 return undef unless ref($self);
150
151 return undef if not $file and not $self->{'File'};
152 $file = $self->{'File'} if not $file;
153
154 _SetPath($self->{'ilink'}, $self->{'ifile'}, $self->{'Path'});
155 _SetArguments($self->{'ilink'}, $self->{'ifile'}, $self->{'Arguments'});
156 _SetWorkingDirectory($self->{'ilink'}, $self->{'ifile'}, $self->{'WorkingDirectory'});
157 _SetDescription($self->{'ilink'}, $self->{'ifile'}, $self->{'Description'});
158 _SetShowCmd($self->{'ilink'}, $self->{'ifile'}, $self->{'ShowCmd'});
159 _SetHotkey($self->{'ilink'}, $self->{'ifile'}, $self->{'Hotkey'});
160 _SetIconLocation($self->{'ilink'}, $self->{'ifile'},
161 $self->{'IconLocation'}, $self->{'IconNumber'});
162
163 my $result = _Save($self->{'ilink'}, $self->{'ifile'}, $file);
164 return $result;
165}
166
167#============
168sub Resolve {
169#============
170 my($self, $flags) = @_;
171 return undef unless ref($self);
172 $flags = 1 unless defined($flags);
173 my $result = _Resolve($self->{'ilink'}, $self->{'ifile'}, $flags);
174 return $result;
175}
176
177
178#==========
179sub Close {
180#==========
181 my($self) = @_;
182 return undef unless ref($self);
183
184 my $result = _Release($self->{'ilink'}, $self->{'ifile'});
185 $self->{'released'} = 1;
186 return $result;
187}
188
189#=========
190sub Path {
191#=========
192 my($self, $value) = @_;
193 return undef unless ref($self);
194
195 if(not defined($value)) {
196 return $self->{'Path'};
197 } else {
198 $self->{'Path'} = $value;
199 }
200 return $self->{'Path'};
201}
202
203#==============
204sub ShortPath {
205#==============
206 my($self) = @_;
207 return undef unless ref($self);
208 return $self->{'ShortPath'};
209}
210
211#==============
212sub Arguments {
213#==============
214 my($self, $value) = @_;
215 return undef unless ref($self);
216
217 if(not defined($value)) {
218 return $self->{'Arguments'};
219 } else {
220 $self->{'Arguments'} = $value;
221 }
222 return $self->{'Arguments'};
223}
224
225#=====================
226sub WorkingDirectory {
227#=====================
228 my($self, $value) = @_;
229 return undef unless ref($self);
230
231 if(not defined($value)) {
232 return $self->{'WorkingDirectory'};
233 } else {
234 $self->{'WorkingDirectory'} = $value;
235 }
236 return $self->{'WorkingDirectory'};
237}
238
239
240#================
241sub Description {
242#================
243 my($self, $value) = @_;
244 return undef unless ref($self);
245
246 if(not defined($value)) {
247 return $self->{'Description'};
248 } else {
249 $self->{'Description'} = $value;
250 }
251 return $self->{'Description'};
252}
253
254#============
255sub ShowCmd {
256#============
257 my($self, $value) = @_;
258 return undef unless ref($self);
259
260 if(not defined($value)) {
261 return $self->{'ShowCmd'};
262 } else {
263 $self->{'ShowCmd'} = $value;
264 }
265 return $self->{'ShowCmd'};
266}
267
268#===========
269sub Hotkey {
270#===========
271 my($self, $value) = @_;
272 return undef unless ref($self);
273
274 if(not defined($value)) {
275 return $self->{'Hotkey'};
276 } else {
277 $self->{'Hotkey'} = $value;
278 }
279 return $self->{'Hotkey'};
280}
281
282#=================
283sub IconLocation {
284#=================
285 my($self, $value) = @_;
286 return undef unless ref($self);
287
288 if(not defined($value)) {
289 return $self->{'IconLocation'};
290 } else {
291 $self->{'IconLocation'} = $value;
292 }
293 return $self->{'IconLocation'};
294}
295
296#===============
297sub IconNumber {
298#===============
299 my($self, $value) = @_;
300 return undef unless ref($self);
301
302 if(not defined($value)) {
303 return $self->{'IconNumber'};
304 } else {
305 $self->{'IconNumber'} = $value;
306 }
307 return $self->{'IconNumber'};
308}
309
310#============
311sub Version {
312#============
313 # [dada] to get rid of the "used only once" warning...
314 return $VERSION;
315}
316
317
318#######################################################################
319# PRIVATE METHODS
320#
321
322#============ ### CLASS DESTRUCTOR
323sub DESTROY {
324#============
325 my($self) = @_;
326
327 if(not $self->{'released'}) {
328 _Release($self->{'ilink'}, $self->{'ifile'});
329 }
330}
331
332#======== ### PACKAGE DESTRUCTOR
333sub END {
334#========
335 # print "Exiting...\n";
336 _Exit();
337}
338
339#######################################################################
340# dynamically load in the Shortcut.pll module.
341#
342
343bootstrap Win32::Shortcut;
344
345# Preloaded methods go here.
346
347#Currently Autoloading is not implemented in Perl for win32
348# Autoload methods go after __END__, and are processed by the autosplit program.
349
3501;
351__END__
352
Note: See TracBrowser for help on using the repository browser.