~ubuntu-branches/ubuntu/utopic/padre/utopic

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
package Padre::Locker;

=pod

=head1 NAME

Padre::Locker - The Padre Multi-Resource Lock Manager

=cut

use 5.008;
use strict;
use warnings;
use Padre::Lock     ();
use Padre::DB       ();
use Padre::Constant ();
use Padre::Logger;

our $VERSION = '0.96';

sub new {
	my $class = shift;
	my $owner = shift;

	# Create the object
	my $self = bless {
		owner => $owner,

		# Padre::DB Transaction lock
		db_depth => 0,

		# Padre::Config Transaction lock
		config_depth => 0,

		# Padre::Wx::AuiManager Transaction lock
		aui_depth => 0,

		# Wx ->Update lock
		update_depth  => 0,
		update_locker => undef,

		# Wx "Busy" lock
		busy_depth  => 0,
		busy_locker => undef,

		# Padre ->refresh lock
		method_depth   => 0,
		method_pending => {},
	}, $class;
}

sub lock {
	Padre::Lock->new( shift, @_ );
}

sub locked {
	my $self  = shift;
	my $asset = shift;
	if ( $asset eq 'UPDATE' ) {
		return !!$self->{update_depth};
	} elsif ( $asset eq 'REFRESH' ) {
		return !!$self->{method_depth};
	} elsif ( $asset eq 'AUI' ) {
		return !!$self->{aui_depth};
	} elsif ( $asset eq 'BUSY' ) {
		return !!$self->{busy_depth};
	} elsif ( $asset eq 'CONFIG' ) {
		return !!$self->{config_depth};
	} else {
		return !!$self->{method_pending}->{$asset};
	}
}

# During Padre shutdown we should disable all forms of screen updating,
# once we have completed all user-interactive steps in the shutdown.
# Calling the shutdown method will permanently ignore any and all attempts
# to call refresh methods.
# This method does NOT ->Hide the actual application, that is left up to the
# shutdown process. This action just disables everything lock-related that
# might slow the shutdown process.
sub shutdown {
	my $self = shift;
	my $lock = $self->lock( 'UPDATE', 'AUI', 'REFRESH', 'CONFIG' );

	# If we have an update lock running, stop it manually now.
	# If we don't do this, Win32 Padre will segfault on exit.
	$self->{update_locker} = undef;

	$self->{shutdown} = 1;
}





######################################################################
# Locking Mechanism

# Database locking like this is only possible because Padre NEVER makes
# use of rollback. All bad database requests are considered fatal.

sub db_increment {
	my $self = shift;
	unless ( $self->{db_depth}++ ) {
		Padre::DB->begin;

		# Database operations we lock on are the most likely to
		# involve writes. So opportunistically prevent blocking
		# on filesystem sync confirmation. This should make
		# database write operations faster, at the risk of config.db
		# corruption if (and only if) there is a power outage,
		# operating system crash, or catastrophic hardware failure.
		Padre::DB->pragma( synchronous => 0 );
	}
	return;
}

sub db_decrement {
	my $self = shift;
	unless ( --$self->{db_depth} ) {
		Padre::DB->commit;
	}
	return;
}

sub config_increment {

	# my $self = shift;
	# unless ( $self->{config_depth}++ ) {
	# TO DO: Initiate config locking here
	# NOTE: Pretty sure we don't need to do anything specific
	# here for the config file stuff.
	# }
	return;
}

sub config_decrement {
	my $self = shift;
	unless ( --$self->{config_depth} ) {

		# Write the config file here
		$self->{owner}->config->write;
	}
	return;
}

