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.