Convert-BulkDecoder

 view release on metacpan or  search on metacpan

lib/Convert/BulkDecoder.pm  view on Meta::CPAN

	if ( m;^content-type:.*(image/|multipart);i ) {
	    return 'M';		# MIME
	}

	if ( m/^=ybegin\s+.*\s+name=(.+)/i ) {
	    return "Y$1";	# yEnc
	}

	# Otherwise, search for the uudecode 'begin' line.
	if ( /^begin\s+\d+\s+(.+)$/ ) {
	    $name = $self->{neat}->($1);
	    $self->{type} = "U";
	    $self->{name} = $name;
	    $self->{file} = $self->{destdir} . $name;
	    $doing = 2;		# Done
	    warn("Decoding(UU) to ", $self->{file}, "\n")
	      if $self->{verbose};
	    # Skip duplicates.
	    # Note that testing for -s fails if it is a
	    # notexisting symlink.
	    if ( (-l $self->{file} || -s _ ) && !$self->{force} ) {
		$self->{size} = -s _;
		$self->{result} = "DUP";
		last;
	    }

	    open (OUT, ">".$self->{file})
	      or die("create(".$self->{file}."): $!\n");
	    binmode(OUT);
	    $doing = 1;		# Doing
	    $self->{result} = "FAIL";
	    next;
	}
    }
    push(@{$self->{parts}},
	 { type   => $self->{type},
	   size   => $self->{size},
	   md5    => $self->{md5},
	   result => $self->{result},
	   name   => $self->{name},
	   file   => $self->{file} });
    return $self->{result};
}

my @crctab;

