perl 邮件解析及数据库操作

root

#!/usr/bin/perl
# file: readmail01.pl
# Figure 7.4: An readmail program


#-------------------------------------Sub decode_mimewords---------------------------------
sub decode_mimewords {
   my $encstr = shift;#省略@_,完整shift @_; #此处@_是所有传入参数组成的list
   my %params = @_;#hash
   my @tokens;#list
   $@ = '';         # error-return

   # Collapse boundaries between adjacent encoded words:
   $encstr =~ s{(\?\=)[\r\n \t]*(\=\?)}{$1$2}gs;#把$encstr 替换s///第一个（）为$1第二个为$2
   pos($encstr) = 0;#返回最后一次模式匹配的位置
   ### print STDOUT "ENC = [", $encstr, "]\n";

   # Decode:
   my ($charset, $encoding, $enc, $dec);
   while (1) {
      last if (pos($encstr) >= length($encstr));#Perl提供了last、next和redo这几个语句来控制代码块内的执行流程。last语句退出代码块； next语句终止当前指令然后开始下一循环；而redo语句则重新开始循环代码块却并不重新计算条件语句
      my $pos = pos($encstr);            # save it

      # Case 1: are we looking at "=?..?..?="?
      if ($encstr =~   m{\G            # from where we left off..
                     =\?([^?]*)      # "=?" + charset +
                      \?([bq])       #  "?" + encoding +
                      \?([^?]+)      #  "?" + data maybe with spcs +
                      \?=           #  "?="
                     }xgi) {
         ($charset, $encoding, $enc) = ($1, lc($2), $3);
         $dec = (($encoding eq 'q') ? _decode_Q($enc) : decode_base64($enc));
         push @tokens, [$dec, $charset];#在数组末尾增加一个或多个元素。等价于slice (@array, @array, 0, elements);
         next;
      }

      # Case 2: are we looking at a bad "=?..." prefix?
      # We need this to detect problems for case 3, which stops at "=?":
      pos($encstr) = $pos;            # reset the pointer.
      if ($encstr =~ m{\G=\?}xg) {
         $@ .= qq|unterminated "=?..?..?=" in "$encstr" (pos $pos)\n|;
         push @tokens, ['=?'];
         next;
      }

      # Case 3: are we looking at ordinary text?
      pos($encstr) = $pos;            # reset the pointer.
      if ($encstr =~ m{\G            # from where we left off...
                   ([\x00-\xFF]*?   #   shortest possible string,
                    \n*)          #   followed by 0 or more NLs,
                   (?=(\Z|=\?))     # terminated by "=?" or EOS
                  }xg) {
         length($1) or die "MIME::Words: internal logic err: empty token\n";
         push @tokens, [$1];
         next;
      }

      # Case 4: bug!
      die "MIME::Words: unexpected case:\n($encstr) pos $pos\n\t".
         "Please alert developer.\n";
   }
   return (wantarray ? @tokens : join('',map {$_->[0]} @tokens));
}