← Back to branch summary

~ubuntu-branches/ubuntu/karmic/zim/karmic

« back to all changes in this revision

Viewing changes to lib/Zim/Win32.pm

  • Committer: Bazaar Package Importer
  • Author(s): Emfox Zhou
  • Date: 2007-08-25 13:04:42 UTC
  • mfrom: (1.1.7 upstream)
  • Revision ID: james.westby@ubuntu.com-20070825130442-q7xffffj9usah8b4
Tags: 0.20-1
http://bugs.debian.org/438612
* New upstream release
* Fix the bug which cause wrong internal links (Closes: #438612)

Show diffs side-by-side

added added

removed removed

Lines of Context:
lib/Zim/Win32.pm
1
 
package Zim::Win32;
2
 
 
3
 
use strict;
4
 
use Win32::Process;
5
 
require Cwd;
6
 
 
7
 
our $VERSION = '0.16';
8
 
 
9
 
=head1 NAME
10
 
 
11
 
Zim::Win32 - win32 specific routines for zim
12
 
 
13
 
=head1 DESCRIPTION
14
 
 
15
 
This module contains some routines that are specific
16
 
for the windows platform.
17
 
 
18
 
=cut
19
 
 
20
 
## Spawning processes ##
21
 
 
22
 
$Zim::GUI::DEFAULTS{browser} = 'firefox.exe';
23
 
$Zim::GUI::DEFAULTS{file_browser} = 'explorer.exe';
24
 
 
25
 
*Zim::GUI::Component::_exec = sub {
26
 
        my ($self, @args) = @_;
27
 
        my ($prog, $cmdline);
28
 
        if (@args > 1) {
29
 
                $cmdline = join ' ', map {/\s/ ? qq/"$_"/ : $_} @args;
30
 
                $prog = $args[0];
31
 
        }
32
 
        else {
33
 
                $cmdline = $args[0];
34
 
                $args[0] =~ /^(['"])(.+?)\1|^(\S+)/;
35
 
                $prog = $2 || $3;
36
 
        }
37
 
        $prog = _lookup_exec($self, $prog) unless $prog =~ /\\/;
38
 
        return unless $prog;
39
 
        
40
 
        warn "Executing $prog, $cmdline\n";
41
 
        my $ProcessObj;
42
 
        Win32::Process::Create(
43
 
                $ProcessObj, $prog, $cmdline, 0, NORMAL_PRIORITY_CLASS, "." );
44
 
};
45
 
 
46
 
sub _lookup_exec {
47
 
        my ($self, $prog) = @_;
48
 
        for (split /;/, $ENV{PATH}) {
49
 
                my $try = File::Spec->catfile($_, $prog);
50
 
                return $try if -f $try;
51
 
        }
52
 
        return $self->error_dialog("Could not find program: $prog");
53
 
}
54
 
 
55
 
## File name parsing ##
56
 
 
57
 
# copy old code
58
 
my $_abs_path = *Zim::File::abs_path{CODE};
59
 
my $_parse_uri = *Zim::File::parse_uri{CODE};
60
 
 
61
 
# Turn /foo into C:/foo
62
 
# wrap unix abs_path function by using /C:/path
63
 
 
64
 
*Zim::File::abs_path = sub {
65
 
        my ($class, $file, $ref) = @_;
66
 
        
67
 
        if ($file =~ m#file:/#) { $file = $class->parse_uri($file) }
68
 
        else { $file =~ s#\\#/#g } # foo\bar => foo/bar
69
 
        
70
 
        $file =~ s#^([a-z]:/)#/$1#i; # C:/foo => /C:/foo
71
 
        $file = $_abs_path->($class, $file, $ref);
72
 
        $file =~ s#^/+([a-z]:/)#$1#i; # /C:foo => C:/foo
73
 
        
74
 
        return $file unless $file =~ m#^/#i;
75
 
 
76
 
        $ref ||= Cwd::cwd();
77
 
        my ($vol, undef, undef) = File::Spec->splitpath($ref);
78
 
        return $vol.$file;
79
 
};
80
 
 
81
 
# support file:///C:/path
82
 
# translate file:////host/share => smb://host/share
83
 
 
84
 
*Zim::File::parse_uri = sub {
85
 
        my $class = shift;
86
 
        my $file = shift;
87
 
        $file =~ m#^file:/# or return $file;
88
 
        return $file if $file =~ s#^file:////(?!/)#smb://#;
89
 
        $file = $_parse_uri->($class, $file);
90
 
        $file =~ s#^/+([a-z]:/)#$1#i;
91
 
        return $file;
92
 
};
93
 
 
94
 
*Zim::File::localize = sub {
95
 
        my $file = pop;
96
 
        if    ($file =~ s#^smb://+##) { $file = '\\\\'.$file }
97
 
        elsif ($file =~ m#^\w[\w\+\-\.]+:/#) { return $file }
98
 
        elsif ($file =~ m#^/#) {
99
 
                my $cwd = Cwd::cwd();
100
 
                my ($vol, undef, undef) = File::Spec->splitpath($cwd);
101
 
                $file = $vol.$file;
102
 
        }
103
 
        $file =~ s#/+#\\#g;
104
 
        return $file;
105
 
};
106
 
 
107
 
1;
108
 
 
109
 
__END__
110
 
 
111
 
=head1 AUTHOR
112
 
 
113
 
Jaap Karssenberg (Pardus) E<lt>pardus@cpan.orgE<gt>
114
 
 
115
 
Copyright (c) 2006 Jaap G Karssenberg. All rights reserved.
116
 
This program is free software; you can redistribute it and/or
117
 
modify it under the same terms as Perl itself.
118
 
 
119
 
=head1 SEE ALSO
120
 
 
121
 
=cut
122