sub ydecode {
    my ($self, $a) = @_;
    $self->{type} = "Y";
    $self->{result} = "EMPTY";

    _fill_crctab() unless @crctab || !$self->{crc};

    my @lines = @$a;

    my ($ydec_part, $ydec_line, $ydec_size, $ydec_name, $ydec_pcrc,
	$ydec_begin, $ydec_end);
    my $pcrc;

    while ( $_ = shift(@lines) ) {
	# Newlines a fakes and should not be decoded.
	chomp;
	s/\r//g;
	# If we've started decoding $ydec_name will be set.
	if ( !$ydec_name  ) {
	    # Skip until beginning of yDecoded part.
	    next unless /^=ybegin/;
	    if ( / part=(\d+)/ ) {
		$ydec_part = $1;
	    }

	    if ( / size=(\d+)/ ) {
		$self->{size} = $ydec_size = $1;
	    }
	    else {
		die("Mandatory field 'size' missing\n");
	    }
	    if ( / line=(\d+)/ ) {
		$ydec_line = $1;
	    }
	    if( / name=(.*)$/ ) {
		$ydec_name = $self->{neat}->($1);
		$self->{file} = $self->{destdir} . $ydec_name;
		$self->{name} = $ydec_name;
		if ( !defined($ydec_part) || $ydec_part == 1 ) {
		    warn("Decoding(yEnc) to ", $self->{file}, "\n")
		      if $self->{verbose};
		    if ( -s $self->{file} ) {
			if ( $self->{force} ) {
			    unlink($self->{file});
			}
			else {
			    $self->{size} = -s _;
			    $self->{result} = "DUP";
			    last;
			}
		    }
		}
	    }
	    else {
		die("Unknown attach name\n");
	    }

	    # Multipart messages contain more information on.
	    # the second line.
	    if ( $ydec_part ) {
		$_ = shift(@lines);
		chomp;
		s/\r//g;
		if ( /^=ypart/ ) {
		    if ( / begin=(\d+)/ ) {
			# We need this to check if the size of this message
			# is correct.
			$ydec_begin = $1;
			$pcrc = 0xffffffff;
			undef $ydec_pcrc;
		    }
		    else {
			warn("No begin field found in part, ignoring\n");
			undef $ydec_part;
		    }
		    if ( / end=(\d+)/ ) {
			# We need this to calculate the size of this message.
			$ydec_end = $1;
		    }
		    else {
			warn("No end field found in part, ignoring");
			undef $ydec_part;
		    }
		}
		else {
		    warn("Article described as multipart message, however ".
			 "it doesn't seem that way\n");
		    undef $ydec_part;
		}
	    }
	    else {
		$pcrc = 0xffffffff;
	    }

	    # If the $ydec_part is different from 1
	    # we need to open the file for appending.
	    if ( -e $self->{file} ) {
		if ( defined($ydec_part) && $ydec_part != 1 ) {
		    # If we have a multipart message, the file exists
		    # and we are not at the first part, we should just
		    # open the file as an append. We assume that this is
		    # the multipart we were already processing.
		    #print "Opening $ydec_name for appending\n";
		    if ( !open(OUT, ">>".$self->{file}) ) {
			die("Couldn't open ".$self->{file}.
			    " for appending: $!\n");
		    }
		}
		elsif ( !open(OUT, ">".$self->{file}) ) {
		    die("Couldn't create ".$self->{file}.": $!\n");
		}
	    }
	    else {
		# File doesn't exist. We open it for writing O' so plain.
		if ( defined($ydec_part) && $ydec_part != 1 ) {
		    die("Missing  ".$self->{file}. " for appending: $!\n");
		}
		if ( !open(OUT, ">".$self->{file}) ) {
		    die("Couldn't create ".$self->{file}.": $!\n");
		}
		$self->{result} = "FAIL";
	    }
	    # Cancel any file translations.
	    binmode(OUT);
	    # Excellent.. We have determed all the info for this file we
	    # need.. Skip till next line, this should contain the real
	    # data.
	    next;
	}

	# Looking for the end tag.
	if ( /^=yend/ ) {
	    # We are done.. Check the sanity of article.
	    # and unset $ydec_name in case that there are more
	    # ydecoded files in the same article.
	    $self->{result} = "OK";
	    if ( / part=(\d+)/ ) {
		if ( $ydec_part != $1 ) {
		    die("Part number '$1' different from beginning part '$ydec_part'\n");
		}
	    }
	    if ( / size=(\d+)/ ) {
		# Check size, but first calculate it.
		my $size;
		if ( defined($ydec_part) ) {
		    $size = ($ydec_end - $ydec_begin + 1);
		}
		else {
		    $size = $ydec_size;
		}
		if ( $1 != $size ) {
		    die("Size '$1' different from beginning size '$size'\n");
		}
	    }
	    if ( / pcrc32=([0-9a-f]+)/i && @crctab ) {
		if ( defined($ydec_pcrc) && ($ydec_pcrc != $1) ) {
		    die("CRC '$1' different from beginning CRC '$ydec_pcrc'\n");
		}
		$ydec_pcrc = hex($1);
		$pcrc = $pcrc ^ 0xffffffff;
		if ( $pcrc == $ydec_pcrc ) {
		    warn("Part $ydec_part, checksum OK\n")
		      if $self->{verbose};
		}
		else {
		    warn(sprintf("Part $ydec_part, checksum mismatch, ".
				 "got 0x%08x, expected 0x%08x\n",
				 $pcrc, $ydec_pcrc));
		}

	    }
	    if ( !defined($ydec_part) && / crc32=([0-9a-f]+)/i && @crctab ) {
		$ydec_pcrc = hex($1);
		$pcrc = $pcrc ^ 0xffffffff;
		if ( $pcrc == $ydec_pcrc ) {
		    warn("Checksum OK\n")
		      if $self->{verbose};
		}
		else {
		    warn(sprintf("Checksum mismatch, ".
				 "got 0x%08x, expected 0x%08x\n",
				 $pcrc, $ydec_pcrc));
		}

	    }
	    undef $ydec_name;
	    # Dont encode the endline, we skip to the next line
	    # in search for any more parts.
	    next;
	}

	# If we got here, we are within an encoded article, an
	# we will take meassures to decode it.
	# We decode line by line.



( run in 1.118 second using v1.01-cache-2.11-cpan-d7f47b0818f )