--- deliantra/server/ext/Jeweler.pm 2006/12/15 19:29:18 1.1 +++ deliantra/server/ext/Jeweler.pm 2010/04/28 21:05:33 1.33 @@ -10,8 +10,7 @@ package Jeweler; -use strict; -use YAML; +use common::sense; =over 4 @@ -23,16 +22,11 @@ our $CFG; -sub read_config { - my ($filename) = @_; - - unless (-e $filename) { - warn "$filename doesn't exists! no config for jeweler skill loaded!\n"; - $CFG = {}; - return - } +sub load_config { + 0 < Coro::AIO::aio_load "$cf::DATADIR/jeweler", my $data + or die "$cf::DATADIR/jeweler: $!"; - $CFG = YAML::LoadFile $filename; + $CFG = cf::decode_json $data; } sub getcfg { @@ -119,6 +113,8 @@ cf::ATNR_DISEASE => "DISEASE", ); +our %REV_RESMAP = map { $RESMAP{$_} => $_ } keys %RESMAP; + our %LVL_DIFF_CHANCES = ( +5 => 100, +4 => 95, @@ -162,29 +158,32 @@ } sub analyze { - my ($sk, $chdl, $pl) = @_; + my ($sk, $chdl, $pl, $input_level) = @_; my $hadunid = 0; + my $found = 0; for ($chdl->grep_by_type (cf::RING, cf::AMULET)) { if (!$_->flag (cf::FLAG_IDENTIFIED) && $_->need_identify) { $hadunid = 1; next; } + $found = 1; my $r = Jeweler::Object->new (object => $_); - my $msg = $r->analyze ($sk, $pl); + my $msg = $r->analyze ($sk, $pl, $input_level); $pl->message ($r->to_string . ": " . $msg); if ($pl->flag (cf::FLAG_WIZ)) { $r->wiz_analyze ($pl); } } - if ($hadunid) { - $pl->message ("You couldn't identify the other rings and not analyze them!"); - } + $pl->message ("You couldn't identify the other rings and not analyze them!") + if $hadunid; + $pl->message ("You couldn't find anything in the bench to analyse!") + unless $found; } # this function converts metals/minerals into a raw ring (of adornment) sub simple_converter { - my ($pl, $ingred, $chdl, $conv) = @_; + my ($pl, $ingred, $chdl, $conv, $sk_lvl, $low_skill_cb) = @_; $conv = lc $conv; my $cnvs = $CFG->{conversions}; @@ -203,7 +202,7 @@ } unless ($xp_gain > 0) { - warn "WARNING: xp gain isn't > 0 in convesion '$outarch'\n"; + warn "WARNING: xp gain isn't > 0 in conversion '$outarch'\n"; return; } @@ -216,22 +215,34 @@ warn "WARNING: source-arch-value-multiplier < 1 in conversion '$outarch', results in more valuable output!\n"; } - my $archvalsum = $ingred->value ($ingr_grp, $srcarchname); - $ingred->remove ($ingr_grp, $srcarchname); + my $archvalsum = $ingred->value ($ingr_grp, $srcarchname); + my $outarchval = cf::arch::find ($outarch)->value; + my $nrof = int $archvalsum / (($outarchval || 1000) * $outarchvalfact); + my $can_make_nr = int (($sk_lvl / 2) + 10); - my $outarchval = cf::arch::find ($outarch)->clone->value; + if ($nrof > $can_make_nr) { + $pl->ob->message ("Your jeweler level is too low to make $nrof rings, you can only make $can_make_nr at your current level."); + return; + } - my $nrof = int ($archvalsum / (($outarchval || 1000) * $outarchvalfact)); if ($nrof) { - # XXX: yes, i know what i'm doing here, i don't set nrof, but it didn't work somehow (pls. chek sometimes) - $chdl->put (cf::object::new $outarch) for 1..$nrof; + # XXX: yes, I know what I'm doing here, I don't set nrof, but it didn't work somehow (pls. check sometimes) + $ingred->remove ($ingr_grp, $srcarchname); + for (1 .. $nrof) { + $chdl->put (my $ob = cf::object::new $outarch); + $ob->set_animation (cf::rndm $ob->num_animations) + if ($ob->type == cf::RING); + $ob->flag (cf::FLAG_IDENTIFIED, 1); + } - my $xp_sum = ($xp_gain * $nrof); + my $xp_sum = $xp_gain * $nrof; if ($xp_sum) { $pl->ob->message ("You got $xp_sum xp by making $nrof ${outarch}s"); - $pl->ob->change_exp ($xp_sum, "jeweler", cf::SK_EXP_ADD_SKILL); + $pl->ob->change_exp ($xp_sum, "jeweler", cf::SK_EXP_SKILL_ONLY); } + } else { + $pl->ob->message ("You fail to make something, probably you used not enough source material?"); } } @@ -273,7 +284,7 @@ my @c = grep { $_->flag (cf::FLAG_IS_CAULDRON) - and $_->arch->name eq $arch_name + and $_->arch->archname eq $arch_name } @map_stack; $self->{cauldron} = $c[0]; @@ -322,9 +333,16 @@ ); for ($self->{cauldron}->inv) { + if (!$_->flag (cf::FLAG_IDENTIFIED) && $_->need_identify) { + die "unidentified"; + } elsif ($_->flag (cf::FLAG_CURSED) || $_->flag (cf::FLAG_DAMNED)) { + die "cursed"; + } if (my $k = $type_to_key{$_->type}) { push @{$ingreds->{$k}}, $_; + } else { + push @{$ingreds->{other}}, $_; } } @@ -341,7 +359,7 @@ my ($self, $obj) = @_; return undef unless $self->{cauldron}; - $obj->insert_ob_in_ob ($self->{cauldron}); + $self->{cauldron}->insert ($obj); } =back @@ -384,7 +402,7 @@ my ($self, $group, $archname) = @_; my @objs = grep { - $_->arch->name eq $archname + $_->arch->archname eq $archname } @{$self->{ingredients}->{$group} || []}; my $sum = 0; @@ -411,7 +429,7 @@ for (@{$ingred->{$group}}) { if (defined $archname) { - if ($_->arch->name eq $archname) { + if ($_->arch->archname eq $archname) { Jeweler::Util::remove ($_); } else { push @out, $_; @@ -429,21 +447,17 @@ my $ingred = $self->{ingredients}; - for my $grp (keys %$ingred) { - for my $pot (@{$ingred->{$grp}}) { - for my $plan (keys %{$Jeweler::CFG->{plans}}) { - my $plg = $Jeweler::CFG->{plans}->{$plan}; - my @plga = (); - unless (ref $plg eq 'ARRAY') { - push @plga, $plg; - } else { - @plga = @$plg; - } - next unless @plga > 0; - if (Jeweler::Util::grep_for_match ($pot, @plga)) { - return $plan; - } - } + for my $plan (keys %{$Jeweler::CFG->{plans}}) { + my $plg = $Jeweler::CFG->{plans}->{$plan}; + my @plga = (); + unless (ref $plg eq 'ARRAY') { + push @plga, $plg; + } else { + @plga = @$plg; + } + next unless @plga > 0; + if (Jeweler::Util::grep_for_match ($ingred, @plga)) { + return $plan; } } } @@ -456,10 +470,18 @@ ); } +sub improve_max { + my ($stat, $impro) = @_; + if ($stat >= 0) { + $stat = $impro > $stat ? $impro : $stat; + } + $stat +} + sub improve_ring_by_plan { my ($self, $plan, $ring) = @_; - $ring = dclone ($ring); + $ring = dclone $ring; my $ingred = $self->{ingredients}; my $impr = {}; @@ -470,79 +492,116 @@ or die "ingredients for plan '$plan' not defined!"; my $cnt = 0; - for my $pot (@{$ingred->{potions}}) { - if (Jeweler::Util::grep_for_match ($pot, @$plingred)) { - $cnt += $pot->nrof; - } + if (my $pot = Jeweler::Util::grep_for_match ($ingred, @$plingred)) { + $cnt += $pot->nrof; } my $maxstat = Jeweler::getcfg (maximprovements => 'stats'); - my $did_impr = 0; for my $x (1..$maxstat) { - my $y = Jeweler::Object::fx ($x, 'stat_potions'); + my $y = Jeweler::Object::fx ($x, 'stat_items'); if ($cnt <= $y->[0]) { - $ring->{hash}->{stat}->{$statname} += $x; - $did_impr = 1; + $ring->{hash}->{stat}->{$statname} = + improve_max $ring->{hash}->{stat}->{$statname}, $x; last; } } - # we want at least this improvement if we have a plan... - $ring->{hash}->{stat}->{$statname} += 1 unless $did_impr; - } elsif ($plan =~ m/^spec_(\S+)$/) { + my $specname = $1; + my $plingred = Jeweler::getcfg (plans => $plan) + or die "ingredients for plan '$plan' not defined!"; + + my $cnt = 0; + if (my $pot = Jeweler::Util::grep_for_match ($ingred, @$plingred)) { + $cnt += $pot->nrof; + } + + my $maxspec = Jeweler::getcfg (maximprovements => 'specials'); + for my $x (1..$maxspec) { + my $y = Jeweler::Object::fx ($x, 'spec_items'); + + if ($cnt <= $y->[0]) { + $ring->{hash}->{spec}->{$specname} = + improve_max $ring->{hash}->{spec}->{$specname}, $x; + last; + } + } + } elsif ($plan =~ m/^resist_(\S+)$/) { + my $resname = $1; + my $resnum = $REV_RESMAP{$resname}; + my $plingred = Jeweler::getcfg (plans => $plan) + or die "ingredients for plan '$plan' not defined!"; + + my $cnt = 0; + if (my $it = Jeweler::Util::grep_for_match ($ingred, @$plingred)) { + $cnt += $it->nrof; + } + my $resist_item_nr = 0; + $self->do_grep (sub { $resist_item_nr += ($_[0]->nrof || 1); 0 }, @$plingred); + + my $maximprovname = (grep { $resnum eq $_ } @Jeweler::EFFECT_RESISTS) + ? 'effect_resistances' + : 'attack_resistances'; + + my $maxres = Jeweler::getcfg (maximprovements => $maximprovname); + $resist_item_nr = $maxres if ($resist_item_nr > $maxres); + $ring->{hash}->{resist}->{$resnum} = + improve_max $ring->{hash}->{resist}->{$resnum}, $resist_item_nr; } return $ring; } sub do_grep { - my ($self, $cb, @grepar) = @_; + my ($self, $cb, $cat, @grepar) = @_; my $ingred = $self->{ingredients}; - - for my $cat (keys %$ingred) { - my @rem; - for my $ing (@{$ingred->{$cat}}) { - if (Jeweler::Util::grep_for_match ($ing, @grepar)) { - unless ($cb->($ing)) { - push @rem, $ing; - } - } else { + my @rem; + for my $ing (@{$ingred->{$cat}}) { + if (Jeweler::Util::check_for_match ($ing, @grepar)) { + unless ($cb->($ing)) { push @rem, $ing; } + } else { + push @rem, $ing; } - @{$ingred->{$cat}} = @rem; } + @{$ingred->{$cat}} = @rem; } sub check_costs { my ($self, $costs, $do_remove) = @_; - my $costs = dclone ($costs); + my $costs = dclone $costs; for my $key (keys %$costs) { my @grepar; - if ($key =~ m/^stat_(\S+)$/) { - @grepar = @{Jeweler::getcfg (plans => $key) || []}; - } else { - @grepar = (undef, undef, $key); + if ($key =~ m/^(resist_|spec_|stat_)/) { # check the special items + eval { @grepar = @{Jeweler::getcfg (plans => $key) || []} }; + next if $@; + } else { # check the gems + @grepar = ('gems', undef, undef, $key); } if ($do_remove) { my $rem = $costs->{$key}; - $self->do_grep (sub { if ($rem) { $rem = Jeweler::Util::remove ($_[0], $rem); } 1 }, @grepar); + $self->do_grep (sub { + if ($rem) { $rem = Jeweler::Util::remove ($_[0], $rem); } + 1 + }, @grepar); if ($rem > 0) { - warn "JEWELER BUG: removed ingredients $rem > 0 after removing!"; + warn "JEWELER BUG: removed ingredients ($key) $rem > 0 after removing!"; } + } else { my $nr; - $self->do_grep (sub { $nr += $_[0]->nrof; 0 }, @grepar); + $self->do_grep (sub { $nr += ($_[0]->nrof || 1); 0 }, @grepar); $costs->{$key} -= $nr; } + } return $costs; @@ -579,8 +638,55 @@ $self; } +sub has_resist { + my ($self, $resistnam, $resistval) = @_; + my $resnum = $REV_RESMAP{uc $resistnam}; + if (defined ($resistval)) { + return 1 if $self->{hash}->{resist}->{$resnum} == $resistval; + } else { + return 1 if $self->{hash}->{resist}->{$resnum}; + } + return undef; +} + +sub projected_exp { + my ($self, $input_level) = @_; + + my $lvl = max ($self->power_to_level, 1); + my $exp = + (cf::level_to_min_exp ($lvl) - cf::level_to_min_exp ($lvl - 1)) + / (10 + max ($lvl - 1, 0)); # 10 + level times making such a ring + # should get you to the rings level at least. + + if (defined $input_level) { + my $subexp = + (cf::level_to_min_exp ($input_level) + - cf::level_to_min_exp ($input_level - 1)) + / (10 + max ($input_level - 1, 0)); # see above for comment + + $exp -= $subexp; + $exp = max ($exp, 0); + + } else { + # the experience bonus here is to make level 1 rings give you at least + # 200 exp points when making them. This also makes leveling in the + # first few levels a bit easier. (probably until around level 5-6). + my $expbonus = cf::level_to_min_exp (2) / 5; + # this bonus should also only be given for _new_ rings and not for merged + # ones - to prevent infinite exp making. + $exp += $expbonus; + } + + $exp +} + sub analyze { - my ($self, $sk, $pl) = @_; + my ($self, $sk, $pl, $input_level) = @_; + my $costs = $self->calc_costs; + + unless (defined $costs) { + return "This ring has a resistancy above 99%, you can't make that."; + } my $sklvl = cf::exp_to_level ($sk->stats->exp); my $ringlvl = $self->power_to_level; @@ -591,20 +697,45 @@ } else { $tmpl = Jeweler::level_diff_to_str ($sklvl - $ringlvl); } - my $msg = sprintf "Projected success rate: %s", $tmpl; + my $msg = sprintf "Projected success rate: %s, you would get %d exp for this.", $tmpl, $self->projected_exp ($input_level); return $msg; } +sub calc_value_from_cost { + my ($self, $costs) = @_; + my $emarch = cf::arch::find 'emerald'; + my $saarch = cf::arch::find 'sapphire'; + my $pearch = cf::arch::find 'pearl'; + my $ruarch = cf::arch::find 'ruby'; + my $diarch = cf::arch::find 'gem'; + my $value = $emarch->value * $costs->{emerald} + + $saarch->value * $costs->{sapphire} + + $pearch->value * $costs->{pearl} + + $ruarch->value * $costs->{ruby} + + $diarch->value * $costs->{gem}; + + $value +} + sub wiz_analyze { my ($self, $pl) = @_; my $costs = $self->calc_costs; - my $desc = ""; - my $lvl = $self->power_to_level (\$desc); - $pl->message ("costs: " . join (', ', map { "$_: " . sprintf "%.2f", $costs->{$_} } keys %$costs)); - $pl->message ("level: " . $desc); + if (defined $costs) { + my $desc = ""; + my $lvl = $self->power_to_level (\$desc); + my $scosts = $self->calc_value_from_cost ($costs); + + $pl->message ("costs: " + . (join ', ', map { "$_: " . sprintf "%.2f", $costs->{$_} } keys %$costs) + . " (" + . ($scosts / "platinacoin"->cf::arch::find->value) + . " platinum)"); + $pl->message ("level: $desc"); + } else { + $pl->message ("level: impossible to make, due to impossible resistancy configuration"); + } } - sub get_chance_perc { my ($self, $sk) = @_; my $sklvl = cf::exp_to_level ($sk->stats->exp); @@ -616,12 +747,23 @@ my ($res, $cfg) = @_; my $or = $res; my $ar = $Jeweler::CFG->{functions}->{$cfg}; - if (ref $ar->[0] eq 'ARRAY') { + + if (ref $ar && ref $ar->[0] eq 'ARRAY') { $res = $res - 1; + return $ar->[max (min ($res, @$ar - 1), 0)]; + } else { - $res = ceil ($res / 5) - 1; + # +0.1 is for a jump to the next index when $res / 5 is exactly 1, 2, 3... + # old code: + #my $idx = ceil (($res / 5) + 0.1) - 1; + #my $a = $ar->[max (min ($idx, @$ar - 1), 0)]; + #my $b = $ar->[max (min ($idx + 1, @$ar - 1), 0)]; + #my $diff = $b - $a; # use the difference of the cost to the next cost + #my $o_cost = $a + ($diff / 5) * ($res % 5); # and do some linear interpolation + #return $o_cost; + return 0 if $res <= 0; + return ($ar / (1 - ($res * 0.01)) - $ar) } - $ar->[max (min ($res, @$ar - 1), 0)]; } sub improve_by_ring { @@ -647,6 +789,7 @@ } } } + $self->{hash}{value} = 0; } sub to_string { @@ -677,7 +820,7 @@ my $obj = {}; for (@Jeweler::RESISTS) { - $obj->{resist}->{$_} = $thing->resistance ($_); + $obj->{resist}->{$_} = $thing->resist ($_); } my $stats = $thing->stats; @@ -695,9 +838,13 @@ $obj->{spec}{food} = $stats->food; $obj->{name} = $thing->name; - $obj->{arch} = $thing->arch->name; + $obj->{arch} = $thing->arch->archname; $obj->{face} = $thing->face; + $obj->{value} = $thing->value; + + $obj->{is_ring} = ($thing->type == cf::RING); + $self->{hash} = $obj } @@ -706,6 +853,8 @@ my $obj = cf::object::new $self->{hash}->{arch}; + $obj->item_power (floor ($self->power_to_level / 3)); # there have to be strings attached! + $obj->face ($self->{hash}{face}); my $stats = $obj->stats; @@ -722,14 +871,32 @@ for qw/Str Dex Con Wis Cha Int Pow/; for (@Jeweler::RESISTS) { - $obj->resistance ($_, $self->{hash}->{resist}->{$_}); + $obj->resist ($_, $self->{hash}->{resist}->{$_}); } $obj->flag (cf::FLAG_IDENTIFIED, 1); + $obj->value ($self->{hash}{value}); + return $obj; } +sub set_value { $_[0]->{hash}{value} = $_[1] } + +sub is_better_than { + my ($self, $other) = @_; + + for my $type (qw/spec stat resist/) { + for my $stat (keys %{$self->{hash}->{$type}}) { + if ($self->{hash}->{$type}->{$stat} > $other->{hash}->{$type}->{$stat}) { + return 1; + } + } + } + + return 0; +} + sub stat_level { my ($self) = @_; my $stats = $self->{hash}->{stat} || {}; @@ -749,8 +916,8 @@ my $resists = $self->{hash}->{resist} || {}; - my $att_res_lvl = Jeweler::getcfg (maxlevels => 'resist_level'); - my $efc_res_lvl = Jeweler::getcfg (maxlevels => 'effect_resist_level'); + my $att_res_lvl = Jeweler::getcfg (maxlevels => 'resist_level'); + my $efc_res_lvl = Jeweler::getcfg (maxlevels => 'effect_resist_level'); my $max_att_res = Jeweler::getcfg (maximprovements => 'attack_resistances'); my $max_efc_res = Jeweler::getcfg (maximprovements => 'effect_resistances'); my $max_ovr_res = Jeweler::getcfg (maximprovements => 'resistances'); @@ -820,6 +987,7 @@ my $max_imprs = Jeweler::getcfg (maximprovements => 'improvements'); my $max_impr_lvl = Jeweler::getcfg (maxlevels => 'improve_level'); + my $ring_offs = Jeweler::getcfg (maxlevels => 'ring_offset'); my ($stat_lvl, $stat_imprs) = $self->stat_level; my ($resist_lvl, $res_imprs) = $self->resist_level; @@ -827,10 +995,18 @@ my $impr_sum = $stat_imprs + $res_imprs + $spec_imprs; - my $impr_lvl = ceil (($max_impr_lvl / ($max_imprs + 1)) * ($impr_sum - 1)); # 1 improvemnt bonus + my $impr_lvl = + ceil (($max_impr_lvl / ($max_imprs + 1)) + * ($impr_sum - 1)); # 1 improvemnt bonus my $levl = int max ($stat_lvl, $resist_lvl, $impr_lvl, $spec_lvl, 0); + if ($self->{hash}->{is_ring}) { + $levl += $ring_offs; + } + + $levl = min ($levl, cf::settings->max_level); + if ($lvldescr) { $$lvldescr = sprintf "%3d: %s\n", $levl, @@ -851,7 +1027,7 @@ next unless $sum > 0; - my $statfx = fx ($sum, 'stat_potions'); + my $statfx = fx ($sum, 'stat_items'); $cost->{"stat_$stat"} += $statfx->[0]; split_diamonds ($cost, $statfx->[1], 'stat_' . $stat); } @@ -867,7 +1043,7 @@ next unless $sum > 0; - my $specfx = fx ($sum, 'spec_potions'); + my $specfx = fx ($sum, 'spec_items'); $cost->{"spec_$spec"} += $specfx->[0]; split_diamonds ($cost, $specfx->[1], 'spec_' . $spec); } @@ -880,22 +1056,24 @@ my $ring = $self->{hash}; - for my $resnam (keys %{$ring->{resist} || {}}) { + for my $resnum (keys %{$ring->{resist} || {}}) { - my $res = $ring->{resist}->{$resnam}; + my $res = $ring->{resist}->{$resnum}; next unless $res > 0; - $costs->{"resist_" . $Jeweler::RESMAP{$resnam} . "_item"} += $res; + return undef if $res == 100; + + $costs->{"resist_" . $Jeweler::RESMAP{$resnum}} += $res; my $diamonds; - if (grep { $resnam eq $_ } @Jeweler::EFFECT_RESISTS) { - $diamonds += fx ($res, 'effect_resist_diamonds'); + if (grep { $resnum eq $_ } @Jeweler::EFFECT_RESISTS) { + $diamonds += fx ($res, 'effect_resist_diamonds_x'); } else { - $diamonds += fx ($res, 'attack_resist_diamonds'); + $diamonds += fx ($res, 'attack_resist_diamonds_x'); } - split_diamonds ($costs, $diamonds, 'resist_' . $Jeweler::RESMAP{$resnam}); + split_diamonds ($costs, $diamonds, 'resist_' . $Jeweler::RESMAP{$resnum}); } $self->add_stat_costs ($costs); @@ -910,9 +1088,6 @@ my $stat_split = Jeweler::getcfg (diamond_split => $category); my $sum = sum (@$stat_split); - if ($sum < (1 - 0.0001)) { - warn "JEWELER BUG: sum (@$stat_split) = $sum < 1 for $category!"; - } my $emarch = cf::arch::find 'emerald'; my $saarch = cf::arch::find 'sapphire'; @@ -920,13 +1095,13 @@ my $ruarch = cf::arch::find 'ruby'; my $diarch = cf::arch::find 'gem'; - my $sumvalue = $diarch->clone->value * $diamonds; + my $sumvalue = $diarch->value * $diamonds; - $cost->{emerald} += ceil $sumvalue * $stat_split->[0] / max 1, $emarch->clone->value; - $cost->{sapphire} += ceil $sumvalue * $stat_split->[1] / max 1, $saarch->clone->value; - $cost->{pearl} += ceil $sumvalue * $stat_split->[2] / max 1, $pearch->clone->value; - $cost->{ruby} += ceil $sumvalue * $stat_split->[3] / max 1, $ruarch->clone->value; - $cost->{gem} += ceil $sumvalue * $stat_split->[4] / max 1, $diarch->clone->value; + $cost->{emerald} += ceil $sumvalue * $stat_split->[0] / max 1, $emarch->value; + $cost->{sapphire} += ceil $sumvalue * $stat_split->[1] / max 1, $saarch->value; + $cost->{pearl} += ceil $sumvalue * $stat_split->[2] / max 1, $pearch->value; + $cost->{ruby} += ceil $sumvalue * $stat_split->[3] / max 1, $ruarch->value; + $cost->{gem} += ceil $sumvalue * $stat_split->[4] / max 1, $diarch->value; } package Jeweler::Util; @@ -942,56 +1117,67 @@ =item remove ($object[, $nrof]) Removes the C<$object>. If C<$nrof> is given, remove only C<$nrof> objects. -The returnvalue is the number of 'single' objects that couldn't be removed. +The return value is the number of 'single' objects that couldn't be removed. =cut sub remove { my ($obj, $nrof) = @_; + + my $c = $obj->nrof || 1; + my $r = $c > $nrof ? 0 : $nrof - $c; + $obj->decrease (defined ($nrof) ? $nrof : ($obj->nrof || 1)); - my $cnt; - - if (defined $nrof) { - return 0 if ($nrof * 1) == 0; - $cnt = int (($obj->nrof || 1) - (1 * $nrof)); - - if ($cnt > 0) { - $obj->nrof ($cnt); - return 0; - } - } - - remove ($_) for $obj->inv; - $obj->destroy; - return $cnt; + $r } -sub grep_for_match { +sub check_for_match { my ($thing, @matchar) = @_; my $i = 0; + my $check_cnts = 0; + my $check_true = 0; for my $match (@matchar) { + if ($i % 3 == 0) { + return 1 if $check_true && $check_cnts == $check_true; + $check_cnts = 0; + $check_true = 0; + } + if ($match =~ m/^\s*$/) { $i++; next; } + $check_cnts++; if ($i % 3 == 0) { $thing->name eq $match - and return 1; + and $check_true++; } elsif ($i % 3 == 1) { $thing->title eq $match - and return 1; + and $check_true++; } else { # $i % 3 == 2 - $thing->arch->name eq $match - and return 1; + $thing->arch->archname eq $match + and $check_true++; } $i++; } + #d# warn "CHECK $check_true | $check_cnts | [".(join ',', @matchar).":".join (",", ($thing->name, $thing->title, $thing->arch->archname))."\n"; + return 1 if $check_true && $check_cnts == $check_true; return 0; } -=back +sub grep_for_match { + my ($ingred, $group, @matchar) = @_; + + for my $thing (@{$ingred->{$group} || []}) { + #d# warn sprintf "DEB:(%s,%s,%s)<->%s\n", $thing->name, $thing->title, $thing->arch->archname, "@matchar"; #d# + if (check_for_match ($thing, @matchar)) { + return $thing; + } + } + return undef; +} =back