<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;">package LookFor;
use Carp;
use strict;
our $AUTOLOAD;  # it's a package global


BEGIN {
 use Exporter   ();
 our(@ISA,@EXPORT);
 @ISA = qw(Exporter);
 @EXPORT =  qw(END_FIND FOUND DEBUG NOT_FOUND);
}

sub AUTOLOAD {
	my $self = shift;
	my $type = ref($self)
			or croak "&lt;$self&gt; is not an object";
	my $name = $AUTOLOAD;
	$name =~ s/.*://;   # strip fully-qualified portion
	unless (exists $self-&gt;{_permitted}-&gt;{$name} ) {
		croak "Can't access `$name' field in class $type";
	}
	if (@_) {
		return $self-&gt;{$name} = shift;
	} else {
		return $self-&gt;{$name};
	}
}


my %fields = ( #fields to inherit!
	data		=&gt; undef, #Required in Class Init
	data_stream	=&gt; undef, #"
	stream_name	=&gt; undef, #"
	_data		=&gt; undef,
	max_seeks       =&gt; 1000,
	seek		=&gt; \&amp;_default_seek,
	_parent		=&gt; undef, #don't inheret
	_data		=&gt; undef, #
	_end_find	=&gt; undef,
	type 		=&gt; undef,
	next_lookfor 	=&gt; undef, 
	fnd_n_prc_data	=&gt; undef, 
	name		=&gt; undef
);

my @req_fields = qw/data data_stream stream_name/;

sub new {
 my $objq = shift;
 my $class = ref($objq) || $objq;
 my %init = @_;
 my $self  = {
	_permitted =&gt; \%fields,
	%fields,
	%init,
 };
 bless $self, $class;
 if(ref($objq)) {$self-&gt;_inst_check($objq,\%init) }
	 else {	$self-&gt;_check()}
 return $self;
}

sub _end_chk {
 my $self = shift;
 $_ =  $self-&gt;{sought};
 return FOUND()  if ("$_" eq undef);
 return NOT_FOUND();
}

sub _check {
 my $self = shift;
 $self-&gt;{_end_find} = $self-&gt;new("fnd_n_prc_data"=&gt; \&amp;_end_chk,"name"=&gt; "end");
}

sub _inst_check {
 my ($self,$parent,$init) = @_;
 foreach (keys %fields) {
	if (!$$init{$_}) {$self-&gt;{$_} = $parent-&gt;{$_}}
 }
 $self-&gt;{_parent} = $parent;
 if ( ref($$init{fnd_n_prc_data}) ne "CODE" ) {
	$self-&gt;{_data}-&gt;{re} = $$init{fnd_n_prc_data};
 	$self-&gt;{fnd_n_prc_data} = \&amp;_default_proc;
 }
}

sub change {
 my $self = shift;
 my %changes = @_;
 foreach my $param (keys %changes) {
	$self-&gt;{$param}  = $changes{$param};
 }
}

sub _default_proc {
my ($self,$srch_str) = @_;
 $_ = $self-&gt;{sought};
 if (/$self-&gt;{_data}-&gt;{re}/i) {
	if( $self-&gt;{type} &amp; DEBUG() ) {
		print  "{".$self-&gt;{stream_name}." ".$self-&gt;{name}."}-&gt;$_\n";
	}
	return FOUND();
 }
 return NOT_FOUND();
}

sub _default_seek {
 my $self = shift;
 my $file = $self-&gt;{data_stream};
 $self-&gt;{sought} = &lt;$file&gt;;
 return $self-&gt;{sought};
}

#
#Insert Code Diagraming stuff here;)
#
sub next_lookfor {
 my $self = shift;
 if (@_ &gt; 1) { #multiple lookfors!
	$self-&gt;{next_lookfor} = _combined_lookfors($self, @_);
 } else {
	$self-&gt;{next_lookfor} = _check_for_end_find($self,shift);
 }
}


sub _check_for_end_find { 
 my $self = shift;
 my $lookfor_in_question = shift;
 if ($lookfor_in_question eq "end_find" &amp;&amp; ref($lookfor_in_question) ne "LookFor") {
	return $self-&gt;{_end_find};
 } else {
	return $lookfor_in_question;
 }
}

sub _combined_fnd_n_prc_data {
 my $self = shift; #self will be the combined lookfor...
 my $chk;
 foreach my $lookfor ( @{$self-&gt;{_data}-&gt;{lookfors}}) {
	$lookfor-&gt;{sought} = $self-&gt;{sought}; #The data to search changes!
	if($lookfor-&gt;{fnd_n_prc_data}($lookfor) eq FOUND()) {
		$self-&gt;{next_lookfor} = $lookfor-&gt;{next_lookfor};
		return FOUND();
	}
 }
 return return NOT_FOUND();
}

sub _combined_lookfors {
 my $self = shift;
 my $name;
 my @lookfors;
 while (@_) {
	my $lookfor = shift;
	$lookfor = _check_for_end_find($self,$lookfor);
	push @lookfors,$lookfor;
	$name .= "-{".$lookfor-&gt;{name}."}-";
 }
 my $combined_lookfor =
	$self-&gt;new( "fnd_n_prc_data"=&gt;\&amp;_combined_fnd_n_prc_data,
		"name" =&gt; $name);
 $combined_lookfor-&gt;{_data}-&gt;{lookfors} = \@lookfors;
 return $combined_lookfor;
}


sub lookfor {
 my $self = shift;
 my $chk = NOT_FOUND();
 my $sought = " ";
 my $debug = $self-&gt;{stream_name}."  |".$self-&gt;{name}."|";
 my $seek_count = 1;
 #foreach my $field (@req_fields) {
 #	croak "$field is not defined in new()!" unless ($self-&gt;{$field});
 #}
 while ($chk ne FOUND() &amp;&amp; $sought ne undef &amp;&amp; $seek_count &lt; $self-&gt;{max_seeks}) {
	$sought = $self-&gt;{seek}($self);
        $chk = $self-&gt;{fnd_n_prc_data}($self);	
	$seek_count++;
 }
 croak "$debug END FOUND before pattern" unless ($sought || $self-&gt;{name} eq "end");
 croak "$debug: BROKEN LINK: Don't know what to do!"
	 unless ($self-&gt;{next_lookfor} || $self-&gt;{name} eq "end" );
 croak "$debug TOO MANY seeks!" if ($seek_count &gt;= $self-&gt;{max_seeks});
 $seek_count = 1;
 $self-&gt;{next_lookfor}-&gt;lookfor() if ($self-&gt;{next_lookfor});
 return $self-&gt;{data};
}



sub DEBUG {return 1}
sub FOUND {return "found"}
sub NOT_FOUND {return "not found"}
sub END_FIND {return "end_find"}

return 1;</pre></body></html>