/usr/share/perl5/vendor_perl/MIME/Decoder/UU.pm

https://gitlab.com/kinwei/IFE-task7 · Perl · 150 lines · 81 code · 33 blank · 36 comment · 16 complexity · 25aeec63dbac68702e91f78b8b08b1c1 MD5 · raw file

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