sub update_increment {
	my $self = shift;
	unless ( $self->{update_depth}++ ) {

		# When a Wx application quits with ->Update locked, windows will
		# segfault. During shutdown, do not allow the application to
		# enable an update lock. This should be pointless anyway,
		# because the window shouldn't be visible.
		return if $self->{shutdown};

		# Locking for the first time
		# Version 2.8.12  of wxWidgets introduces some improvements to
		# wxAuiNotebook. The window will no longer carry out updates if
		# it is Frozen on win32 platform (Mark Dootson)
		### TODO This is an crude emergency hack, we need to find
		### something better than disabling all render optimisation.
		### Commented out to record for posterity, the forced Layout
		### solution below evades the bug but without the flickering.
		# if ( Wx::wxVERSION() >= 2.008012 and Padre::Constant::WIN32 ) {
		# $self->{update_locker} = 1;
		# } else {
		$self->{update_locker} = Wx::WindowUpdateLocker->new( $self->{owner} );

		# }
	}
	return;
}

sub update_decrement {
	my $self = shift;
	unless ( --$self->{update_depth} ) {
		return if $self->{shutdown};

		# Unlocked for the final time
		$self->{update_locker} = undef;

		# On Windows, we need to force layouts down to notebooks
		if (Padre::Constant::WIN32) {
			if ( Wx::wxVERSION() >= 2.008012 and $self->{owner} ) {
				my @notebook = grep { $_->isa('Wx::AuiNotebook') } $self->{owner}->GetChildren;
				$_->Layout foreach @notebook;
			}
		}
	}
	return;
}

sub aui_increment {
	my $self = shift;
	unless ( $self->{aui_depth}++ ) {
		return if $self->{shutdown};

		# Nothing to do at increment time
	}
	return;
}

sub aui_decrement {
	my $self = shift;
	unless ( --$self->{aui_depth} ) {
		return if $self->{shutdown};

		# Unlocked for the final time
		$self->{owner}->aui->Update;
		$self->{owner}->Layout;
	}
	return;
}

sub busy_increment {
	my $self = shift;
	unless ( $self->{busy_depth}++ ) {

		# If we are in shutdown, the application isn't painting anyway
		# (or possibly even visible) so don't put us into busy state.
		return if $self->{shutdown};

		# Locking for the first time
		$self->{busy_locker} = Wx::BusyCursor->new;
	}
	return;
}

sub busy_decrement {
	my $self = shift;
	unless ( --$self->{busy_depth} ) {
		return if $self->{shutdown};

		# Unlocked for the final time
		$self->{busy_locker} = undef;
	}
	return;
}

sub method_increment {
	$_[0]->{method_depth}++;
	$_[0]->{method_pending}->{ $_[1] }++ if $_[1];
	return;
}

sub method_decrement {
	my $self = shift;

	unless ( --$self->{method_depth} ) {

		# Once we start the shutdown process, don't refresh anything
		return if $self->{shutdown};

		# Optimise the refresh methods
		$self->method_trim;

		# Run all of the pending methods
		foreach ( keys %{ $self->{method_pending} } ) {
			next if $_ eq uc $_;

			# This call is sent into what is essentially
			# arbitrary code, and it's easy for exceptions
			# under here to cause the entire locking sub-system
			# to crash. Trap and ignore errors so we can attempt
			# to retain the integrity of the locking subsystem
			# as a whole.
			local $@;
			eval { $self->{owner}->$_(); };
			if ( DEBUG and $@ ) {
				TRACE("ERROR: '$@'");
			}
		}
		$self->{method_pending} = {};
	}

	return;
}

# Optimise the refresh by removing low level refresh methods that are
# contained within high level refresh methods we need to run anyway.
sub method_trim {
	my $self    = shift;
	my $pending = $self->{method_pending};
	if ( defined $pending->{refresh} ) {
		delete $pending->{refresh_menu};
		delete $pending->{refresh_toolbar};
		delete $pending->{refresh_notebook};
		delete $pending->{refresh_status};
		delete $pending->{refresh_functions};
		delete $pending->{refresh_directory};
		delete $pending->{refresh_syntax};
		delete $pending->{refresh_outline};
		delete $pending->{refresh_diff};
		delete $pending->{refresh_vcs};
		delete $pending->{refresh_title};
	}
	return;
}

1;

# Copyright 2008-2012 The Padre development team as listed in Padre.pm.
# LICENSE
# This program is free software; you can redistribute it and/or
# modify it under the same terms as Perl 5 itself.