#!/usr/bin/perl
use strict;
use warnings;
use stl;
print ">>>$0>>>:\n";
my $l1 = list();
$l1->push_back($l1->factory(data => 'first'));
$l1->push_back($l1->factory(data => 'second'));
$l1->push_back($l1->factory(data => 'third'));
$l1->push_back($l1->factory(data => 'fourth'));
$l1->push_back($l1->factory(data => 'fifth'));
my $l2 = list();
$l2->push_back($l2->factory(data => 'red'));
$l2->push_back($l2->factory(data => 'blue'));
$l2->push_back($l2->factory(data => 'yellow'));
$l2->push_back($l2->factory(data => 'pink'));
$l2->push_back($l2->factory(data => 'white'));
my $t1 = tree($l1);
my $t2 = tree($l2);
my $tree = tree();
$tree->push_back($tree->factory($t1));
$tree->push_back($tree->factory($t2));
print "Tree Foreach:\n";
for_each($tree->begin(), $tree->end(), MyPrint->new());
print "Tree Find_If 'yellow':",
find_if($tree->begin(), $tree->end(), MyFind->new(what => 'yellow'))
? '...Found' : '...Not found!', "\n";
print "Tree Count_If(/e/i):",
count_if($tree->begin(), $tree->end(), MyMatch->new(what => 'e')),
"\n";
print "Tree Remove_If(/l/i):\n";
remove_if($tree->begin(), $tree->end(), MyMatch->new(what => 'l'));
for_each($tree->begin(), $tree->end(), MyPrint->new());
print "Tree Find_If 'yellow':",
find_if($tree->begin(), $tree->end(), MyFind->new(what => 'yellow'))
? '...Found' : '...Not found!', "\n";
# ----------------------------------------------------------------------------------------------------
{
package MyPrint;
use base qw(Class::STL::Utilities::FunctionObject::UnaryFunction);
sub function_operator
{
my $self = shift;
my $arg = shift;
print "Data:", $arg->data(), "\n";
}
}
# ----------------------------------------------------------------------------------------------------
{
package MyFind;
use base qw(Class::STL::Utilities::FunctionObject::UnaryFunction);
use Class::STL::ClassMembers (
qw(what),
Class::STL::ClassMembers::FunctionMember::New->new(),
);
sub function_operator
{
my $self = shift;
my $arg = shift;
return $arg->data() eq $self->what() ? $arg : 0;
}
}
# ----------------------------------------------------------------------------------------------------
{
package MyMatch;
use base qw(Class::STL::Utilities::FunctionObject::UnaryFunction);
use Class::STL::ClassMembers (
qw(what),
Class::STL::ClassMembers::FunctionMember::New->new(),
);
sub function_operator
{
my $self = shift;
my $arg = shift;
return ($arg->data() =~ /@{[ $self->what() ]}/i) ? $arg : 0;
}
}
# ----------------------------------------------------------------------------------------------------
syntax highlighted by Code2HTML, v. 0.9.1