| HoneyClient-Agent documentation | Contained in the HoneyClient-Agent distribution. |
HoneyClient::Agent::Integrity::Registry::Parser - Perl extension to parse static hive dumps of the Windows OS registry.
This documentation refers to HoneyClient::Agent::Integrity::Registry::Parser version 0.98.
use HoneyClient::Agent::Integrity::Registry::Parser;
use IO::File;
use Data::Dumper;
# Initialize the parser object.
my $parser = HoneyClient::Agent::Integrity::Registry::Parser->init(
input_file => "dump.reg",
);
# Print each registry group found, until there are no more left.
my $registryGroup = $parser->nextGroup();
while(scalar(keys(%{$registryGroup}))) {
print Dumper($registryGroup);
$registryGroup = $parser->nextGroup();
}
# $registryGroup refers to hashtable reference, which has the
# following format:
#
# $registryGroup = {
# # The registry directory name.
# 'key' => 'HKEY_LOCAL_MACHINE\Software...',
#
# # An array containing the list of entries within the
# # registry directory.
# 'entries' => [ {
# 'name' => "\"string\"", # A (potentially) quoted string;
# # "@" for default
# 'value' => "data",
# }, ],
# };
This library allows the Registry module to easily parse and enumerate each Windows OS registry hive.
The following functions have been implemented by any Parser object.
Creates a new Parser object, using the specified input file as its data source.
Inputs:$filename is an required parameter, specifying the file to open for parsing.$perform_index is an optional parameter. 1 specifies that the parser should go ahead and scan the entire file, indexing the file offsets of where groups start and end. Otherwise, this indexing process is not performed.$progress is an optional parameter. 1 specifies that the parser should display a progress bar, as it scans through a specified file. Otherwise, a progress bar is not displayed.
Output: The instantiated Parser $object, fully initialized.
Provides the next registry group, in the form of a hashtable reference. This hashtable has the following format:
{
# The registry directory name.
'key' => 'HKEY_LOCAL_MACHINE\Software...',
# An array containing the list of entries within the
# registry directory.
'entries' => [ {
'name' => "\"string\"", # A (potentially) quoted string;
# "@" for default
'value' => "data",
}, ],
};
Output: A hashtable reference if the next group was parsed successfully; returns an empty hash ref, if the Parser $object has reached the end of the input stream.
Indicates how many registry directories the Parser $object has parsed within the specified file, so far.
Output: Returns the number of directory groups parsed so far; returns 0, if none parsed yet.
Indicates how many registry key/value pairs the Parser $object has parsed within the specified file, so far.
Output: Returns the number of key/value pairs parsed so far; returns 0, if none parsed yet.
Returns the file handle associated with the current Parser $object.
Output: Returns the file handle in use.
Returns the file name associated with the current Parser $object.
Output: Returns the file name in use.
Closes the file handle associated with the current Parser $object.
Returns the number of lines parsed by the Parser $object within the specified file and resets the counter back to zero.
Output: Returns the current line count of the parser.
Note: Calling this function will reset the parser's line count.
Given an absolute offset or line number within the file, this function will seek the parser to the nearest group found before the specified offset.
Inputs:$offset is an required parameter, specifying the absolute offset within the file to seek to.$linenum is a required parameter, specifying the absolute line number within the file to seek to.$index is an optional parameter, specifying to seek to a group before or after the target group. If unspecified, $index = 0.
Outputs: None.
Notes: Either $offset or $linnum must be specified. To seek to the target group, specify $index = 0 or leave undefined. To seek to the previous group before the target group, specify $index = -1. To seek to the next group after the target group, specify $index = 1.
Once called, all corresponding statistical counters will be reset. This means, that the output from $object->dirsParsed() and $object->entriesParsed() will be zero, if called immediately after this function.
The Parser $object expects to scan the specified file as an input stream. Subsequent calls to $object->nextGroup() will advance the parser through the input stream.
Francois Desarmenien <francois@fdesar.net> for his work in developing the Parse::Yapp module.
Darien Kindlund, <kindlund@mitre.org>
Copyright (C) 2007 The MITRE Corporation. All rights reserved.
This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation, using version 2 of the License.
This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details.
You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
| HoneyClient-Agent documentation | Contained in the HoneyClient-Agent distribution. |
#################################################################### # # This file was generated using Parse::Yapp version 1.05. # # Don't edit this file, use source file instead. # # ANY CHANGE MADE HERE WILL BE LOST ! # #################################################################### package HoneyClient::Agent::Integrity::Registry::Parser; use vars qw ( @ISA ); use strict; @ISA= qw ( Parse::Yapp::Driver ); use Parse::Yapp::Driver; #line 1 "Parser.yp" ####################################################################### # Created on: Dec 10, 2006 # Package: HoneyClient::Agent::Integrity::Registry::Parser # File: Parser.pm # Description: Parses static hive dumps of the Windows OS registry. # # CVS: $Id: Parser.pm 773 2007-07-26 19:04:55Z kindlund $ # # @author kindlund # # Copyright (C) 2007 The MITRE Corporation. All rights reserved. # # This program is free software; you can redistribute it and/or # modify it under the terms of the GNU General Public License # as published by the Free Software Foundation, using version 2 # of the License. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA # 02110-1301, USA. # #######################################################################
use strict; use warnings; use Carp (); # Include Global Configuration Processing Library use HoneyClient::Util::Config qw(getVar); # Include Logging Library use Log::Log4perl qw(:easy); # Use Dumper Library. use Data::Dumper; # Use IO File Library. use IO::File; # Use Seek Library. use Fcntl qw(:seek); # Use Binary Search Library. use Search::Binary; # Use Progress Bar Library. use Term::ProgressBar; ####################################################################### # Module Initialization # ####################################################################### BEGIN { # Defines which functions can be called externally. require Exporter; our (@ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS, $VERSION); # Set our package version. $VERSION = 0.98; @ISA = qw(Exporter); # Symbols to export automatically @EXPORT = qw( ); # Items to export into callers namespace by default. Note: do not export # names by default without a very good reason. Use EXPORT_OK instead. # Do not simply export all your public functions/methods/constants. # This allows declaration use HoneyClient::Agent::Integrity::Registry ':all'; # If you do not need this, moving things directly into @EXPORT or @EXPORT_OK # will save memory. %EXPORT_TAGS = ( 'all' => [ qw( ) ], ); # Symbols to autoexport (when qw(:all) tag is used) @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } ); $SIG{PIPE} = 'IGNORE'; # Do not exit on broken pipes. } our (@EXPORT_OK, $VERSION);
####################################################################### # Global Configuration Variables ####################################################################### # The global logging object. our $LOG = get_logger(); # Make Dumper format more terse. $Data::Dumper::Terse = 1; $Data::Dumper::Indent = 1; sub new { my($class)=shift; ref($class) and $class=ref($class); my($self)=$class->SUPER::new( yyversion => '1.05', yystates => [ {#State 0 ACTIONS => { 'DIR_NAME' => 2, 'HEADER' => 5, 'NEWLINE' => 6 }, DEFAULT => -1, GOTOS => { 'group' => 1, 'registry' => 3, 'groups' => 4 } }, {#State 1 DEFAULT => -4 }, {#State 2 ACTIONS => { 'KEY_NAME' => 7 }, DEFAULT => -9, GOTOS => { 'entry' => 8, 'entries' => 9 } }, {#State 3 ACTIONS => { '' => 10 } }, {#State 4 DEFAULT => -2 }, {#State 5 ACTIONS => { 'DIR_NAME' => 2, 'NEWLINE' => 6 }, GOTOS => { 'group' => 1, 'groups' => 11 } }, {#State 6 ACTIONS => { 'DIR_NAME' => 2 }, GOTOS => { 'group' => 12 } }, {#State 7 ACTIONS => { 'KEY_VALUE' => 13 } }, {#State 8 ACTIONS => { 'KEY_NAME' => 7 }, DEFAULT => -10, GOTOS => { 'entry' => 8, 'entries' => 14 } }, {#State 9 DEFAULT => -8 }, {#State 10 DEFAULT => 0 }, {#State 11 DEFAULT => -3 }, {#State 12 ACTIONS => { 'DIR_NAME' => 2, 'NEWLINE' => 16 }, DEFAULT => -5, GOTOS => { 'group' => 1, 'groups' => 15 } }, {#State 13 DEFAULT => -12 }, {#State 14 DEFAULT => -11 }, {#State 15 DEFAULT => -7 }, {#State 16 ACTIONS => { 'DIR_NAME' => 2 }, DEFAULT => -6, GOTOS => { 'group' => 12 } } ], yyrules => [ [#Rule 0 '$start', 2, undef ], [#Rule 1 'registry', 0, sub #line 247 "Parser.yp" { $LOG->debug("Reached end of input stream."); # Finished parsing the entire file, return empty hash ref. return { }; } ], [#Rule 2 'registry', 1, sub #line 252 "Parser.yp" { $LOG->debug("Reached end of input stream."); # Finished parsing the entire file, return empty hash ref. return { }; } ], [#Rule 3 'registry', 2, sub #line 257 "Parser.yp" { $LOG->debug("Reached end of input stream."); # Finished parsing the entire file, return empty hash ref. return { }; } ], [#Rule 4 'groups', 1, undef ], [#Rule 5 'groups', 2, undef ], [#Rule 6 'groups', 3, undef ], [#Rule 7 'groups', 3, undef ], [#Rule 8 'group', 2, sub #line 274 "Parser.yp" { my $ret = { }; $_[0]->YYData->{'latest_group'}->{'key'} = $_[1]; if (!exists($_[0]->YYData->{'latest_group'}->{'entries'})) { # Make sure the 'entries' key exists. $_[0]->YYData->{'latest_group'}->{'entries'} = []; } $ret = $_[0]->YYData->{'latest_group'}; $_[0]->YYData->{'latest_group'} = { }; $_[0]->YYData->{'dir_count'}++; $_[0]->YYAccept; # Terminate the parse, early. return $ret; } ], [#Rule 9 'group', 1, sub #line 288 "Parser.yp" { my $ret = { }; $_[0]->YYData->{'latest_group'}->{'key'} = $_[1]; if (!exists($_[0]->YYData->{'latest_group'}->{'entries'})) { # Make sure the 'entries' key exists. $_[0]->YYData->{'latest_group'}->{'entries'} = []; } $ret = $_[0]->YYData->{'latest_group'}; $_[0]->YYData->{'latest_group'} = { }; $_[0]->YYData->{'dir_count'}++; $_[0]->YYAccept; # Terminate the parse, early. return $ret; } ], [#Rule 10 'entries', 1, undef ], [#Rule 11 'entries', 2, undef ], [#Rule 12 'entry', 2, sub #line 312 "Parser.yp" { my $entry = { name => $_[1], value => $_[2], }; push(@{$_[0]->YYData->{'latest_group'}->{entries}}, $entry); $_[0]->YYData->{'entry_count'}++; } ] ], @_); bless($self,$class); } #line 322 "Parser.yp" ####################################################################### # Private Methods Implemented # ####################################################################### # Helper function, designed to tokenize specific data from the input stream. # # Inputs: parser # Outputs: (token_id, data) pair sub _lexer { # Identify NEWLINE token. if ($_[0]->YYData->{DATA} =~ m/\G\n/cg) { $_[0]->YYData->{'in_group'} = 0; $LOG->debug("Found NEWLINE token ending at offset (" . pos($_[0]->YYData->{DATA}) . ")."); $_[0]->YYData->{'line_count'}++; return ("NEWLINE", "\n"); } # Check to see if we're inside a group block... if (!$_[0]->YYData->{'in_group'}) { $_[0]->YYData->{'input_pos'} = pos($_[0]->YYData->{DATA}); $_[0]->YYData->{'input_pos'} = $_[0]->YYData->{'input_pos'} ? $_[0]->YYData->{'input_pos'} : 0; $_[0]->YYData->{'input_pos'} = $_[0]->YYData->{'input_pos'} + $_[0]->YYData->{'abs_offset'}; # Update progress bar, if defined. if (defined($_[0]->YYData->{'progress'}) && ($_[0]->YYData->{'input_pos'} > $_[0]->YYData->{'progress_next_update'})) { $_[0]->YYData->{'progress_next_update'} = $_[0]->YYData->{'progress'}->update($_[0]->YYData->{'input_pos'}); } # Identify DIR_NAME token. if ($_[0]->YYData->{DATA} =~ m/\G\[(.*)\]\n/cg) { $_[0]->YYData->{'in_group'} = 1; $LOG->debug("Found DIR_NAME token ending at offset (" . pos($_[0]->YYData->{DATA}) . ")."); $_[0]->YYData->{'last_group_line_number'} = $_[0]->YYData->{'line_count'}; $_[0]->YYData->{'line_count'}++; return ("DIR_NAME", $1); } # Identify HEADER token. It's always only at the beginning. if ($_[0]->YYData->{DATA} =~ m/\GREGEDIT4\n/cg) { $LOG->debug("Found HEADER token ending at offset (" . pos($_[0]->YYData->{DATA}) . ")."); $_[0]->YYData->{'line_count'}++; return ("HEADER", "REGEDIT4\n"); } } else { # Check to see if we're in a value segment... if (!$_[0]->YYData->{'in_value'}) { # Identify KEY_NAME token. if ($_[0]->YYData->{DATA} =~ m/\G\"(|[^\\]|.*(?:\\[^\\]|\\\\|[^\\][^\\]))\"(?==)/cg) { $_[0]->YYData->{'in_value'} = 1; $LOG->debug("Found KEY_NAME token ending at offset (" . pos($_[0]->YYData->{DATA}) . ")."); return ("KEY_NAME", $1); } # Identify default KEY_NAME token (@). if ($_[0]->YYData->{DATA} =~ m/\G\@(?==)/cg) { $_[0]->YYData->{'in_value'} = 1; $LOG->debug("Found KEY_NAME token ending at offset (" . pos($_[0]->YYData->{DATA}) . ")."); return ("KEY_NAME", "@"); } } else { # Identify string KEY_VALUE token. if ($_[0]->YYData->{DATA} =~ m/\G=\"(|[^\\]|.*?(?:\\[^\\]|\\\\|[^\\][^\\]))\"\n/cgs) { $_[0]->YYData->{'in_value'} = 0; $LOG->debug("Found KEY_VALUE token ending at offset (" . pos($_[0]->YYData->{DATA}) . ")."); $_[0]->YYData->{'line_count'} += 1 + @{[$1 =~ /\n/g]}; return ("KEY_VALUE", $1); } # Identify binary KEY_VALUE token. if ($_[0]->YYData->{DATA} =~ m/\G=(|.*?[^\\])\n/cgs) { $_[0]->YYData->{'in_value'} = 0; $LOG->debug("Found KEY_VALUE token ending at offset (" . pos($_[0]->YYData->{DATA}) . ")."); $_[0]->YYData->{'line_count'} += 1 + @{[$1 =~ /\n/g]}; return ("KEY_VALUE", $1); } } } # Croak if encountered a token error. if ($_[0]->YYData->{DATA} =~ m/\G(.*\n)/cg) { $_[0]->YYData->{'input_pos'} = pos($_[0]->YYData->{DATA}); $LOG->fatal("Error: Unknown token (" . $1 . ") at offset (". $_[0]->YYData->{'input_pos'} .")"); Carp::croak("Error: Unknown token (" . $1 . ") at offset (". $_[0]->YYData->{'input_pos'} .")"); } return ('', undef); } # Helper function, designed to report when any parsing error # occurs. # # Inputs: parser # Outputs: None sub _error { $LOG->fatal("Error: Malformed input found at offset (" . $_[0]->YYData->{'input_pos'} . ")."); Carp::croak("Error: Malformed input found at offset (" . $_[0]->YYData->{'input_pos'} . ")."); } # Helper function, designed to reset the parser's file stream back to the # beginning, allowing the parser to reparse from the beginning. Or, if # specified, the function will seek the parser to the specified offset. # # Inputs: parser, absolute offset (optional) # Outputs: none sub _reset { # Extract arguments. my ($self, $offset) = @_; $LOG->debug("Resetting parser."); $self->YYData->{'file_handle'} = undef; my $fh = new IO::File($self->YYData->{'filename'}, "r"); if (!defined($fh)) { $LOG->fatal("Error: Unable to read file '" . $self->YYData->{'filename'} . "'!"); Carp::croak("Error: Unable to read file '" . $self->YYData->{'filename'} . "'!"); } $self->YYData->{'file_handle'} = $fh; # Check the offset. if (!defined($offset)) { $offset = 0; } seek($fh, $offset, SEEK_SET); undef $/; $self->YYData->{DATA} = <$fh>; # Strip all CRs. $self->YYData->{DATA} =~ s/\r//g; # Total size of input file. $self->YYData->{'file_size'} = (stat($fh))[7]; # Reinitialize helper variables. # Hashtable, to represent the latest, extracted group chunk. $self->YYData->{'latest_group'} = { }; # Boolean, to indicate when we're parsing inside a group chunk. $self->YYData->{'in_group'} = 0; # Boolean, to indicate when we're parsing inside a value segment. $self->YYData->{'in_value'} = 0; # Regexp offset, used to record where the parser is within # the file (relative position). $self->YYData->{'input_pos'} = 0; # Absolute offset, recording where the parser initially seeked to. $self->YYData->{'abs_offset'} = $offset; # Initialize statistics. # Total number of directories parsed. $self->YYData->{'dir_count'} = 0; # Total number of key/value pairs parsed. $self->YYData->{'entry_count'} = 0; # Total number of lines parsed. $self->YYData->{'line_count'} = 0; # Last line number that corresponded to a group separation point. $self->YYData->{'last_group_line_number'} = 0; # Progress bar information. if ($self->YYData->{'show_progress'}) { $self->YYData->{'progress'} = Term::ProgressBar->new({ name => 'Progress', count => $self->YYData->{'file_size'}, ETA => 'linear', }); $self->YYData->{'progress'}->minor(0); $self->YYData->{'progress'}->max_update_rate(1); $self->YYData->{'progress_next_update'} = $self->YYData->{'progress'}->update($offset); } else { $self->YYData->{'progress'} = undef; } } # Helper function, designed to index all groups, based upon beginning file # offsets. # # Inputs: parser # Outputs: None sub _index { # Extract arguments. my $self = shift; $LOG->debug("Starting group index process."); $self->YYData->{'group_index_offsets'} = [0, ]; $self->YYData->{'group_index_linenums'} = [0, ]; my $registryGroup = $self->nextGroup(); while(scalar(keys(%{$registryGroup}))) { push (@{$self->YYData->{'group_index_offsets'}}, $self->YYData->{'input_pos'}); push (@{$self->YYData->{'group_index_linenums'}}, $self->YYData->{'last_group_line_number'}); $registryGroup = $self->nextGroup(); } # Reset the parser. $self->_reset(); $LOG->debug("Finished group index process."); } # Helper function, designed to be called from within the # Search::Binary::binary_search() function, in order to allow # the binary_search to properly read in group index data from # the default parser reference. # # For more information about how this function operates, please # see the Search::Binary POD documentation. # # Inputs: parser, value_to_compare, current_array_index # Outputs: comparison, last_valid_array_index sub _search { # Extract arguments. my ($parser, $value_to_compare, $current_array_index) = @_; # Increment the search index, if the current one is undef. if (defined($current_array_index)) { $parser->YYData->{'last_search_index'} = $current_array_index; } else { $parser->YYData->{'last_search_index'}++; } # Perform a comparison, if the array entry is defined. # Check to see if the search is for line numbers or offsets. if ($parser->YYData->{'search_is_linenum'}) { if (defined(@{$parser->YYData->{'group_index_linenums'}}[$parser->YYData->{'last_search_index'}])) { return($value_to_compare <=> @{$parser->YYData->{'group_index_linenums'}}[$parser->YYData->{'last_search_index'}], $parser->YYData->{'last_search_index'}); } } else { if (defined(@{$parser->YYData->{'group_index_offsets'}}[$parser->YYData->{'last_search_index'}])) { return($value_to_compare <=> @{$parser->YYData->{'group_index_offsets'}}[$parser->YYData->{'last_search_index'}], $parser->YYData->{'last_search_index'}); } } # Array entry not found, return undef with this position. return (undef, $parser->YYData->{'last_search_index'}); } ####################################################################### # Public Methods Implemented # #######################################################################
sub init { # Extract arguments. my ($self, %args) = @_; # Log resolved arguments. $LOG->debug(sub { # Make Dumper format more terse. $Data::Dumper::Terse = 1; $Data::Dumper::Indent = 0; Dumper(\%args); }); # Sanity check, don't initialize, unless input_file_handle # was provided. my $argsExist = scalar(%args); if (!$argsExist || !exists($args{'input_file'}) || !defined($args{'input_file'})) { $LOG->fatal("Error: Unable to create parser - no 'input_file' specified!"); Carp::croak("Error: Unable to create parser - no 'input_file' specified!"); } my $parser = HoneyClient::Agent::Integrity::Registry::Parser->new(); my $fh = new IO::File($args{'input_file'}, "r"); if (!defined($fh)) { $LOG->fatal("Error: Unable to read file '" . $args{'input_file'} . "'!"); Carp::croak("Error: Unable to read file '" . $args{'input_file'} . "'!"); } # Check if show progress was specified. if ($argsExist && exists($args{'show_progress'}) && defined($args{'show_progress'}) && $args{'show_progress'}) { $parser->YYData->{'show_progress'} = 1; } else { $parser->YYData->{'show_progress'} = 0; } # Save the file name. $parser->YYData->{'filename'} = $args{'input_file'}; # Save the file handle. $parser->YYData->{'file_handle'} = $fh; # Reset the parser. $parser->_reset(); # Perform group indexing, if specified. if ($argsExist && exists($args{'index_groups'}) && defined($args{'index_groups'}) && $args{'index_groups'}) { $parser->_index(); } else { $parser->YYData->{'group_index_offsets'} = [0, ]; $parser->YYData->{'group_index_linenums'} = [0, ]; } # Return parser object. return $parser; }
sub nextGroup { # Extract arguments. my ($self, %args) = @_; # Sanity check: Make sure we've been fed an object. unless (ref($self)) { $LOG->error("Error: Function must be called in reference to a " . __PACKAGE__ . "->new() object!"); Carp::croak "Error: Function must be called in reference to a " . __PACKAGE__ . "->new() object!\n"; } # Log resolved arguments. $LOG->debug(sub { # Make Dumper format more terse. $Data::Dumper::Terse = 1; $Data::Dumper::Indent = 0; Dumper(\%args); }); # Reopen the file_handle, if it's been closed. if (!defined($self->YYData->{'file_handle'})) { $self->_reset(); } if ($self->YYData->{'input_pos'} == 0) { $LOG->debug("Beginning parse of input stream."); } # Update progress bar, if defined. if (defined($_[0]->YYData->{'progress'}) && ($_[0]->YYData->{'file_size'} <= $_[0]->YYData->{'progress_next_update'})) { $_[0]->YYData->{'progress'}->update($_[0]->YYData->{'file_size'}); } # Return the next group parsed. return $self->YYParse(yylex => \&_lexer, yyerror => \&_error); }
sub dirsParsed { # Extract arguments. my ($self, %args) = @_; # Sanity check: Make sure we've been fed an object. unless (ref($self)) { $LOG->error("Error: Function must be called in reference to a " . __PACKAGE__ . "->new() object!"); Carp::croak "Error: Function must be called in reference to a " . __PACKAGE__ . "->new() object!\n"; } # Log resolved arguments. $LOG->debug(sub { # Make Dumper format more terse. $Data::Dumper::Terse = 1; $Data::Dumper::Indent = 0; Dumper(\%args); }); return $self->YYData->{'dir_count'}; }
sub entriesParsed { # Extract arguments. my ($self, %args) = @_; # Sanity check: Make sure we've been fed an object. unless (ref($self)) { $LOG->error("Error: Function must be called in reference to a " . __PACKAGE__ . "->new() object!"); Carp::croak "Error: Function must be called in reference to a " . __PACKAGE__ . "->new() object!\n"; } # Log resolved arguments. $LOG->debug(sub { # Make Dumper format more terse. $Data::Dumper::Terse = 1; $Data::Dumper::Indent = 0; Dumper(\%args); }); return $self->YYData->{'entry_count'}; }
sub getFileHandle { # Extract arguments. my ($self, %args) = @_; # Sanity check: Make sure we've been fed an object. unless (ref($self)) { $LOG->error("Error: Function must be called in reference to a " . __PACKAGE__ . "->new() object!"); Carp::croak "Error: Function must be called in reference to a " . __PACKAGE__ . "->new() object!\n"; } # Log resolved arguments. $LOG->debug(sub { # Make Dumper format more terse. $Data::Dumper::Terse = 1; $Data::Dumper::Indent = 0; Dumper(\%args); }); return $self->YYData->{'file_handle'}; }
sub getFilename { # Extract arguments. my ($self, %args) = @_; # Sanity check: Make sure we've been fed an object. unless (ref($self)) { $LOG->error("Error: Function must be called in reference to a " . __PACKAGE__ . "->new() object!"); Carp::croak "Error: Function must be called in reference to a " . __PACKAGE__ . "->new() object!\n"; } # Log resolved arguments. $LOG->debug(sub { # Make Dumper format more terse. $Data::Dumper::Terse = 1; $Data::Dumper::Indent = 0; Dumper(\%args); }); return $self->YYData->{'filename'}; }
sub closeFileHandle { # Extract arguments. my ($self, %args) = @_; # Sanity check: Make sure we've been fed an object. unless (ref($self)) { $LOG->error("Error: Function must be called in reference to a " . __PACKAGE__ . "->new() object!"); Carp::croak "Error: Function must be called in reference to a " . __PACKAGE__ . "->new() object!\n"; } # Log resolved arguments. $LOG->debug(sub { # Make Dumper format more terse. $Data::Dumper::Terse = 1; $Data::Dumper::Indent = 0; Dumper(\%args); }); $self->YYData->{'file_handle'} = undef; }
sub getCurrentLineCount { # Extract arguments. my ($self, %args) = @_; # Sanity check: Make sure we've been fed an object. unless (ref($self)) { $LOG->error("Error: Function must be called in reference to a " . __PACKAGE__ . "->new() object!"); Carp::croak "Error: Function must be called in reference to a " . __PACKAGE__ . "->new() object!\n"; } # Log resolved arguments. $LOG->debug(sub { # Make Dumper format more terse. $Data::Dumper::Terse = 1; $Data::Dumper::Indent = 0; Dumper(\%args); }); my $ret = $self->YYData->{'line_count'}; $self->YYData->{'line_count'} = 0; return $ret; }
sub seekToNearestGroup { # Extract arguments. my ($self, %args) = @_; # Sanity check: Make sure we've been fed an object. unless (ref($self)) { $LOG->error("Error: Function must be called in reference to a " . __PACKAGE__ . "->new() object!"); Carp::croak "Error: Function must be called in reference to a " . __PACKAGE__ . "->new() object!\n"; } # Log resolved arguments. $LOG->debug(sub { # Make Dumper format more terse. $Data::Dumper::Terse = 1; $Data::Dumper::Indent = 0; Dumper(\%args); }); # Sanity check, don't continue, unless absolute_offset or absolute_linennum # was provided. my $argsExist = scalar(%args); if (!$argsExist) { $LOG->fatal("Error: Unable to seek parser - no 'absolute_offset' or 'absolute_linenum' specified!"); Carp::croak("Error: Unable to seek parser - no 'absolute_offset' or 'absolute_linenum' specified!"); } # Check if adjust_index was provided. my $adjust_index = 0; if (exists($args{'adjust_index'})) { if(!defined($args{'adjust_index'})) { $LOG->fatal("Error: Unable to seek parser - invalid 'adjust_index' specified!"); Carp::croak("Error: Unable to seek parser - invalid 'adjust_index' specified!"); } else { $adjust_index = $args{'adjust_index'}; } } # Define helper variables. my $search_arrayref = undef; my $search_target = undef; # Specify the search type. $self->YYData->{'search_is_linenum'} = 0; # Check if absolute_offset was provided. if (exists($args{'absolute_offset'})) { if (!defined($args{'absolute_offset'})) { $LOG->fatal("Error: Unable to seek parser - no 'absolute_offset' or 'absolute_linenum' specified!"); Carp::croak("Error: Unable to seek parser - no 'absolute_offset' or 'absolute_linenum' specified!"); } $search_arrayref = $self->YYData->{'group_index_offsets'}; $search_target = $args{'absolute_offset'}; } else { # Check if absolute_linenum was provided. if (!defined($args{'absolute_linenum'})) { $LOG->fatal("Error: Unable to seek parser - no 'absolute_offset' or 'absolute_linenum' specified!"); Carp::croak("Error: Unable to seek parser - no 'absolute_offset' or 'absolute_linenum' specified!"); } $search_arrayref = $self->YYData->{'group_index_linenums'}; $search_target = $args{'absolute_linenum'}; $self->YYData->{'search_is_linenum'} = 1; } # Final sanity check. if (!defined($search_target)) { $LOG->fatal("Error: Unable to seek parser - no 'absolute_offset' or 'absolute_linenum' specified!"); Carp::croak("Error: Unable to seek parser - no 'absolute_offset' or 'absolute_linenum' specified!"); } # Check to see if the $search_arrayref has been initialized. # We assume that if it has [0, ], then this has not been # done. my $numIndices = scalar(@{$search_arrayref}); if ($numIndices < 2) { $self->_index(); } $numIndices = scalar(@{$search_arrayref}); # Find the nearest index after the offset. my $found_index = binary_search(0, $numIndices - 1, $search_target, \&_search, $self); # Now, find the nearest index before the offset. if ($found_index > 0) { $found_index--; # Adjust the index, if specified. if ($found_index > 0) { my $test_index = ($found_index + $adjust_index); # Make sure the adjustment doesn't exceed the min or max. if ($test_index >= $numIndices) { $found_index = $numIndices - 1; } elsif ($test_index < 0) { $found_index = 0; } else { $found_index = $test_index; } } } my $found_offset = @{$self->YYData->{'group_index_offsets'}}[$found_index]; # Seek the parser, to the specified offset. $self->_reset($found_offset); if($self->YYData->{'search_is_linenum'}) { my $found_linenum = @{$self->YYData->{'group_index_linenums'}}[$found_index]; $LOG->debug("Seeking parser to nearest earlier group line number (" . $found_linenum . ")."); return $found_linenum; } else { $LOG->debug("Seeking parser to nearest earlier group offset (" . $found_offset . ")."); return $found_offset; } } ####################################################################### # Additional Module Documentation # #######################################################################
1;