DataStructures.pm
上传用户:market2
上传日期:2018-11-18
资源大小:18786k
文件大小:11k
- #########################################################################
- # OpenKore - Utility Functions
- #
- # Copyright (c) 2004,2005,2006,2007 OpenKore Development Team
- #
- # This software is open source, licensed under the GNU General Public
- # License, version 2.
- # Basically, this means that you're allowed to modify and distribute
- # this software. However, if you distribute modified versions, you MUST
- # also distribute the source code.
- # See http://www.gnu.org/licenses/gpl.html for the full license.
- #########################################################################
- ##
- # MODULE DESCRIPTION: Utility functions for data structure manipulation
- #
- # Various functions for manipulating data structures.
- package Utils::DataStructures;
- use strict;
- use Exporter;
- use base qw(Exporter);
- use FastUtils;
- our %EXPORT_TAGS = (
- # Manipulation functions for arrays which can contain "holes".
- arrays => [qw( binAdd binFind binFindReverse binRemove binRemoveAndShift
- binRemoveAndShiftByIndex binSize )],
- # Functions for searching in arrays and nested data structures.
- finders => [qw( existsInList findIndex findIndexString findIndexString_lc findIndexString_lc_not_equip
- findIndexStringList_lc findLastIndex findKey findKeyString )],
- # Misc array functions.
- misc => [qw( compactArray hashCopyByKey minHeapAdd shuffleArray )]
- );
- our @EXPORT_OK = (
- @{$EXPORT_TAGS{arrays}},
- @{$EXPORT_TAGS{finders}},
- @{$EXPORT_TAGS{misc}}
- );
- $EXPORT_TAGS{all} = @EXPORT_OK;
- ##
- # void binAdd(Array* array, ID)
- # array: a reference to an array.
- # ID: the element to add to @array.
- # Requires: defined($array)
- # Returns: the index of the added element.
- #
- # Add $ID to the first empty slot (that is, a slot which is set to undef)
- # in @array, or append it to the end of @array if there are no empty
- # slots.
- #
- # Example:
- # @list = ("ID1", undef, "ID2");
- # binAdd(@list, "New"); # --> Returns: 1
- # # Result:
- # # $list[0] eq "ID1"
- # # $list[1] eq "New"
- # # $list[2] eq "ID2"
- #
- # @list = ("ID1", "ID2");
- # binAdd(@list, "New"); # --> Returns: 2
- # # Result:
- # # $list[0] eq "ID1"
- # # $list[1] eq "ID2"
- # # $list[2] eq "New"
- sub binAdd {
- my $r_array = shift;
- my $ID = shift;
- my $i;
- for ($i = 0; $i <= @{$r_array};$i++) {
- if ($$r_array[$i] eq "") {
- $$r_array[$i] = $ID;
- return $i;
- }
- }
- }
- ##
- # binFind(Array *array, ID)
- # array: a reference to an array.
- # ID: the element to search for.
- # Returns: the index of the element for $ID, or undef is $ID
- # is not an element in $array.
- #
- # Look for element $ID in $array.
- #
- # Example:
- # our @array = ("hello", "world", "!");
- # binFind(@array, "world"); # => 1
- # binFind(@array, "?"); # => undef
- # This function is written in src/auto/XSTools/misc/fastutils.xs
- ##
- # binFindReverse(Array *array, ID)
- #
- # Same as binFind() but starts looking from the end of the array
- # instead of from the beginning.
- sub binFindReverse {
- my $r_array = shift;
- my $ID = shift;
- my $i;
- for ($i = @{$r_array} - 1; $i >= 0;$i--) {
- if ($$r_array[$i] eq $ID) {
- return $i;
- }
- }
- }
- ##
- # void binRemove(Array *array, ID)
- # array: a reference to an array
- # ID: the element to remove.
- #
- # Find a value in $array which has the same value as $ID,
- # and remove it.
- #
- # Example:
- # our @array = ("hello", "world", "!");
- # # Same as: delete $array[1];
- # binRemove(@array, "world");
- sub binRemove {
- my $r_array = shift;
- my $ID = shift;
- my $i;
- for ($i = 0; $i < @{$r_array};$i++) {
- if ($$r_array[$i] eq $ID) {
- delete $$r_array[$i];
- last;
- }
- }
- }
- sub binRemoveAndShift {
- my $r_array = shift;
- my $ID = shift;
- my $found;
- my $i;
- my @newArray;
- for ($i = 0; $i < @{$r_array};$i++) {
- if ($$r_array[$i] ne $ID || $found ne "") {
- push @newArray, $$r_array[$i];
- } else {
- $found = $i;
- }
- }
- @{$r_array} = @newArray;
- return $found;
- }
- sub binRemoveAndShiftByIndex {
- my $r_array = shift;
- my $index = shift;
- my $found;
- my $i;
- my @newArray;
- for ($i = 0; $i < @{$r_array};$i++) {
- if ($i != $index) {
- push @newArray, $$r_array[$i];
- } else {
- $found = 1;
- }
- }
- @{$r_array} = @newArray;
- return $found;
- }
- ##
- # int binSize(Array *array)
- # r_array: a reference to an array.
- #
- # Calculates the size of $array, excluding undefined values.
- #
- # Example:
- # our @array = ("hello", undef, "world");
- # scalar @array; # -> 3
- # binSize(@array); # -> 2
- sub binSize {
- my $r_array = shift;
- return 0 if !defined $r_array;
- my $found = 0;
- my $i;
- for ($i = 0; $i < @{$r_array};$i++) {
- if ($$r_array[$i] ne "") {
- $found++;
- }
- }
- return $found;
- }
- ##
- # void compactArray(Array *array)
- #
- # Resize an array by removing undefined items.
- sub compactArray {
- my ($array) = @_;
- for (my $i = $#{$array}; $i >= 0; $i--) {
- if (!defined $array->[$i]) {
- splice @{$array}, $i, 1;
- }
- }
- }
- ##
- # boolean existsInList(list, val)
- # list: a string containing a list of comma-seperated items.
- # val: the value to check for.
- #
- # Check whether $val exists in $list. This function is case-insensitive.
- #
- # Example:
- # my $list = "Apple,Orange Juice";
- # existsInList($list, "apple"); # => 1
- # existsInList($list, "Orange Juice"); # => 1
- # existsInList($list, "juice"); # => 0
- sub existsInList {
- my ($list, $val) = @_;
- return 0 if ($val eq "");
- my @array = split / *, */, $list;
- $val = lc($val);
- foreach (@array) {
- s/^s+//;
- s/s+$//;
- s/s+/ /g;
- next if ($_ eq "");
- return 1 if (lc($_) eq $val);
- }
- return 0;
- }
- ##
- # findIndex(r_array, key, [num])
- # r_array: A reference to an array, which contains a hash in each element.
- # key: The name of the key to lookup.
- # num: The number to compare with.
- # Returns: The index in r_array of the found item, or undef if not found. Or, if not found and $num is not given: returns the index of first undefined array element, or the index of the last array element + 1.
- #
- # This function loops through the entire array, looking for a hash item whose
- # value equals $num.
- #
- # Example:
- # my @inventory;
- # $inventory[0]{amount} = 50;
- # $inventory[1]{amount} = 100;
- # $inventory[2] = undef;
- # $inventory[3]{amount} = 200;
- # findIndex(@inventory, "amount", 100); # 1
- # findIndex(@inventory, "amount", 99); # undef
- # findIndex(@inventory, "amount"); # 2
- #
- # @inventory = ();
- # $inventory[0]{amount} = 50;
- # findIndex(@inventory, "amount"); # 1
- sub findIndex {
- my $r_array = shift;
- return undef if !$r_array;
- my $key = shift;
- my $num = shift;
- if ($num ne "") {
- my $max = @{$r_array};
- for (my $i = 0; $i < $max; $i++) {
- return $i if (exists $r_array->[$i] && $r_array->[$i]{$key} == $num);
- }
- return undef;
- } else {
- my $max = @{$r_array};
- my $i;
- for ($i = 0; $i < $max; $i++) {
- return $i if (!$r_array->[$i] || !%{$r_array->[$i]});
- }
- return $i;
- }
- }
- ##
- # findIndexString(r_array, key, [str])
- #
- # Same as findIndex(), except this function compares strings, not numbers.
- sub findIndexString {
- my $r_array = shift;
- return undef if !$r_array;
- my $key = shift;
- my $str = shift;
- if ($str ne "") {
- my $max = @{$r_array};
- for (my $i = 0; $i < $max; $i++) {
- if (exists $r_array->[$i] && $r_array->[$i]{$key} eq $str) {
- return $i;
- }
- }
- return undef;
- } else {
- my $max = @{$r_array};
- my $i;
- for ($i = 0; $i < $max; $i++) {
- return $i if (!$r_array->[$i] || !%{$r_array->[$i]});
- }
- return $i;
- }
- }
- ##
- # findIndexString_lc(r_array, key, [str])
- #
- # Same has findIndexString(), except this function does case-insensitive string comparisons.
- sub findIndexString_lc {
- my $r_array = shift;
- return undef if !$r_array;
- my $key = shift;
- my $str = shift;
- if ($str ne "") {
- $str = lc $str;
- my $max = @{$r_array};
- for (my $i = 0; $i < $max; $i++) {
- return $i if (exists $r_array->[$i] && lc($r_array->[$i]{$key}) eq $str);
- }
- return undef;
- } else {
- my $max = @{$r_array};
- my $i;
- for ($i = 0; $i < $max; $i++) {
- return $i if (!$r_array->[$i] || !%{$r_array->[$i]});
- }
- return $i;
- }
- }
- our %findIndexStringList_lc_cache;
- sub findIndexStringList_lc {
- my $r_array = shift;
- return undef if !defined $r_array;
- my $match = shift;
- my $ID = shift;
- my $skipID = shift;
- my $max = @{$r_array};
- my ($i, $arr);
- if (exists $findIndexStringList_lc_cache{$ID}) {
- $arr = $findIndexStringList_lc_cache{$ID};
- } else {
- my @tmp = split / *, */, lc($ID);
- $arr = @tmp;
- %findIndexStringList_lc_cache = () if (scalar(keys %findIndexStringList_lc_cache) > 30);
- $findIndexStringList_lc_cache{$ID} = $arr;
- }
- foreach (@{$arr}) {
- for ($i = 0; $i < $max; $i++) {
- next if $i eq $skipID;
- if (exists $r_array->[$i] && lc($r_array->[$i]{$match}) eq $_) {
- return $i;
- }
- }
- }
- if ($ID eq "") {
- return $i;
- } else {
- return undef;
- }
- }
- ##
- # findIndexString_lc_not_equip(r_array, key, [str])
- #
- # Same has findIndexString(), except this function does case-insensitive string comparisons.
- # It only finds items which are not equipped AND are able to be equipped (identified).
- sub findIndexString_lc_not_equip {
- my $r_array = shift;
- return undef if !defined $r_array;
- my $match = shift;
- my $ID = lc(shift);
- my $i;
- for ($i = 0; $i < @{$r_array} ;$i++) {
- if ((exists $r_array->[$i] && lc($$r_array[$i]{$match}) eq $ID && ($$r_array[$i]{'identified'}) && !($$r_array[$i]{'equipped'}))
- || (!$$r_array[$i] && $ID eq "")) {
- return $i;
- }
- }
- if ($ID eq "") {
- return $i;
- } else {
- return undef;
- }
- }
- sub findLastIndex {
- my $r_array = shift;
- return undef if !$r_array;
- my $key = shift;
- my $num = shift;
- if ($num ne "") {
- my $max = @{$r_array};
- for (my $i = $max-1; $i > -1; $i--) {
- return $i if (exists $r_array->[$i] && $r_array->[$i]{$key} == $num);
- }
- return undef;
- } else {
- my $max = @{$r_array};
- my $i;
- for ($i = $max-1; $i > -1; $i--) {
- return $i if (!$r_array->[$i] || !%{$r_array->[$i]});
- }
- return $i;
- }
- }
- sub findKey {
- my $r_hash = shift;
- my $match = shift;
- my $ID = shift;
- foreach (keys %{$r_hash}) {
- if (exists $r_hash->{$_} && $r_hash->{$_}{$match} == $ID) {
- return $_;
- }
- }
- }
- sub findKeyString {
- my $r_hash = shift;
- my $match = shift;
- my $ID = shift;
- foreach (keys %{$r_hash}) {
- if (ref($r_hash->{$_}) && $r_hash->{$_}{$match} eq $ID) {
- return $_;
- }
- }
- }
- ##
- # hashCopyByKey(Hash* target, Hash* source, keys...)
- #
- # Copies each key from the target to the source.
- #
- # For example,
- # <pre class="example">
- # hashCopyByKey(%target, %source, qw(some keys));
- # </pre>
- # would copy 'some' and 'keys' from the source hash to the
- # target hash.
- sub hashCopyByKey {
- my ($target, $source, @keys) = @_;
- foreach (@keys) {
- $target->{$_} = $source->{$_} if exists $source->{$_};
- }
- }
- sub minHeapAdd {
- my $r_array = shift;
- my $r_hash = shift;
- my $match = shift;
- my $i;
- my $found;
- my @newArray;
- for ($i = 0; $i < @{$r_array};$i++) {
- if (!$found && exists $r_array->[$i] && $$r_hash{$match} < $$r_array[$i]{$match}) {
- push @newArray, $r_hash;
- $found = 1;
- }
- push @newArray, $$r_array[$i];
- }
- if (!$found) {
- push @newArray, $r_hash;
- }
- @{$r_array} = @newArray;
- }
- ##
- # void shuffleArray(Array* array)
- # array: A reference to an array.
- #
- # Randomize the order of the items in the array.
- sub shuffleArray {
- my $r_array = shift;
- my $i = @{$r_array};
- my $j;
- while ($i--) {
- $j = int rand ($i+1);
- @$r_array[$i,$j] = @$r_array[$j,$i];
- }
- }
- 1;