]> git.donarmstrong.com Git - debbugs.git/blob - Debbugs/Bugs.pm
merge changes from don
[debbugs.git] / Debbugs / Bugs.pm
1 # This module is part of debbugs, and is released
2 # under the terms of the GPL version 2, or any later
3 # version at your option.
4 # See the file README and COPYING for more information.
5 #
6 # Copyright 2007 by Don Armstrong <don@donarmstrong.com>.
7
8 package Debbugs::Bugs;
9
10 =head1 NAME
11
12 Debbugs::Bugs -- Bug selection routines for debbugs
13
14 =head1 SYNOPSIS
15
16 use Debbugs::Bugs qw(get_bugs);
17
18
19 =head1 DESCRIPTION
20
21 This module is a replacement for all of the various methods of
22 selecting different types of bugs.
23
24 It implements a single function, get_bugs, which defines the master
25 interface for selecting bugs.
26
27 It attempts to use subsidiary functions to actually do the selection,
28 in the order specified in the configuration files. [Unless you're
29 insane, they should be in order from fastest (and often most
30 incomplete) to slowest (and most complete).]
31
32 =head1 BUGS
33
34 =head1 FUNCTIONS
35
36 =cut
37
38 use warnings;
39 use strict;
40 use vars qw($VERSION $DEBUG %EXPORT_TAGS @EXPORT_OK @EXPORT);
41 use base qw(Exporter);
42
43 BEGIN{
44      $VERSION = 1.00;
45      $DEBUG = 0 unless defined $DEBUG;
46
47      @EXPORT = ();
48      %EXPORT_TAGS = ();
49      @EXPORT_OK = (qw(get_bugs count_bugs newest_bug bug_filter));
50      $EXPORT_TAGS{all} = [@EXPORT_OK];
51 }
52
53 use Debbugs::Config qw(:config);
54 use Params::Validate qw(validate_with :types);
55 use IO::File;
56 use Debbugs::Status qw(splitpackages get_bug_status);
57 use Debbugs::Packages qw(getsrcpkgs);
58 use Debbugs::Common qw(getparsedaddrs getmaintainers getmaintainers_reverse make_list);
59 use Fcntl qw(O_RDONLY);
60 use MLDBM qw(DB_File Storable);
61 use List::Util qw(first);
62 use Carp;
63
64 =head2 get_bugs
65
66      get_bugs()
67
68 =head3 Parameters
69
70 The following parameters can either be a single scalar or a reference
71 to an array. The parameters are ANDed together, and the elements of
72 arrayrefs are a parameter are ORed. Future versions of this may allow
73 for limited regular expressions, and/or more complex expressions.
74
75 =over
76
77 =item package -- name of the binary package
78
79 =item src -- name of the source package
80
81 =item maint -- address of the maintainer
82
83 =item submitter -- address of the submitter
84
85 =item severity -- severity of the bug
86
87 =item status -- status of the bug
88
89 =item tag -- bug tags
90
91 =item owner -- owner of the bug
92
93 =item correspondent -- address of someone who sent mail to the log
94
95 =item affects -- bugs which affect this package
96
97 =item dist -- distribution (I don't know about this one yet)
98
99 =item bugs -- list of bugs to search within
100
101 =item function -- see description below
102
103 =back
104
105 =head3 Special options
106
107 The following options are special options used to modulate how the
108 searches are performed.
109
110 =over
111
112 =item archive -- whether to search archived bugs or normal bugs;
113 defaults to false. As a special case, if archive is 'both', but
114 archived and unarchived bugs are returned.
115
116 =item usertags -- set of usertags and the bugs they are applied to
117
118 =back
119
120
121 =head3 Subsidiary routines
122
123 All subsidiary routines get passed exactly the same set of options as
124 get_bugs. If for some reason they are unable to handle the options
125 passed (for example, they don't have the right type of index for the
126 type of selection) they should die as early as possible. [Using
127 Params::Validate and/or die when files don't exist makes this fairly
128 trivial.]
129
130 This function will then immediately move on to the next subroutine,
131 giving it the same arguments.
132
133 =head3 function
134
135 This option allows you to provide an arbitrary function which will be
136 given the information in the index.db file. This will be super, super
137 slow, so only do this if there's no other way to write the search.
138
139 You'll be given a list (which you can turn into a hash) like the
140 following:
141
142  (pkg => ['a','b'], # may be a scalar (most common)
143   bug => 1234,
144   status => 'pending',
145   submitter => 'boo@baz.com',
146   severity => 'serious',
147   tags => ['a','b','c'], # may be an empty arrayref
148  )
149
150 The function should return 1 if the bug should be included; 0 if the
151 bug should not.
152
153 =cut
154
155 sub get_bugs{
156      my %param = validate_with(params => \@_,
157                                spec   => {package   => {type => SCALAR|ARRAYREF,
158                                                         optional => 1,
159                                                        },
160                                           src       => {type => SCALAR|ARRAYREF,
161                                                         optional => 1,
162                                                        },
163                                           maint     => {type => SCALAR|ARRAYREF,
164                                                         optional => 1,
165                                                        },
166                                           submitter => {type => SCALAR|ARRAYREF,
167                                                         optional => 1,
168                                                        },
169                                           severity  => {type => SCALAR|ARRAYREF,
170                                                         optional => 1,
171                                                        },
172                                           status    => {type => SCALAR|ARRAYREF,
173                                                         optional => 1,
174                                                        },
175                                           tag       => {type => SCALAR|ARRAYREF,
176                                                         optional => 1,
177                                                        },
178                                           owner     => {type => SCALAR|ARRAYREF,
179                                                         optional => 1,
180                                                        },
181                                           dist      => {type => SCALAR|ARRAYREF,
182                                                         optional => 1,
183                                                        },
184                                           correspondent => {type => SCALAR|ARRAYREF,
185                                                             optional => 1,
186                                                            },
187                                           affects   => {type => SCALAR|ARRAYREF,
188                                                         optional => 1,
189                                                        },
190                                           function  => {type => CODEREF,
191                                                         optional => 1,
192                                                        },
193                                           bugs      => {type => SCALAR|ARRAYREF,
194                                                         optional => 1,
195                                                        },
196                                           archive   => {type => BOOLEAN|SCALAR,
197                                                         default => 0,
198                                                        },
199                                           usertags  => {type => HASHREF,
200                                                         optional => 1,
201                                                        },
202                                          },
203                               );
204
205      # Normalize options
206      my %options = %param;
207      my @bugs;
208      if ($options{archive} eq 'both') {
209           push @bugs, get_bugs(%options,archive=>0);
210           push @bugs, get_bugs(%options,archive=>1);
211           my %bugs;
212           @bugs{@bugs} = @bugs;
213           return keys %bugs;
214      }
215      # A configuration option will set an array that we'll use here instead.
216      for my $routine (qw(Debbugs::Bugs::get_bugs_by_idx Debbugs::Bugs::get_bugs_flatfile)) {
217           my ($package) = $routine =~ m/^(.+)\:\:/;
218           eval "use $package;";
219           if ($@) {
220                # We output errors here because using an invalid function
221                # in the configuration file isn't something that should
222                # be done.
223                warn "use $package failed with $@";
224                next;
225           }
226           @bugs = eval "${routine}(\%options)";
227           if ($@) {
228
229                # We don't output errors here, because failure here
230                # via die may be a perfectly normal thing.
231                print STDERR "$@" if $DEBUG;
232                next;
233           }
234           last;
235      }
236      # If no one succeeded, die
237      if ($@) {
238           die "$@";
239      }
240      return @bugs;
241 }
242
243 =head2 count_bugs
244
245      count_bugs(function => sub {...})
246
247 Uses a subroutine to classify bugs into categories and return the
248 number of bugs which fall into those categories
249
250 =cut
251
252 sub count_bugs {
253      my %param = validate_with(params => \@_,
254                                spec   => {function => {type => CODEREF,
255                                                       },
256                                           archive  => {type => BOOLEAN,
257                                                        default => 0,
258                                                       },
259                                          },
260                               );
261      my $flatfile;
262      if ($param{archive}) {
263           $flatfile = IO::File->new("$config{spool_dir}/index.archive", 'r')
264                or die "Unable to open $config{spool_dir}/index.archive for reading: $!";
265      }
266      else {
267           $flatfile = IO::File->new("$config{spool_dir}/index.db", 'r')
268                or die "Unable to open $config{spool_dir}/index.db for reading: $!";
269      }
270      my %count = ();
271      while(<$flatfile>) {
272           if (m/^(\S+)\s+(\d+)\s+(\d+)\s+(\S+)\s+\[\s*([^]]*)\s*\]\s+(\w+)\s+(.*)$/) {
273                my @x = $param{function}->(pkg       => $1,
274                                           bug       => $2,
275                                           status    => $4,
276                                           submitter => $5,
277                                           severity  => $6,
278                                           tags      => $7,
279                                          );
280                local $_;
281                $count{$_}++ foreach @x;
282           }
283      }
284      close $flatfile;
285      return %count;
286 }
287
288 =head2 newest_bug
289
290      my $bug = newest_bug();
291
292 Returns the bug number of the newest bug, which is nextnumber-1.
293
294 =cut
295
296 sub newest_bug {
297      my $nn_fh = IO::File->new("$config{spool_dir}/nextnumber",'r')
298           or die "Unable to open $config{spool_dir}nextnumber for reading: $!";
299      local $/;
300      my $next_number = <$nn_fh>;
301      close $nn_fh;
302      chomp $next_number;
303      return $next_number-1;
304 }
305
306 =head2 bug_filter
307
308      bug_filter
309
310 Allows filtering bugs on commonly used criteria
311
312
313
314 =cut
315
316 sub bug_filter {
317      my %param = validate_with(params => \@_,
318                                spec   => {bug    => {type => ARRAYREF|SCALAR,
319                                                      optional => 1,
320                                                     },
321                                           status => {type => HASHREF|ARRAYREF,
322                                                      optional => 1,
323                                                     },
324                                           seen_merged => {type => HASHREF,
325                                                           optional => 1,
326                                                          },
327                                           repeat_merged => {type => BOOLEAN,
328                                                             optional => 1,
329                                                            },
330                                           include => {type => HASHREF,
331                                                       optional => 1,
332                                                      },
333                                           exclude => {type => HASHREF,
334                                                       optional => 1,
335                                                      },
336                                           min_days => {type => SCALAR,
337                                                        optional => 1,
338                                                       },
339                                           max_days => {type => SCALAR,
340                                                        optional => 1,
341                                                       },
342                                          },
343                               );
344      if (exists $param{repeat_merged} and
345          not $param{repeat_merged} and
346          not defined $param{seen_merged}) {
347           croak "repeat_merged false requires seen_merged to be passed";
348      }
349      if (not exists $param{bug} and not exists $param{status}) {
350          croak "one of bug or status must be passed";
351      }
352
353      if (not exists $param{status}) {
354           my $location = getbuglocation($param{bug}, 'summary');
355           return 0 if not defined $location or not length $location;
356           $param{status} = readbug( $param{bug}, $location );
357           return 0 if not defined $param{status};
358      }
359
360      if (exists $param{include}) {
361           return 1 if (!__bug_matches($param{include}, $param{status}));
362      }
363      if (exists $param{exclude}) {
364           return 1 if (__bug_matches($param{exclude}, $param{status}));
365      }
366      if (exists $param{repeat_merged} and not $param{repeat_merged}) {
367           my @merged = sort {$a<=>$b} $param{bug}, split(/ /, $param{status}{mergedwith});
368           return 1 if first {defined $_} @{$param{seen_merged}}{@merged};
369           @{$param{seen_merged}}{@merged} = (1) x @merged;
370      }
371      my $daysold = int((time - $param{status}{date}) / 86400);   # seconds to days
372      if (exists $param{min_days}) {
373           return 1 unless $param{min_days} <= $daysold;
374      }
375      if (exists $param{max_days}) {
376           return 1 unless $param{max_days} == -1 or
377                $param{max_days} >= $daysold;
378      }
379      return 0;
380 }
381
382
383 =head2 get_bugs_by_idx
384
385 This routine uses the by-$index.idx indicies to try to speed up
386 searches.
387
388
389 =cut
390
391 sub get_bugs_by_idx{
392      my %param = validate_with(params => \@_,
393                                spec   => {package   => {type => SCALAR|ARRAYREF,
394                                                         optional => 1,
395                                                        },
396                                           submitter => {type => SCALAR|ARRAYREF,
397                                                         optional => 1,
398                                                        },
399                                           severity  => {type => SCALAR|ARRAYREF,
400                                                         optional => 1,
401                                                        },
402                                           tag       => {type => SCALAR|ARRAYREF,
403                                                         optional => 1,
404                                                        },
405                                           archive   => {type => BOOLEAN,
406                                                         default => 0,
407                                                        },
408                                           owner     => {type => SCALAR|ARRAYREF,
409                                                         optional => 1,
410                                                        },
411                                           src       => {type => SCALAR|ARRAYREF,
412                                                         optional => 1,
413                                                        },
414                                           maint     => {type => SCALAR|ARRAYREF,
415                                                         optional => 1,
416                                                        },
417                                           bugs      => {type => SCALAR|ARRAYREF,
418                                                         optional => 1,
419                                                        },
420                                           correspondent => {type => SCALAR|ARRAYREF,
421                                                             optional => 1,
422                                                            },
423                                           affects => {type => SCALAR|ARRAYREF,
424                                                       optional => 1,
425                                                      },
426                                           usertags  => {type => HASHREF,
427                                                         optional => 1,
428                                                        },
429                                          },
430                               );
431      my %bugs = ();
432
433      # We handle src packages, maint and maintenc by mapping to the
434      # appropriate binary packages, then removing all packages which
435      # don't match all queries
436      my @packages = __handle_pkg_src_and_maint(map {exists $param{$_}?($_,$param{$_}):()}
437                                                qw(package src maint)
438                                               );
439      if (exists $param{package} or
440          exists $param{src} or
441          exists $param{maint}) {
442           delete @param{qw(maint src)};
443           $param{package} = [@packages];
444      }
445      my $keys = grep {$_ !~ /^(archive|usertags|bugs)$/} keys(%param);
446      die "Need at least 1 key to search by" unless $keys;
447      my $arc = $param{archive} ? '-arc':'';
448      my %idx;
449      for my $key (grep {$_ !~ /^(archive|usertags|bugs)$/} keys %param) {
450           my $index = $key;
451           $index = 'submitter-email' if $key eq 'submitter';
452           $index = "$config{spool_dir}/by-${index}${arc}.idx";
453           tie(%idx, MLDBM => $index, O_RDONLY)
454                or die "Unable to open $index: $!";
455           my %bug_matching = ();
456           for my $search (make_list($param{$key})) {
457                for my $bug (keys %{$idx{$search}||{}}) {
458                     next if $bug_matching{$bug};
459                     # increment the number of searches that this bug matched
460                     $bugs{$bug}++;
461                     $bug_matching{$bug}=1;
462                }
463                if ($search ne lc($search)) {
464                     for my $bug (keys %{$idx{lc($search)}||{}}) {
465                          next if $bug_matching{$bug};
466                          # increment the number of searches that this bug matched
467                          $bugs{$bug}++;
468                          $bug_matching{$bug}=1;
469                     }
470                }
471           }
472           if ($key eq 'tag' and exists $param{usertags}) {
473                for my $bug (make_list(grep {defined $_ } @{$param{usertags}}{make_list($param{tag})})) {
474                     next if $bug_matching{$bug};
475                     $bugs{$bug}++;
476                     $bug_matching{$bug}=1;
477                }
478           }
479           untie %idx or die 'Unable to untie %idx';
480      }
481      if ($param{bugs}) {
482           $keys++;
483           for my $bug (make_list($param{bugs})) {
484                $bugs{$bug}++;
485           }
486      }
487      # Throw out results that do not match all of the search specifications
488      return map {$keys <= $bugs{$_}?($_):()} keys %bugs;
489 }
490
491
492 =head2 get_bugs_flatfile
493
494 This is the fallback search routine. It should be able to complete all
495 searches. [Or at least, that's the idea.]
496
497 =cut
498
499 sub get_bugs_flatfile{
500      my %param = validate_with(params => \@_,
501                                spec   => {package   => {type => SCALAR|ARRAYREF,
502                                                         optional => 1,
503                                                        },
504                                           src       => {type => SCALAR|ARRAYREF,
505                                                         optional => 1,
506                                                        },
507                                           maint     => {type => SCALAR|ARRAYREF,
508                                                         optional => 1,
509                                                        },
510                                           submitter => {type => SCALAR|ARRAYREF,
511                                                         optional => 1,
512                                                        },
513                                           severity  => {type => SCALAR|ARRAYREF,
514                                                         optional => 1,
515                                                        },
516                                           status    => {type => SCALAR|ARRAYREF,
517                                                         optional => 1,
518                                                        },
519                                           tag       => {type => SCALAR|ARRAYREF,
520                                                         optional => 1,
521                                                        },
522                                           owner     => {type => SCALAR|ARRAYREF,
523                                                         optional => 1,
524                                                        },
525                                           correspondent => {type => SCALAR|ARRAYREF,
526                                                             optional => 1,
527                                                            },
528                                           affects   => {type => SCALAR|ARRAYREF,
529                                                         optional => 1,
530                                                        },
531 # not yet supported
532 #                                         dist      => {type => SCALAR|ARRAYREF,
533 #                                                       optional => 1,
534 #                                                      },
535                                           archive   => {type => BOOLEAN,
536                                                         default => 1,
537                                                        },
538                                           usertags  => {type => HASHREF,
539                                                         optional => 1,
540                                                        },
541                                           function  => {type => CODEREF,
542                                                         optional => 1,
543                                                        },
544                                          },
545                               );
546      my $flatfile;
547      if ($param{archive}) {
548           $flatfile = IO::File->new("$config{spool_dir}/index.archive", 'r')
549                or die "Unable to open $config{spool_dir}/index.archive for reading: $!";
550      }
551      else {
552           $flatfile = IO::File->new("$config{spool_dir}/index.db", 'r')
553                or die "Unable to open $config{spool_dir}/index.db for reading: $!";
554      }
555      my %usertag_bugs;
556      if (exists $param{tag} and exists $param{usertags}) {
557           # This complex slice makes a hash with the bugs which have the
558           # usertags passed in $param{tag} set.
559           @usertag_bugs{make_list(@{$param{usertags}}{make_list($param{tag})})
560                         } = (1) x make_list(@{$param{usertags}}{make_list($param{tag})});
561      }
562      # We handle src packages, maint and maintenc by mapping to the
563      # appropriate binary packages, then removing all packages which
564      # don't match all queries
565      my @packages = __handle_pkg_src_and_maint(map {exists $param{$_}?($_,$param{$_}):()}
566                                                qw(package src maint)
567                                               );
568      if (exists $param{package} or
569          exists $param{src} or
570          exists $param{maint}) {
571           delete @param{qw(maint src)};
572           $param{package} = [@packages];
573      }
574      my $grep_bugs = 0;
575      my %bugs;
576      if (exists $param{bugs}) {
577           $bugs{$_} = 1 for make_list($param{bugs});
578           $grep_bugs = 1;
579      }
580      if (exists $param{owner} or exists $param{correspondent} or exists $param{affects}) {
581           $bugs{$_} = 1 for get_bugs_by_idx(exists $param{correspondent}?(correspondent => $param{correspondent}):(),
582                                             exists $param{owner}?(owner => $param{owner}):(),
583                                             exists $param{affects}?(affects => $param{affects}):(),
584                                            );
585           $grep_bugs = 1;
586      }
587      my @bugs;
588      while (<$flatfile>) {
589           next unless m/^(\S+)\s+(\d+)\s+(\d+)\s+(\S+)\s+\[\s*([^]]*)\s*\]\s+(\w+)\s+(.*)$/;
590           my ($pkg,$bug,$time,$status,$submitter,$severity,$tags) = ($1,$2,$3,$4,$5,$6,$7);
591           next if $grep_bugs and not exists $bugs{$bug};
592           if (exists $param{package}) {
593                my @packages = splitpackages($pkg);
594                next unless grep { my $pkg_list = $_;
595                                   grep {$pkg_list eq $_} make_list($param{package})
596                              } @packages;
597           }
598           if (exists $param{src}) {
599                my @src_packages = map { getsrcpkgs($_)} make_list($param{src});
600                my @packages = splitpackages($pkg);
601                next unless grep { my $pkg_list = $_;
602                                   grep {$pkg_list eq $_} @packages
603                              } @src_packages;
604           }
605           if (exists $param{submitter}) {
606                my @p_addrs = map {lc($_->address)}
607                     map {getparsedaddrs($_)}
608                          make_list($param{submitter});
609                my @f_addrs = map {$_->address}
610                     getparsedaddrs($submitter||'');
611                next unless grep { my $f_addr = $_; 
612                                   grep {$f_addr eq $_} @p_addrs
613                              } @f_addrs;
614           }
615           next if exists $param{severity} and not grep {$severity eq $_} make_list($param{severity});
616           next if exists $param{status} and not grep {$status eq $_} make_list($param{status});
617           if (exists $param{tag}) {
618                my $bug_ok = 0;
619                # either a normal tag, or a usertag must be set
620                $bug_ok = 1 if exists $param{usertags} and $usertag_bugs{$bug};
621                my @bug_tags = split ' ', $tags;
622                $bug_ok = 1 if grep {my $bug_tag = $_;
623                                     grep {$bug_tag eq $_} make_list($param{tag});
624                                } @bug_tags;
625                next unless $bug_ok;
626           }
627           # We do this last, because a function may be slow...
628           if (exists $param{function}) {
629                my @bug_tags = split ' ', $tags;
630                my @packages = splitpackages($pkg);
631                my $package = (@packages > 1)?\@packages:$packages[0];
632                next unless
633                     $param{function}->(pkg       => $package,
634                                        bug       => $bug,
635                                        status    => $status,
636                                        submitter => $submitter,
637                                        severity  => $severity,
638                                        tags      => \@bug_tags,
639                                       );
640           }
641           push @bugs, $bug;
642      }
643      return @bugs;
644 }
645
646 =head1 PRIVATE FUNCTIONS
647
648 =head2 __handle_pkg_src_and_maint
649
650      my @packages = __handle_pkg_src_and_maint(map {exists $param{$_}?($_,$param{$_}):()}
651                                                qw(package src maint)
652                                               );
653
654 Turn package/src/maint into a list of packages
655
656 =cut
657
658 sub __handle_pkg_src_and_maint{
659      my %param = validate_with(params => \@_,
660                                spec   => {package   => {type => SCALAR|ARRAYREF,
661                                                         optional => 1,
662                                                        },
663                                           src       => {type => SCALAR|ARRAYREF,
664                                                         optional => 1,
665                                                        },
666                                           maint     => {type => SCALAR|ARRAYREF,
667                                                         optional => 1,
668                                                        },
669                                          },
670                                allow_extra => 1,
671                               );
672
673      my @packages;
674      @packages = make_list($param{package}) if exists $param{package};
675      my $package_keys = @packages?1:0;
676      my %packages;
677      @packages{@packages} = (1) x @packages;
678      if (exists $param{src}) {
679           # We only want to increment the number of keys if there is
680           # something to match
681           my $key_inc = 0;
682           for my $package ((map { getsrcpkgs($_)} make_list($param{src})),make_list($param{src})) {
683                $packages{$package}++;
684                $key_inc=1;
685           }
686           $package_keys += $key_inc;
687      }
688      if (exists $param{maint}) {
689           my $key_inc = 0;
690           my $maint_rev = getmaintainers_reverse();
691           for my $package (map { exists $maint_rev->{$_}?@{$maint_rev->{$_}}:()}
692                            make_list($param{maint})) {
693                $packages{$package}++;
694                $key_inc = 1;
695           }
696           $package_keys += $key_inc;
697      }
698      return grep {$packages{$_} >= $package_keys} keys %packages;
699 }
700
701 my %field_match = (
702     'subject' => \&__contains_field_match,
703     'tags' => sub {
704         my ($field, $values, $status) = @_; 
705         my %values = map {$_=>1} @$values;
706         foreach my $t (split /\s+/, $status->{$field}) {
707             return 1 if (defined $values{$t});
708         }
709         return 0;
710     },
711     'severity' => \&__exact_field_match,
712     'pending' => \&__exact_field_match,
713     'package' => \&__exact_field_match,
714     'originator' => \&__contains_field_match,
715     'forwarded' => \&__contains_field_match,
716     'owner' => \&__contains_field_match,
717 );
718
719 sub __bug_matches {
720     my ($hash, $status) = @_;
721     foreach my $key( keys( %$hash ) ) {
722         my $value = $hash->{$key};
723         my $sub = $field_match{$key};
724         return 1 if ($sub->($key, $value, $status));
725     }
726     return 0;
727 }
728
729 sub __exact_field_match {
730     my ($field, $values, $status) = @_; 
731     my @values = @$values;
732     my @ret = grep {$_ eq $status->{$field} } @values;
733     $#ret != -1;
734 }
735
736 sub __contains_field_match {
737     my ($field, $values, $status) = @_; 
738     foreach my $data (@$values) {
739         return 1 if (index($status->{$field}, $data) > -1);
740     }
741     return 0;
742 }
743
744
745
746
747
748 1;
749
750 __END__