# Copyright 2001-2004, Phill Wolf. See README. # Win32::ActAcc (Active Accessibility) package Win32::ActAcc::AO; use strict; use Win32::ActAcc qw(:ROLEs :EVENTs :STATEs :SELFLAGs); use Data::Dumper; use Carp; use Time::HiRes; use overload ( '""'=>\&describe ); our $accDoDefaultActionHook; # coderef # "Memoizing" means saving an accessible object's # contained-objects in its baggage for quick reference. # But if circular references result, # you may wish to turn off the memoizing. our $MEMOIZE_MEMBERS = 1; sub accDoDefaultAction { my $ao = shift; if (defined($accDoDefaultActionHook)) { &$accDoDefaultActionHook($ao); } if ($Win32::ActAcc::LOG_ACTIONS) { print STDERR "Action: default of $ao\n"; } $ao->accDoDefaultAction_(); } # testable('doActionIfDefault.not_default') # testable('doActionIfDefault.is_default') # in: AO, action name (as reported by get_accDefaultAction) # side_effect: performs action if default, else dies. sub doActionIfDefault { my $ao = shift; my $action = shift; my $defact = $ao->get_accDefaultAction() || ''; if ($action eq $defact) { $ao->accDoDefaultAction(); } else { croak("Cannot '$action' when the available action is '$defact'\n"); } } sub describe_meta { return "role:name {state,(location),id,hwnd}: defaultAction"; # keep synchronized with describe() } # format==1 suppresses location if AO is invisible. # format==1 suppresses ID if ID is 0. sub describe { my $ao = shift; my $format = shift || 0; # default to 0 if not specified my $name = $ao->get_accName(); my $role = "?"; my $outlineprefix = ""; my $ir = $ao->get_accRole(); $role = Win32::ActAcc::GetRoleText($ir); if ($ir == ROLE_SYSTEM_OUTLINEITEM()) { $outlineprefix='>'x($ao->get_accValue()); } my $state = "?"; my $allstate = $ao->get_accState(); if (!defined($allstate)) { $allstate = 0; } $state = Win32::ActAcc::GetStateTextComposite($allstate, ($format>0)); my $location; if (!($allstate & STATE_SYSTEM_INVISIBLE())) { my ($left, $top, $width, $height); ($left, $top, $width, $height) = $ao->accLocation(); if(defined($height)) { $location = "($left,$top,$width,$height)"; } } else { $location = ""; } my $hwnd = "(no HWND)"; my $h = $ao->WindowFromAccessibleObject(); if (defined($h)) { $hwnd = sprintf("HWND=%lx",$h); } my $itemID = ($format==0)?"(no ID)":""; if (defined($ao->get_itemID()) && ($ao->get_itemID()>0)) { $itemID = 'id=' . $ao->get_itemID(); } my $dfltAction = $ao->get_accDefaultAction() || ""; if (defined($dfltAction)) { $dfltAction=": " . $dfltAction;} if ($format==0) { $name = "(undef)" unless defined($name); } else { $name = "" unless defined($name); } $location = "(location error)" unless defined($location); # keep the string composition synchronized with describe_meta() return "$role:$outlineprefix$name {$state,$location,$itemID,$hwnd}$dfltAction"; } use Carp qw(croak verbose carp); use Data::Dumper; sub axis_iterator { my $self = shift; my $axis = shift || 'child'; my $pflags = shift || +{}; if ('child' eq $axis) { return $self->iterator($pflags); } elsif ('parent' eq $axis) { return new Win32::ActAcc::ArrayIterator($self, +[$self->parent()]); } elsif ('prune' eq $axis) { return undef; } else { die("Don't know what to do with axis $axis"); } } sub dig_R { my $ao = shift; my $pCriteriaList = shift; my $indent = shift; my $pflags = shift; my $pfound = shift; my $max = shift; # may be undef my $iterflags = shift; my $guard = shift; die unless defined($pfound); die if (defined($guard)); my ($crit, @morecrit) = @{$pCriteriaList}; my $axis = $$crit{'axis'} || 'child'; if ($$pflags{'trace'}) { print STDERR "${indent}Seeking $axis ".describeCriteria($crit)."\n"; } my $it = $ao->axis_iterator($axis, $iterflags); if (!$it || !$it->iterable()) { return; } $it->open(); while ( my $aoi = $it->nextAO() ) { my $expl = '?'; my $m = $aoi->match($crit, \$expl); if ($$pflags{'trace'}) { print STDERR ( "${indent}Match $aoi? " . ($m ? "yes":"no:$expl") ."\n" ); } # "match" should take options hash and do its own trace output. if ($m) { if (@morecrit) { $aoi->dig_R(\@morecrit, ' '.$indent, $pflags, $pfound, $max, $iterflags); } else { push(@{$pfound}, $aoi); } if (defined($max) && (@{$pfound} >= $max)) { if ($$pflags{'trace'}) { print STDERR "${indent}Got enough ($max).. cutting dig short\n"; } last; } } } if (defined($max) && 1==$max && 1==@{$pfound}) { $it->leaveOpen(1); } $it->close(); } # testable('dig.1_step') ## # testable('dig.N_step') ## # testable('dig.backtrack') # testable('dig.scalar_context.positive') ## # testable('dig.scalar_context.negative') ## # testable('dig.scalar_context.min0.negative') # testable('dig.scalar_context.outline') ## # testable('dig.array_context.none') ## # testable('dig.array_context.capped') # testable('dig.array_context.min_met') ## # testable('dig.array_context.min_not_met') ## sub dig { my $self = shift; my $path = shift; my $pflags = shift || +{}; croak "Criteria must be a list" unless ref($path) eq 'ARRAY'; croak "Flags must be a hash" unless ref($pflags) eq 'HASH'; my $min = defined($$pflags{'min'}) ? $$pflags{'min'} : 1; my $max = !wantarray ? 1 : $$pflags{'max'}; # undef for no limit my @path = map((ref eq 'HASH' || (UNIVERSAL::isa($_, 'Win32::ActAcc::Test'))) ? $_ : matchHashUpCriteria($_) , ref($path)eq'ARRAY' ? @$path : ((),$path)); if ($$pflags{'trace'}) { print STDERR "dig: path=\n"; print STDERR map(describeCriteria($_)."\n", @path); } my $iterflags = +{ # Infer 'active' flag if caller didn't specify it. 'active'=>(exists($$pflags{'active'}) ? $$pflags{'active'} : 1), # Convey 'nav' and 'perfunctory' if caller specified them. map( ((exists($$pflags{$_}) ? ($_=>$$pflags{$_}) : ()),) , ('nav', 'perfunctory')) }; my @found; $self->dig_R(\@path, ' ', $pflags, \@found, $max, $iterflags); if (@found < $min) { croak("Fewer than $min found (".(0+@found).")"); } if (wantarray) { return @found; } else { return $found[0]; } } sub center { my $self = shift; my $rv = undef; my ($left, $top, $width, $height) = $self->accLocation(); if (defined($left) && defined($top) && defined($width) && defined($height)) { my $centerX = $left + int($width/2); my $centerY = $top + int($height/2); $rv = +[ $centerX, $centerY ]; } return $rv; } sub has_clickable_location { my $self = shift; my $rv = undef; if ($self->visible()) { my ($left, $top, $width, $height) = $self->accLocation(); $rv = (defined($left) && $width && $height); } return $rv; } # testable('AO::click') # die if AO invisible sub click { my $self = shift; my $peventMonitorOptional = shift; croak("Can't click an invisible AO") unless $self->has_clickable_location(); my $c = $self->center(); Win32::ActAcc::click(@$c,$peventMonitorOptional); } # testable('AO::rightclick') # die if AO invisible sub rightclick { my $self = shift; my $peventMonitorOptional = shift; die if (!$self->has_clickable_location()); my $c = $self->center(); Win32::ActAcc::rightclick(@$c,$peventMonitorOptional); } # testable('AO::mouseover') # harmless/no action if the AO is not visible. sub mouseover { my $self = shift; my $peventMonitorOptional = shift; if ($self->has_clickable_location()) { my $c = $self->center(); Win32::ActAcc::mouseover($$c[0]-2, $$c[1]-2, undef); # pause ever-so-briefly - so app might tend to the mousemove Time::HiRes::sleep(0.01); Win32::ActAcc::mouseover(@$c,$peventMonitorOptional); # pause ever-so-briefly - so app might tend to the mousemove Time::HiRes::sleep(0.01); } } # testable('AO::context_menu') sub context_menu { my $self = shift; $self->rightclick(); my $cxmenu = Win32::ActAcc::waitForEvent(+{'event'=>EVENT_SYSTEM_MENUPOPUPSTART()}, 5); croak("No context menu found") unless defined($cxmenu); return $cxmenu; } sub debug_tree { my $ao = shift; $ao->tree(sub{my $ao=shift;my $tree=shift;print ' 'x($tree->level()).$ao->describe."\n";}); } # TODO - Convert all matching to use the Test packages. sub match { my $self = shift; my $crit = shift; # string(name OR {role}name) OR regexp OR coderef # OR hash{code,name(string/regexp),role (numeric),state} my $mismatch = shift; my $rv = $self->match_($crit,$mismatch ) || ''; #print STDERR "match OF ".$self->describe() ." AGAINST " .Dumper($crit). " YIELDS ".$rv ."\n"; return $rv; } sub matchHashUpCriteria { my $crit = shift; # string(name OR {role}name) OR regexp OR coderef # OR hash{code,name(string/regexp),role (numeric),state} my $rcrit = ref($crit); if ($rcrit eq 'HASH') { if (exists($$crit{'rolename'})) { $$crit{'role'}=Win32::ActAcc::RoleFriendlyNameToNumber($$crit{'rolename'}); delete $$crit{'rolename'}; } return $crit; } elsif ($rcrit eq 'Regexp') { return +{'name'=>$crit, 'visible'=>1}; } elsif ($rcrit eq 'CODE') { return +{'code'=>$crit, 'visible'=>1}; } elsif ($rcrit eq '') { my $seekingRole = undef; my $seekingName = $crit || ''; if ($seekingName =~ /^\{(.*)\}(.*)/) { my $rolefrn = $1; $seekingRole = Win32::ActAcc::RoleFriendlyNameToNumber($rolefrn); croak "No such role as $rolefrn" unless defined($seekingRole); $seekingName = $2; } if (0==length($seekingName)) { $seekingName = undef; } my %h; $h{'name'}=$seekingName unless !defined($seekingName); $h{'role'}=$seekingRole unless !defined($seekingRole); $h{'visible'}=1; return \%h; } else { croak "Don't know what to do with criteria ref $rcrit"; } } sub describeDigPath { my $path = shift; return join('/', map(describeCriteria($_), @$path)); } sub describeCriteria { my $nhcrit = shift; my $rv; if (UNIVERSAL::isa($nhcrit, 'Win32::ActAcc::Test')) { $rv = $nhcrit->describe(1); } else { my @rv; my $crit = matchHashUpCriteria($nhcrit); foreach (qw(name get_accRole rolename get_accName get_accValue get_accDescription get_accHelp get_accDefaultAction axis nonnegative_coordinates)) { if (exists($$crit{$_})) { push @rv, "$_='$$crit{$_}'"; } } foreach (qw(WindowFromAccessibleObject HWND)) { if (exists($$crit{$_})) { push @rv, sprintf("$_=%08x", $$crit{$_}); } } if (exists($$crit{'role'})) { push @rv, "role=". Win32::ActAcc::GetRoleText($$crit{'role'}); } if (exists($$crit{'state'}) && exists(${$$crit{'state'}}{'value'})) { push @rv, "state-value=". Win32::ActAcc::GetStateTextComposite(${$$crit{'state'}}{'value'}); } if (exists($$crit{'rolemask'})) { push @rv, explain_rolemask_rolebits($$crit{'rolemask'}, $$crit{'rolebits'}); } if (exists($$crit{'code'})) { push @rv, "code(...)"; } if (exists($$crit{'test'})) { push @rv, ('['.$$crit{'test'}->describe().']'); } $rv = join(',',@rv); if ($rv eq '' ) { $rv = "match anything (no restrictions)" } } return $rv; } sub explain_rolemask_rolebits { my $rolemask = shift; my $rolebits = shift; my @allow; my @deny; my $maskt = unpack('b*', $rolemask); my $bitst = unpack('b*', $rolebits); my $imax = length($maskt); for (my $i = $imax-1; $i >= 0; $i--) { if ('1'eq substr($maskt,$i,1)) { if ((length($bitst)>$i) && ('1'eq substr($bitst,$i,1))) { push @allow, $i; } else { push @deny, $i; } } } my $rv; if (@allow <= @deny) { $rv = "role(". join(',', map(Win32::ActAcc::GetRoleText($_), @allow)) .")"; } else { $rv = "role-NOT(". join(',', map(Win32::ActAcc::GetRoleText($_), @deny)) .")"; } return $rv; } sub match_string_or_re { my $candidate = shift || ''; # string my $pattern = shift; # string or regexp if (ref($pattern) eq 'Regexp') { return ($candidate =~ /$pattern/); } else { return ($candidate eq $pattern); } } sub match_ { my $self = shift; my $crit = shift; # string(name OR {role}name) OR regexp OR coderef # OR hash{code,name(string/regexp),role (numeric),state} my $mismatch = shift; my $rcrit = ref($crit); if (UNIVERSAL::isa($crit, 'Win32::ActAcc::Test')) { return $crit->test($self); } elsif ($rcrit eq 'HASH') { # Normalize. Translate rolename->role, visible->state. # We *alter the hash we were given* so if it's reused, # this step doesn't need to be done again. if (exists($$crit{'rolename'})) { $$crit{'role'}=Win32::ActAcc::RoleFriendlyNameToNumber($$crit{'rolename'}); delete $$crit{'rolename'}; } if (exists($$crit{'get_accRole'})) { $$crit{'role'}=$$crit{'get_accRole'}; delete $$crit{'get_accRole'}; } if (exists($$crit{'get_accName'})) { $$crit{'name'}=$$crit{'get_accName'}; delete $$crit{'get_accName'}; } if (exists($$crit{'WindowFromAccessibleObject'})) { $$crit{'HWND'}=$$crit{'WindowFromAccessibleObject'}; delete $$crit{'WindowFromAccessibleObject'}; } if (exists($$crit{'state_has'})) { if (!exists($$crit{'state'})) { $$crit{'state'} = +{ 'mask'=>0, 'value'=>0 }; } ${$$crit{'state'}}{'mask'} |= $$crit{'state_has'}; ${$$crit{'state'}}{'value'} |= $$crit{'state_has'}; delete $$crit{'state_has'}; } if (exists($$crit{'state_lacks'})) { if (!exists($$crit{'state'})) { $$crit{'state'} = +{ 'mask'=>0, 'value'=>0 }; } ${$$crit{'state'}}{'mask'} |= $$crit{'state_lacks'}; ${$$crit{'state'}}{'value'} &= ~$$crit{'state_lacks'}; delete $$crit{'state_lacks'}; } if (exists($$crit{'role'})) { # Note: hard-coded limit on number of roles. $$crit{'rolemask'} = pack('b*', '1'x100); if (!exists($$crit{'rolebits'})) { $$crit{'rolebits'}=''; } vec($$crit{'rolebits'}, $$crit{'role'}, 1) = 1; delete $$crit{'role'}; } if (exists($$crit{'role_in'})) { my $rolespec; foreach $rolespec (@{$$crit{'role_in'}}) { my $rolenum = Win32::ActAcc::RoleFriendlyNameToNumber($rolespec); if (!exists($$crit{'rolebits'})) { $$crit{'rolebits'} = 0; } vec($$crit{'rolebits'}, $rolenum, 1) = 1; } $$crit{'rolemask'} = pack('b*', '1'x100); delete $$crit{'role_in'}; } if (exists($$crit{'role_not_in'})) { my $rolespec; foreach $rolespec (@{$$crit{'role_not_in'}}) { my $rolenum = Win32::ActAcc::RoleFriendlyNameToNumber($rolespec); vec($$crit{'rolebits'}, $rolenum, 1) = 0; } $$crit{'rolemask'} = pack('b*', '1'x100); delete $$crit{'role_not_in'}; } # Match. if (exists($$crit{'rolebits'}) && exists($$crit{'rolemask'})) { my $rolenum = $self->get_accRole(); my $care = vec($$crit{'rolemask'}, $rolenum, 1); my $req = vec($$crit{'rolebits'}, $rolenum, 1); if (!(!$care || $req)) { if (defined($mismatch)) { $$mismatch="role"; } return undef; } } if (exists($$crit{'name'})) { if (!match_string_or_re($self->get_accName(), $$crit{'name'})) { if (defined($mismatch)) { $$mismatch='name'; } return undef; } } if (exists($$crit{'state'})) { croak unless exists(${$$crit{'state'}}{'mask'}); croak unless exists(${$$crit{'state'}}{'value'}); my $s = $self->istate(); if (!defined($s)) { if (defined($mismatch)) { $$mismatch='state-value(ao state not available)'; } return undef; } my $mask = ${$$crit{'state'}}{'mask'}; my $val = ${$$crit{'state'}}{'value'}; $s = $s & $mask; if ($s != $val) { if (defined($mismatch)) { $$mismatch='state-value'; } return undef; } } if (exists($$crit{'visible'})) { my $vv = $self->visible(); return (!$vv == !$$crit{'visible'}); } if (exists($$crit{'get_accHelp'})) { if (!match_string_or_re($self->get_accHelp(), $$crit{'get_accHelp'})) { if (defined($mismatch)) { $$mismatch='get_accHelp'; } return undef; } } if (exists($$crit{'get_accValue'})) { if (!match_string_or_re($self->get_accValue(), $$crit{'get_accValue'})) { if (defined($mismatch)) { $$mismatch='get_accValue'; } return undef; } } if (exists($$crit{'get_accDescription'})) { if (!match_string_or_re($self->get_accDescription(), $$crit{'get_accDescription'})) { if (defined($mismatch)) { $$mismatch='get_accDescription'; } return undef; } } if (exists($$crit{'get_accDefaultAction'})) { if (!match_string_or_re($self->get_accDefaultAction(), $$crit{'get_accDefaultAction'})) { if (defined($mismatch)) { $$mismatch='get_accDefaultAction'; } return undef; } } if (exists($$crit{'HWND'})) { if ($self->WindowFromAccessibleObject() != $$crit{'HWND'}) { if (defined($mismatch)) { $$mismatch='HWND'; } return undef; } } if (exists($$crit{'nonnegative_coordinates'})) { my ($left, $top, $width, $height) = $self->accLocation(); my $nonneg = defined($height) && ($left + $width > -1) && ($top + $height > -1); if (!!$nonneg != !!$$crit{'nonnegative_coordinates'}) { if (defined($mismatch)) { $$mismatch='nonnegative_coordinates'; } return undef; } } if (exists($$crit{'test'})) { if (!$$crit{'test'}->test($self)) { if (defined($mismatch)) { $$mismatch='test'; } return undef; } } if (exists($$crit{'code'})) { $_=$self; my $rv = &{$$crit{'code'}}($self, $crit, $mismatch); if (!$rv && defined($mismatch) && !defined($$mismatch)) { $$mismatch='code'; } return $rv; } return 1; } else { return $self->match_(matchHashUpCriteria($crit), $mismatch); } } # in: AO (known to be child of a *visible* AO) # out: a true value if the AO's state and/or location indicates it's invisible or offscreen. # specifically: 'INVISIBLE' (state bit), 'OFFSCREEN' (state bit), # 'nolocation', 'negative' (right/bottom has negative coordinate), # 'zero' (zero-size). # But, state bit FOCUSABLE trumps the lack of a location. sub either_INVISIBLE_or_negative { my $self = shift; my $state = $self->istate(); return 'INVISIBLE' if ($state & STATE_SYSTEM_INVISIBLE()); return 'OFFSCREEN' if ($state & STATE_SYSTEM_OFFSCREEN()); my ($left, $top, $width, $height) = $self->accLocation(); # Explorer XP's app menubar has no location, but focusable state. return undef if (!defined($height) && ($state & STATE_SYSTEM_FOCUSABLE())); return 'nolocation' unless defined($height); return 'negative' if (($left + $width < 0) || ($top + $height < 0)); return 'zero' if (($width ==0) || ($height == 0)); return undef; } # testable('visible') sub visible { my $self = shift; return !($self->either_INVISIBLE_or_negative()); } # testable('tree') sub tree { my $self = shift; my $coderef = shift; croak "Not a code ref" unless ref($coderef) eq 'CODE'; my $pflags = shift; my $v = new Win32::ActAcc::TreeTour($coderef, $pflags); $v->run($self); } sub iterator { my $self = shift; my $pflags = shift; if (defined($pflags) && $$pflags{'perfunctory'}) { return new Win32::ActAcc::AOIterator($self, $pflags); } elsif (defined($pflags) && $$pflags{'nav'}) { return new Win32::ActAcc::NavIterator($self, $pflags); } else { return new Win32::ActAcc::AONavIterator($self, $pflags); } } sub waitForEvent { my $self = shift; my $pQuarry = shift; croak "Must use HASH" if 'HASH' ne ref($pQuarry); my $timeoutSecs = shift; # optional $$pQuarry{'aoToEqual'} = $self; return Win32::ActAcc::IEH()->waitForEvent($pQuarry, $timeoutSecs); } sub memoize_member { my $self = shift; my $digpath = shift; my $mnemonic = shift; if ($MEMOIZE_MEMBERS) { my $bag = $self->baggage(); if (!exists($$bag{$mnemonic})) { $$bag{$mnemonic} = $self->dig($digpath, +{'min'=>1}); } return $$bag{$mnemonic}; } else { return $self->dig($digpath, +{'min'=>1}); } } sub drill { my $self = shift; my $crit = shift; my $pflags = shift; $pflags = +{} if (!defined($pflags)); croak "Criteria must not be a list" if (ref($crit) eq 'ARRAY'); # confused with dig croak "Flags must be a hash" unless ref($pflags) eq 'HASH'; if (!exists($$pflags{'min'})) { $$pflags{'min'}=1; } if (!exists($$pflags{'max'})) { $$pflags{'max'}=-1; } if (!exists($$pflags{'pruneOnMatch'})) { $$pflags{'pruneOnMatch'}=1; } if (!exists($$pflags{'prunes'})) { $$pflags{'prunes'}=+[ +{'role'=>ROLE_SYSTEM_MENUBAR()}, +{'role'=>ROLE_SYSTEM_BUTTONMENU()}, +{'role'=>ROLE_SYSTEM_OUTLINE()} ]; } if ('HASH' ne ref($crit)) { $crit = matchHashUpCriteria($crit); }; # if visible window is wanted, it can't be within an invisible window... if (exists($$crit{'state'})) { my $mask = ${$$crit{'state'}}{'mask'}; my $val = ${$$crit{'state'}}{'value'}; if ($mask & STATE_SYSTEM_INVISIBLE()) { if (0 == ($val & STATE_SYSTEM_INVISIBLE())) { push(@{$$pflags{'prunes'}}, +{'state'=>+{'mask'=>STATE_SYSTEM_INVISIBLE(), 'value'=>STATE_SYSTEM_INVISIBLE()}}); } } } my @found; $self->tree( sub { my $ao = shift; my $treeTour = shift; my $level = $treeTour->level(); if ($level > 0) { print "Matching " . $ao->describe() . "..." . ($ao->match($crit)) . "\n" if ($$pflags{'trace'}); if ($ao->match($crit)) { $treeTour->prune() unless !$$pflags{'pruneOnMatch'}; push(@found,$ao); if ($$pflags{'max'}==@found) { $treeTour->stop(); } } if (exists($$pflags{'prunes'})) { if (grep($ao->match($_),@{$$pflags{'prunes'}})) { $treeTour->prune(); } } } } , $$pflags{'iterflags'} || +{}); croak "Fewer than ".$$pflags{'min'}." found" if (0+@found < $$pflags{'min'}); if ($$pflags{'max'}==1) { return $found[0]; } else { return @found; } } # Return the subset of an AO's state-bits (including bits inheritable # from its parent) that affect its children also. sub inheritable_state { my $self = shift; my $state = $self->istate() || 0; $state &= ( STATE_SYSTEM_READONLY() | STATE_SYSTEM_OFFSCREEN() | STATE_SYSTEM_INVISIBLE() | STATE_SYSTEM_UNAVAILABLE()); return $state; } # Return an AO's state, including inheritable state-bits from its # parent. Uses $$bag{'::source'} (set by iterators) instead of # parent, b/c parent is buggy in some cases. # testable('iparent') sub iparent { my $self = shift; my $bag = $self->baggage(0); my $src = $bag ? $$bag{'::source'} : undef; return $src; } # testable('parent') sub parent { my $self = shift; return $self->iparent() || $self->get_accParent(); } # testable('istate') sub istate { my $self = shift; my $src = $self->iparent(); my $inh = $src ? $src->inheritable_state() : 0; my $sta = $self->get_accState() || 0; return $sta | $inh; } # testable('dda_Switch') # testable('dda_Press') BEGIN { # Create convenient sub for each default action. my $da; foreach $da ('Check','Click','Close','Collapse','Double Click','Execute','Expand','Press','Switch','Uncheck') { my $m = $da; $m =~ s/\s//g; no strict 'refs'; *{"dda_$m"}=sub{my $ao = shift; $ao->doActionIfDefault($da)}; } } sub baggage { my $self = shift; my $alloc = shift; # whether to allocate if not already; default is 1 if (!defined($alloc)) { $alloc = 1; } my $b = $self->baggage_get(); if ($alloc && (ref($b) ne 'HASH')) { $self->baggage_put(+{}); $b = $self->baggage_get(); die unless (ref($b) eq 'HASH'); } return $b; } sub focus { my $self = shift; my $parent = $self->get_accParent(); if (defined($parent)) { $parent->focus(); } if (STATE_SYSTEM_FOCUSABLE() & $self->get_accState()) { $self->accSelect(SELFLAG_TAKEFOCUS()); } } use Win32::ActAcc::Test; 1;