home *** CD-ROM | disk | FTP | other *** search
/ PC Professionell 2004 December / PCpro_2004_12.ISO / files / webserver / xampp / xampp-perl-addon-1.4.9-installer.exe / UU.pm < prev    next >
Encoding:
Perl POD Document  |  2002-06-14  |  3.2 KB  |  152 lines
  1. package MIME::Decoder::UU;
  2.  
  3.  
  4. =head1 NAME
  5.  
  6. MIME::Decoder::UU - decode a "uuencoded" stream
  7.  
  8.  
  9. =head1 SYNOPSIS
  10.  
  11. A generic decoder object; see L<MIME::Decoder> for usage.
  12.  
  13. Also supports a preamble() method to recover text before
  14. the uuencoded portion of the stream.
  15.  
  16.  
  17. =head1 DESCRIPTION
  18.  
  19. A MIME::Decoder subclass for a nonstandard encoding whereby
  20. data are uuencoded.  Common non-standard MIME encodings for this:
  21.  
  22.     x-uu
  23.     x-uuencode
  24.  
  25.  
  26. =head1 AUTHOR
  27.  
  28. Eryq (F<eryq@zeegee.com>), ZeeGee Software Inc (F<http://www.zeegee.com>).
  29.  
  30. UU-decoding code lifted from "uuexplode", a Perl script by an
  31. unknown author...
  32.  
  33. All rights reserved.  This program is free software; you can redistribute
  34. it and/or modify it under the same terms as Perl itself.
  35.  
  36.  
  37. =head1 VERSION
  38.  
  39. $Revision: 5.403 $ $Date: 2000/11/04 19:54:49 $
  40.  
  41. =cut
  42.  
  43.  
  44. require 5.002;
  45. use vars qw(@ISA $VERSION);
  46. use MIME::Decoder;
  47. use MIME::Tools qw(whine);
  48.  
  49. @ISA = qw(MIME::Decoder);
  50.  
  51. # The package version, both in 1.23 style *and* usable by MakeMaker:
  52. $VERSION = substr q$Revision: 5.403 $, 10;
  53.  
  54.  
  55. #------------------------------
  56. #
  57. # decode_it IN, OUT
  58. #
  59. sub decode_it {
  60.     my ($self, $in, $out) = @_;
  61.     my ($mode, $file);
  62.     my @preamble;
  63.     local $_;
  64.  
  65.     ### Init:
  66.     $self->{MDU_Preamble} = \@preamble;
  67.     $self->{MDU_Mode} = undef;
  68.     $self->{MDU_File} = undef;
  69.  
  70.     ### Find beginning...
  71.     while (defined($_ = $in->getline)) {
  72.     if (/^begin(.*)/) {        ### found it: now decode it...
  73.         my $modefile = $1;
  74.         if ($modefile =~ /^(\s+(\d+))?(\s+(.*?\S))?\s*\Z/) {
  75.         ($mode, $file) = ($2, $4);
  76.         }
  77.         last;                  ### decoded or not, we're done
  78.     }
  79.     push @preamble, $_;
  80.     }
  81.     die("uu decoding: no begin found\n") if !defined($_);      # hit eof!
  82.  
  83.     ### Store info:
  84.     $self->{MDU_Mode} = $mode;
  85.     $self->{MDU_File} = $file;
  86.  
  87.     ### Decode:
  88.     while (defined($_ = $in->getline)) {
  89.     last if /^end/;
  90.     next if /[a-z]/;
  91.     next unless int((((ord() - 32) & 077) + 2) / 3) == int(length() / 4);
  92.     $out->print(unpack('u', $_));
  93.     }
  94.     ### chmod oct($mode), $file;    # sheeyeah... right...
  95.     whine "file incomplete, no end found\n" if !defined($_); # eof
  96.     1;
  97. }
  98.  
  99. #------------------------------
  100. #
  101. # encode_it IN, OUT
  102. #
  103. sub encode_it {
  104.     my ($self, $in, $out) = @_;
  105.     my $buf = '';
  106.  
  107.     my $fname = (($self->head && 
  108.           $self->head->mime_attr('content-disposition.filename')) ||
  109.          '');
  110.     $out->print("begin 644 $fname\n");
  111.     while ($in->read($buf, 45)) { $out->print(pack('u', $buf)) }
  112.     $out->print("end\n");
  113.     1;
  114. }
  115.  
  116. #------------------------------
  117. #
  118. # last_preamble
  119. #
  120. # Return the last preamble as ref to array of lines.
  121. # Gets reset by decode_it().
  122. #
  123. sub last_preamble {
  124.     my $self = shift;
  125.     return $self->{MDU_Preamble} || [];
  126. }
  127.  
  128. #------------------------------
  129. #
  130. # last_mode
  131. #
  132. # Return the last mode.
  133. # Gets reset to undef by decode_it().
  134. #
  135. sub last_mode {
  136.     shift->{MDU_Mode};
  137. }
  138.  
  139. #------------------------------
  140. #
  141. # last_filename
  142. #
  143. # Return the last filename.
  144. # Gets reset by decode_it().
  145. #
  146. sub last_filename {
  147.     shift->{MDU_File} || [];
  148. }
  149.  
  150. #------------------------------
  151. 1;
  152.