scripts/errorlib.in

   1 # -*- perl -*-
   2
   3 use Mail::Address;
   4 use Debbugs::MIME qw(decode_rfc1522 encode_rfc1522);
   5 use Debbugs::Packages qw(:all);
   6 use Debbugs::Common qw(:all);
   7 use Debbugs::Status qw(:all);
   8 use Carp;
   9
  10 sub unlockreadbugmerge {
  11     local ($rv) = @_;
  12     &unfilelock if $rv >= 2;
  13     &unfilelock if $rv >= 1;
  14 }
  15
  16 sub lockreadbugmerge {
  17     local ($lref, $location) = @_;
  18     local $data;
  19     if (!($data = &lockreadbug($lref, $location))) { return ( 0, undef ); }
  20     if (!length($data->{mergedwith})) { return ( 1, $data ); }
  21     &unfilelock;
  22     &filelock('lock/merge');
  23     if (!&lockreadbug($lref, $location)) { &unfilelock; return ( 0, undef ); }
  24     return ( 2, $data );
  25 }
  26
  27 %saniarray= ('<','lt', '>','gt', '&','amp', '"','quot');
  28
  29 sub sani {
  30     my ($in) = @_;
  31     carp "You should be using HTML::Entities instead.";
  32     $in =~ s/([<>&"])/$saniarray{$1}/g;
  33     return $in;
  34 }
  35
  36 sub getmailbody {
  37         my $entity = shift;
  38         my $type = $entity->effective_type;
  39         if ($type =~ m#text/(?!html|enriched)# or
  40             $type eq 'application/pgp') {
  41                 return $entity->bodyhandle;
  42         } elsif ($type eq 'multipart/alternative') {
  43                 # RFC 2046 says we should use the last part we recognize.
  44                 for my $part (reverse $entity->parts) {
  45                         my $ret = getmailbody($part);
  46                         return $ret if $ret;
  47                 }
  48         } else {
  49                 # For other multipart types, we just pretend they're
  50                 # multipart/mixed and run through in order.
  51                 for my $part ($entity->parts) {
  52                         my $ret = getmailbody($part);
  53                         return $ret if $ret;
  54                 }
  55         }
  56         return undef;
  57 }
  58
  59 sub get_addresses {
  60         return
  61             map { $_->address() }
  62             map { Mail::Address->parse($_) } @_;
  63 }
  64
  65 sub escapelog {
  66         my @log = @_;
  67         map { s/^([\01-\07\030])/\030$1/gm } @log;
  68         return \@log;
  69 }
  70
  71 @severities= grep { not exists $gObsoleteSeverities{$_} } @gSeverityList;
  72 @showseverities= @severities;
  73 grep ($_= $_ eq '' ? $gDefaultSeverity : $_, @showseverities);
  74 %displayshowseverities= %gSeverityDisplay;
  75
  76 # compatibility
  77 if (defined $gFowardList and not defined $gForwardList) {
  78     $gForwardList = $gFowardList;
  79 }
  80
  81 1;