[p5sagit/p5-mst-13.2.git] / ext / MIME / Base64 / Base64.xs

/* $Id: Base64.xs,v 3.2 2004/03/29 11:35:13 gisle Exp $

Copyright 1997-2004 Gisle Aas

This library is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.


The tables and some of the code that used to be here was borrowed from
metamail, which comes with this message:

  Copyright (c) 1991 Bell Communications Research, Inc. (Bellcore)

  Permission to use, copy, modify, and distribute this material
  for any purpose and without fee is hereby granted, provided
  that the above copyright notice and this permission notice
  appear in all copies, and that the name of Bellcore not be
  used in advertising or publicity pertaining to this
  material without the specific, prior written permission
  of an authorized representative of Bellcore.	BELLCORE
  MAKES NO REPRESENTATIONS ABOUT THE ACCURACY OR SUITABILITY
  OF THIS MATERIAL FOR ANY PURPOSE.  IT IS PROVIDED "AS IS",
  WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES.

*/


#ifdef __cplusplus
extern "C" {
#endif
#define PERL_NO_GET_CONTEXT     /* we want efficiency */
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
#ifdef __cplusplus
}
#endif

#ifndef PATCHLEVEL
#    include <patchlevel.h>
#    if !(defined(PERL_VERSION) || (SUBVERSION > 0 && defined(PATCHLEVEL)))
#        include <could_not_find_Perl_patchlevel.h>
#    endif
#endif

#if PATCHLEVEL <= 4 && !defined(PL_dowarn)
   #define PL_dowarn dowarn
#endif

#ifdef G_WARN_ON
   #define DOWARN (PL_dowarn & G_WARN_ON)
#else
   #define DOWARN PL_dowarn
#endif


#define MAX_LINE  76 /* size of encoded lines */

static char basis_64[] =
   "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/";

#define XX      255	/* illegal base64 char */
#define EQ      254	/* padding */
#define INVALID XX

static unsigned char index_64[256] = {
    XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX,
    XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX,
    XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,62, XX,XX,XX,63,
    52,53,54,55, 56,57,58,59, 60,61,XX,XX, XX,EQ,XX,XX,
    XX, 0, 1, 2,  3, 4, 5, 6,  7, 8, 9,10, 11,12,13,14,
    15,16,17,18, 19,20,21,22, 23,24,25,XX, XX,XX,XX,XX,
    XX,26,27,28, 29,30,31,32, 33,34,35,36, 37,38,39,40,
    41,42,43,44, 45,46,47,48, 49,50,51,XX, XX,XX,XX,XX,

    XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX,
    XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX,
    XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX,
    XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX,
    XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX,
    XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX,
    XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX,
    XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX,
};

#ifdef SvPVbyte
#   if PERL_REVISION == 5 && PERL_VERSION < 7
       /* SvPVbyte does not work in perl-5.6.1, borrowed version for 5.7.3 */
#       undef SvPVbyte
#       define SvPVbyte(sv, lp) \
          ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8)) == (SVf_POK) \
           ? ((lp = SvCUR(sv)), SvPVX(sv)) : my_sv_2pvbyte(aTHX_ sv, &lp))
       static char *
       my_sv_2pvbyte(pTHX_ register SV *sv, STRLEN *lp)
       {   
           sv_utf8_downgrade(sv,0);
           return SvPV(sv,*lp);
       }
#   endif
#else
#   define SvPVbyte SvPV
#endif

#ifndef isXDIGIT
#   define isXDIGIT isxdigit
#endif

#ifndef NATIVE_TO_ASCII
#   define NATIVE_TO_ASCII(ch) (ch)
#endif

MODULE = MIME::Base64		PACKAGE = MIME::Base64

SV*
encode_base64(sv,...)
	SV* sv
	PROTOTYPE: $;$

	PREINIT:
	char *str;     /* string to encode */
	SSize_t len;   /* length of the string */
	char *eol;     /* the end-of-line sequence to use */
	STRLEN eollen; /* length of the EOL sequence */
	char *r;       /* result string */
	STRLEN rlen;   /* length of result string */
	unsigned char c1, c2, c3;
	int chunk;

	CODE:
#if PERL_REVISION == 5 && PERL_VERSION >= 6
	sv_utf8_downgrade(sv, FALSE);
#endif
	str = SvPV(sv, rlen); /* SvPV(sv, len) gives warning for signed len */
	len = (SSize_t)rlen;

	/* set up EOL from the second argument if present, default to "\n" */
	if (items > 1 && SvOK(ST(1))) {
	    eol = SvPV(ST(1), eollen);
	} else {
	    eol = "\n";
	    eollen = 1;
	}

	/* calculate the length of the result */
	rlen = (len+2) / 3 * 4;	 /* encoded bytes */
	if (rlen) {
	    /* add space for EOL */
	    rlen += ((rlen-1) / MAX_LINE + 1) * eollen;
	}

	/* allocate a result buffer */
	RETVAL = newSV(rlen ? rlen : 1);
	SvPOK_on(RETVAL);	
	SvCUR_set(RETVAL, rlen);
	r = SvPVX(RETVAL);

	/* encode */
	for (chunk=0; len > 0; len -= 3, chunk++) {
	    if (chunk == (MAX_LINE/4)) {
		char *c = eol;
		char *e = eol + eollen;
		while (c < e)
		    *r++ = *c++;
		chunk = 0;
	    }
	    c1 = *str++;
	    c2 = len > 1 ? *str++ : '\0';
	    *r++ = basis_64[c1>>2];
	    *r++ = basis_64[((c1 & 0x3)<< 4) | ((c2 & 0xF0) >> 4)];
	    if (len > 2) {
		c3 = *str++;
		*r++ = basis_64[((c2 & 0xF) << 2) | ((c3 & 0xC0) >>6)];
		*r++ = basis_64[c3 & 0x3F];
	    } else if (len == 2) {
		*r++ = basis_64[(c2 & 0xF) << 2];
		*r++ = '=';
	    } else { /* len == 1 */
		*r++ = '=';
		*r++ = '=';
	    }
	}
	if (rlen) {
	    /* append eol to the result string */
	    char *c = eol;
	    char *e = eol + eollen;
	    while (c < e)
		*r++ = *c++;
	}
	*r = '\0';  /* every SV in perl should be NUL-terminated */

	OUTPUT:
	RETVAL

SV*
decode_base64(sv)
	SV* sv
	PROTOTYPE: $

	PREINIT:
	STRLEN len;
	register unsigned char *str = (unsigned char*)SvPVbyte(sv, len);
	unsigned char const* end = str + len;
	char *r;
	unsigned char c[4];

	CODE:
	{
	    /* always enough, but might be too much */
	    STRLEN rlen = len * 3 / 4;
	    RETVAL = newSV(rlen ? rlen : 1);
	}
        SvPOK_on(RETVAL);
        r = SvPVX(RETVAL);

	while (str < end) {
	    int i = 0;
            do {
		unsigned char uc = index_64[NATIVE_TO_ASCII(*str++)];
		if (uc != INVALID)
		    c[i++] = uc;

		if (str == end) {
		    if (i < 4) {
			if (i && DOWARN)
			    warn("Premature end of base64 data");
			if (i < 2) goto thats_it;
			if (i == 2) c[2] = EQ;
			c[3] = EQ;
		    }
		    break;
		}
            } while (i < 4);
	
	    if (c[0] == EQ || c[1] == EQ) {
		if (DOWARN) warn("Premature padding of base64 data");
		break;
            }
	    /* printf("c0=%d,c1=%d,c2=%d,c3=%d\n", c[0],c[1],c[2],c[3]);*/

	    *r++ = (c[0] << 2) | ((c[1] & 0x30) >> 4);

	    if (c[2] == EQ)
		break;
	    *r++ = ((c[1] & 0x0F) << 4) | ((c[2] & 0x3C) >> 2);

	    if (c[3] == EQ)
		break;
	    *r++ = ((c[2] & 0x03) << 6) | c[3];
	}

      thats_it:
	SvCUR_set(RETVAL, r - SvPVX(RETVAL));
	*r = '\0';

	OUTPUT:
	RETVAL


MODULE = MIME::Base64		PACKAGE = MIME::QuotedPrint

#define qp_isplain(c) ((c) == '\t' || (((c) >= ' ' && (c) <= '~') && (c) != '='))

SV*
encode_qp(sv,...)
	SV* sv
	PROTOTYPE: $;$

	PREINIT:
	char *eol;
	STRLEN eol_len;
	STRLEN sv_len;
	STRLEN linelen;
	char *beg;
	char *end;
	char *p;
	char *p_beg;
	STRLEN p_len;

	CODE:
#if PERL_REVISION == 5 && PERL_VERSION >= 6
	sv_utf8_downgrade(sv, FALSE);
#endif
	/* set up EOL from the second argument if present, default to "\n" */
	if (items > 1 && SvOK(ST(1))) {
	    eol = SvPV(ST(1), eol_len);
	} else {
	    eol = "\n";
	    eol_len = 1;
	}

	beg = SvPV(sv, sv_len);
	end = beg + sv_len;

	RETVAL = newSV(sv_len + 1);
	sv_setpv(RETVAL, "");
	linelen = 0;

	p = beg;
	while (1) {
	    p_beg = p;

	    /* skip past as much plain text as possible */
	    while (p < end && qp_isplain(*p)) {
	        p++;
	    }
	    if (p == end || *p == '\n') {
		/* whitespace at end of line must be encoded */
		while (p > p_beg && (*(p - 1) == '\t' || *(p - 1) == ' '))
		    p--;
	    }

	    p_len = p - p_beg;
	    if (p_len) {
	        /* output plain text (with line breaks) */
	        if (eol_len) {
		    STRLEN max_last_line = (p == end || *p == '\n')
					      ? MAX_LINE         /* .......\n */
					      : ((p + 1) == end || *(p + 1) == '\n')
	                                        ? MAX_LINE - 3   /* ....=XX\n */
	                                        : MAX_LINE - 4;  /* ...=XX=\n */
		    while (p_len + linelen > max_last_line) {
			STRLEN len = MAX_LINE - 1 - linelen;
			if (len > p_len)
			    len = p_len;
			sv_catpvn(RETVAL, p_beg, len);
			p_beg += len;
			p_len -= len;
			sv_catpvn(RETVAL, "=", 1);
			sv_catpvn(RETVAL, eol, eol_len);
		        linelen = 0;
		    }
                }
		if (p_len) {
	            sv_catpvn(RETVAL, p_beg, p_len);
	            linelen += p_len;
		}
	    }

	    if (p == end) {
		break;
            }
	    else if (*p == '\n' && eol_len) {
	        sv_catpvn(RETVAL, eol, eol_len);
	        p++;
		linelen = 0;
	    }
	    else {
		/* output escaped char (with line breaks) */
	        assert(p < end);
		if (eol_len && linelen > MAX_LINE - 4) {
		    sv_catpvn(RETVAL, "=", 1);
		    sv_catpvn(RETVAL, eol, eol_len);
		    linelen = 0;
		}
	        sv_catpvf(RETVAL, "=%02X", (unsigned char)*p);
	        p++;
	        linelen += 3;
	    }

	    /* optimize reallocs a bit */
	    if (SvLEN(RETVAL) > 80 && SvLEN(RETVAL) - SvCUR(RETVAL) < 3) {
		STRLEN expected_len = (SvCUR(RETVAL) * sv_len) / (p - beg);
     		SvGROW(RETVAL, expected_len);
	    }
        }

	OUTPUT:
	RETVAL

SV*
decode_qp(sv)
	SV* sv
	PROTOTYPE: $

        PREINIT:
	STRLEN len;
	char *str = SvPVbyte(sv, len);
	char const* end = str + len;
	char *r;
	char *whitespace = 0;

        CODE:
	RETVAL = newSV(len ? len : 1);
        SvPOK_on(RETVAL);
        r = SvPVX(RETVAL);
	while (str < end) {
	    if (*str == ' ' || *str == '\t') {
		if (!whitespace)
		    whitespace = str;
		str++;
	    }
	    else if (*str == '\r' && (str + 1) < end && str[1] == '\n') {
		str++;
	    }
	    else if (*str == '\n') {
		whitespace = 0;
		*r++ = *str++;
	    }
	    else {
		if (whitespace) {
		    while (whitespace < str) {
			*r++ = *whitespace++;
		    }
		    whitespace = 0;
                }
            	if (*str == '=') {
		    if ((str + 2) < end && isXDIGIT(str[1]) && isXDIGIT(str[2])) {
	                char buf[3];
                        str++;
	                buf[0] = *str++;
		        buf[1] = *str++;
	                buf[2] = '\0';
		        *r++ = (char)strtol(buf, 0, 16);
	            }
		    else {
		        /* look for soft line break */
		        char *p = str + 1;
		        while (p < end && (*p == ' ' || *p == '\t'))
		            p++;
		        if (p < end && *p == '\n')
		     	    str = p + 1;
		        else if ((p + 1) < end && *p == '\r' && *(p + 1) == '\n')
		            str = p + 2;
		        else
		            *r++ = *str++; /* give up */
		    }
		}
		else {
		    *r++ = *str++;
		}
	    }
	}
	if (whitespace) {
	    while (whitespace < str) {
		*r++ = *whitespace++;
	    }
        }
	*r = '\0';
	SvCUR_set(RETVAL, r - SvPVX(RETVAL));

        OUTPUT:
	RETVAL


MODULE = MIME::Base64		PACKAGE = MIME::Base64
Commit	Line	Data
51ebc328	1	/* $Id: Base64.xs,v 3.2 2004/03/29 11:35:13 gisle Exp $
6fba102d	2
691d66bd	3	Copyright 1997-2004 Gisle Aas
6fba102d	4
	5	This library is free software; you can redistribute it and/or
	6	modify it under the same terms as Perl itself.
	7
	8
	9	The tables and some of the code that used to be here was borrowed from
	10	metamail, which comes with this message:
	11
	12	Copyright (c) 1991 Bell Communications Research, Inc. (Bellcore)
	13
7d85a32c	14	Permission to use, copy, modify, and distribute this material
	15	for any purpose and without fee is hereby granted, provided
	16	that the above copyright notice and this permission notice
	17	appear in all copies, and that the name of Bellcore not be
	18	used in advertising or publicity pertaining to this
	19	material without the specific, prior written permission
	20	of an authorized representative of Bellcore. BELLCORE
	21	MAKES NO REPRESENTATIONS ABOUT THE ACCURACY OR SUITABILITY
	22	OF THIS MATERIAL FOR ANY PURPOSE. IT IS PROVIDED "AS IS",
6fba102d	23	WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES.
	24
	25	*/
	26
	27
	28	#ifdef __cplusplus
	29	extern "C" {
	30	#endif
51ebc328	31	#define PERL_NO_GET_CONTEXT /* we want efficiency */
6fba102d	32	#include "EXTERN.h"
	33	#include "perl.h"
	34	#include "XSUB.h"
	35	#ifdef __cplusplus
	36	}
	37	#endif
	38
a3bf621f	39	#ifndef PATCHLEVEL
	40	# include <patchlevel.h>
	41	# if !(defined(PERL_VERSION) \|\| (SUBVERSION > 0 && defined(PATCHLEVEL)))
	42	# include <could_not_find_Perl_patchlevel.h>
	43	# endif
	44	#endif
	45
6a63fb82	46	#if PATCHLEVEL <= 4 && !defined(PL_dowarn)
	47	#define PL_dowarn dowarn
	48	#endif
6fba102d	49
2c634edc	50	#ifdef G_WARN_ON
	51	#define DOWARN (PL_dowarn & G_WARN_ON)
	52	#else
	53	#define DOWARN PL_dowarn
	54	#endif
	55
	56
6fba102d	57	#define MAX_LINE 76 /* size of encoded lines */
	58
	59	static char basis_64[] =
	60	"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/";
	61
	62	#define XX 255 /* illegal base64 char */
	63	#define EQ 254 /* padding */
	64	#define INVALID XX
	65
	66	static unsigned char index_64[256] = {
	67	XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX,
	68	XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX,
	69	XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,62, XX,XX,XX,63,
	70	52,53,54,55, 56,57,58,59, 60,61,XX,XX, XX,EQ,XX,XX,
	71	XX, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9,10, 11,12,13,14,
	72	15,16,17,18, 19,20,21,22, 23,24,25,XX, XX,XX,XX,XX,
	73	XX,26,27,28, 29,30,31,32, 33,34,35,36, 37,38,39,40,
	74	41,42,43,44, 45,46,47,48, 49,50,51,XX, XX,XX,XX,XX,
	75
	76	XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX,
	77	XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX,
	78	XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX,
	79	XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX,
	80	XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX,
	81	XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX,
	82	XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX,
	83	XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX,
	84	};
	85
6a63fb82	86	#ifdef SvPVbyte
	87	# if PERL_REVISION == 5 && PERL_VERSION < 7
	88	/* SvPVbyte does not work in perl-5.6.1, borrowed version for 5.7.3 */
	89	# undef SvPVbyte
	90	# define SvPVbyte(sv, lp) \
	91	((SvFLAGS(sv) & (SVf_POK\|SVf_UTF8)) == (SVf_POK) \
	92	? ((lp = SvCUR(sv)), SvPVX(sv)) : my_sv_2pvbyte(aTHX_ sv, &lp))
	93	static char *
	94	my_sv_2pvbyte(pTHX_ register SV sv, STRLEN lp)
	95	{
	96	sv_utf8_downgrade(sv,0);
	97	return SvPV(sv,*lp);
	98	}
	99	# endif
	100	#else
	101	# define SvPVbyte SvPV
	102	#endif
6fba102d	103
0a362e9d	104	#ifndef isXDIGIT
	105	# define isXDIGIT isxdigit
	106	#endif
	107
6a63fb82	108	#ifndef NATIVE_TO_ASCII
	109	# define NATIVE_TO_ASCII(ch) (ch)
	110	#endif
6fba102d	111
	112	MODULE = MIME::Base64 PACKAGE = MIME::Base64
	113
	114	SV*
	115	encode_base64(sv,...)
	116	SV* sv
	117	PROTOTYPE: $;$
	118
	119	PREINIT:
	120	char str; / string to encode */
	121	SSize_t len; /* length of the string */
	122	char eol; / the end-of-line sequence to use */
	123	STRLEN eollen; /* length of the EOL sequence */
	124	char r; / result string */
	125	STRLEN rlen; /* length of result string */
	126	unsigned char c1, c2, c3;
	127	int chunk;
	128
	129	CODE:
6a63fb82	130	#if PERL_REVISION == 5 && PERL_VERSION >= 6
6fba102d	131	sv_utf8_downgrade(sv, FALSE);
6a63fb82	132	#endif
6fba102d	133	str = SvPV(sv, rlen); /* SvPV(sv, len) gives warning for signed len */
	134	len = (SSize_t)rlen;
	135
	136	/* set up EOL from the second argument if present, default to "\n" */
	137	if (items > 1 && SvOK(ST(1))) {
	138	eol = SvPV(ST(1), eollen);
	139	} else {
	140	eol = "\n";
	141	eollen = 1;
	142	}
	143
	144	/* calculate the length of the result */
	145	rlen = (len+2) / 3 * 4; /* encoded bytes */
	146	if (rlen) {
	147	/* add space for EOL */
	148	rlen += ((rlen-1) / MAX_LINE + 1) * eollen;
	149	}
	150
	151	/* allocate a result buffer */
	152	RETVAL = newSV(rlen ? rlen : 1);
	153	SvPOK_on(RETVAL);
	154	SvCUR_set(RETVAL, rlen);
	155	r = SvPVX(RETVAL);
	156
	157	/* encode */
	158	for (chunk=0; len > 0; len -= 3, chunk++) {
	159	if (chunk == (MAX_LINE/4)) {
	160	char *c = eol;
	161	char *e = eol + eollen;
	162	while (c < e)
	163	r++ = c++;
	164	chunk = 0;
	165	}
	166	c1 = *str++;
8be5f608	167	c2 = len > 1 ? *str++ : '\0';
6fba102d	168	*r++ = basis_64[c1>>2];
	169	*r++ = basis_64[((c1 & 0x3)<< 4) \| ((c2 & 0xF0) >> 4)];
	170	if (len > 2) {
	171	c3 = *str++;
	172	*r++ = basis_64[((c2 & 0xF) << 2) \| ((c3 & 0xC0) >>6)];
	173	*r++ = basis_64[c3 & 0x3F];
	174	} else if (len == 2) {
	175	*r++ = basis_64[(c2 & 0xF) << 2];
	176	*r++ = '=';
	177	} else { /* len == 1 */
	178	*r++ = '=';
	179	*r++ = '=';
	180	}
	181	}
	182	if (rlen) {
	183	/* append eol to the result string */
	184	char *c = eol;
	185	char *e = eol + eollen;
	186	while (c < e)
	187	r++ = c++;
	188	}
	189	r = '\0'; / every SV in perl should be NUL-terminated */
	190
	191	OUTPUT:
	192	RETVAL
	193
	194	SV*
	195	decode_base64(sv)
	196	SV* sv
	197	PROTOTYPE: $
	198
	199	PREINIT:
	200	STRLEN len;
7d85a32c	201	register unsigned char str = (unsigned char)SvPVbyte(sv, len);
6fba102d	202	unsigned char const* end = str + len;
	203	char *r;
	204	unsigned char c[4];
	205
	206	CODE:
	207	{
	208	/* always enough, but might be too much */
	209	STRLEN rlen = len * 3 / 4;
	210	RETVAL = newSV(rlen ? rlen : 1);
	211	}
	212	SvPOK_on(RETVAL);
	213	r = SvPVX(RETVAL);
	214
	215	while (str < end) {
	216	int i = 0;
	217	do {
7d85a32c	218	unsigned char uc = index_64[NATIVE_TO_ASCII(*str++)];
6fba102d	219	if (uc != INVALID)
	220	c[i++] = uc;
	221
	222	if (str == end) {
	223	if (i < 4) {
2c634edc	224	if (i && DOWARN)
6fba102d	225	warn("Premature end of base64 data");
	226	if (i < 2) goto thats_it;
	227	if (i == 2) c[2] = EQ;
	228	c[3] = EQ;
	229	}
	230	break;
	231	}
	232	} while (i < 4);
7d85a32c	233
6fba102d	234	if (c[0] == EQ \|\| c[1] == EQ) {
2c634edc	235	if (DOWARN) warn("Premature padding of base64 data");
6fba102d	236	break;
6fba102d	237	}
c6c619a9	238	/* printf("c0=%d,c1=%d,c2=%d,c3=%d\n", c[0],c[1],c[2],c[3]);*/
6fba102d	239
	240	*r++ = (c[0] << 2) \| ((c[1] & 0x30) >> 4);
	241
	242	if (c[2] == EQ)
	243	break;
	244	*r++ = ((c[1] & 0x0F) << 4) \| ((c[2] & 0x3C) >> 2);
	245
	246	if (c[3] == EQ)
	247	break;
	248	*r++ = ((c[2] & 0x03) << 6) \| c[3];
	249	}
	250
	251	thats_it:
	252	SvCUR_set(RETVAL, r - SvPVX(RETVAL));
	253	*r = '\0';
	254
	255	OUTPUT:
	256	RETVAL
6a63fb82	257
	258
	259	MODULE = MIME::Base64 PACKAGE = MIME::QuotedPrint
	260
691d66bd	261	#define qp_isplain(c) ((c) == '\t' \|\| (((c) >= ' ' && (c) <= '~') && (c) != '='))
6a63fb82	262
	263	SV*
	264	encode_qp(sv,...)
	265	SV* sv
	266	PROTOTYPE: $;$
	267
	268	PREINIT:
	269	char *eol;
	270	STRLEN eol_len;
	271	STRLEN sv_len;
	272	STRLEN linelen;
	273	char *beg;
	274	char *end;
	275	char *p;
	276	char *p_beg;
	277	STRLEN p_len;
	278
	279	CODE:
	280	#if PERL_REVISION == 5 && PERL_VERSION >= 6
	281	sv_utf8_downgrade(sv, FALSE);
	282	#endif
	283	/* set up EOL from the second argument if present, default to "\n" */
	284	if (items > 1 && SvOK(ST(1))) {
	285	eol = SvPV(ST(1), eol_len);
	286	} else {
	287	eol = "\n";
	288	eol_len = 1;
	289	}
	290
	291	beg = SvPV(sv, sv_len);
	292	end = beg + sv_len;
	293
	294	RETVAL = newSV(sv_len + 1);
	295	sv_setpv(RETVAL, "");
	296	linelen = 0;
	297
	298	p = beg;
	299	while (1) {
	300	p_beg = p;
	301
	302	/* skip past as much plain text as possible */
	303	while (p < end && qp_isplain(*p)) {
	304	p++;
	305	}
8be5f608	306	if (p == end \|\| *p == '\n') {
6a63fb82	307	/* whitespace at end of line must be encoded */
	308	while (p > p_beg && ((p - 1) == '\t' \|\| (p - 1) == ' '))
	309	p--;
	310	}
	311
	312	p_len = p - p_beg;
	313	if (p_len) {
	314	/* output plain text (with line breaks) */
	315	if (eol_len) {
8be5f608	316	STRLEN max_last_line = (p == end \|\| *p == '\n')
6a63fb82	317	? MAX_LINE /* .......\n */
8be5f608	318	: ((p + 1) == end \|\| *(p + 1) == '\n')
6a63fb82	319	? MAX_LINE - 3 /* ....=XX\n */
	320	: MAX_LINE - 4; /* ...=XX=\n */
	321	while (p_len + linelen > max_last_line) {
	322	STRLEN len = MAX_LINE - 1 - linelen;
	323	if (len > p_len)
	324	len = p_len;
	325	sv_catpvn(RETVAL, p_beg, len);
	326	p_beg += len;
	327	p_len -= len;
	328	sv_catpvn(RETVAL, "=", 1);
	329	sv_catpvn(RETVAL, eol, eol_len);
	330	linelen = 0;
	331	}
	332	}
	333	if (p_len) {
	334	sv_catpvn(RETVAL, p_beg, p_len);
	335	linelen += p_len;
	336	}
	337	}
	338
8be5f608	339	if (p == end) {
	340	break;
	341	}
	342	else if (*p == '\n' && eol_len) {
6a63fb82	343	sv_catpvn(RETVAL, eol, eol_len);
	344	p++;
	345	linelen = 0;
	346	}
8be5f608	347	else {
6a63fb82	348	/* output escaped char (with line breaks) */
1b96abaf	349	assert(p < end);
6a63fb82	350	if (eol_len && linelen > MAX_LINE - 4) {
	351	sv_catpvn(RETVAL, "=", 1);
	352	sv_catpvn(RETVAL, eol, eol_len);
	353	linelen = 0;
	354	}
	355	sv_catpvf(RETVAL, "=%02X", (unsigned char)*p);
	356	p++;
	357	linelen += 3;
	358	}
6a63fb82	359
	360	/* optimize reallocs a bit */
	361	if (SvLEN(RETVAL) > 80 && SvLEN(RETVAL) - SvCUR(RETVAL) < 3) {
	362	STRLEN expected_len = (SvCUR(RETVAL) * sv_len) / (p - beg);
	363	SvGROW(RETVAL, expected_len);
	364	}
	365	}
	366
	367	OUTPUT:
	368	RETVAL
	369
	370	SV*
	371	decode_qp(sv)
	372	SV* sv
	373	PROTOTYPE: $
	374
	375	PREINIT:
	376	STRLEN len;
7235ff25	377	char *str = SvPVbyte(sv, len);
6a63fb82	378	char const* end = str + len;
	379	char *r;
	380	char *whitespace = 0;
	381
	382	CODE:
	383	RETVAL = newSV(len ? len : 1);
	384	SvPOK_on(RETVAL);
	385	r = SvPVX(RETVAL);
	386	while (str < end) {
	387	if (str == ' ' \|\| str == '\t') {
	388	if (!whitespace)
	389	whitespace = str;
	390	str++;
	391	}
	392	else if (*str == '\r' && (str + 1) < end && str[1] == '\n') {
	393	str++;
	394	}
	395	else if (*str == '\n') {
	396	whitespace = 0;
	397	r++ = str++;
	398	}
	399	else {
	400	if (whitespace) {
	401	while (whitespace < str) {
	402	r++ = whitespace++;
	403	}
	404	whitespace = 0;
	405	}
ea0e37e4	406	if (*str == '=') {
691d66bd	407	if ((str + 2) < end && isXDIGIT(str[1]) && isXDIGIT(str[2])) {
ea0e37e4	408	char buf[3];
	409	str++;
	410	buf[0] = *str++;
	411	buf[1] = *str++;
	412	buf[2] = '\0';
	413	*r++ = (char)strtol(buf, 0, 16);
	414	}
	415	else {
	416	/* look for soft line break */
	417	char *p = str + 1;
	418	while (p < end && (p == ' ' \|\| p == '\t'))
	419	p++;
	420	if (p < end && *p == '\n')
	421	str = p + 1;
	422	else if ((p + 1) < end && p == '\r' && (p + 1) == '\n')
	423	str = p + 2;
	424	else
	425	r++ = str++; /* give up */
	426	}
6a63fb82	427	}
ea0e37e4	428	else {
ea0e37e4	429	r++ = str++;
6a63fb82	430	}
6a63fb82	431	}
6a63fb82	432	}
2c634edc	433	if (whitespace) {
	434	while (whitespace < str) {
	435	r++ = whitespace++;
	436	}
	437	}
6a63fb82	438	*r = '\0';
	439	SvCUR_set(RETVAL, r - SvPVX(RETVAL));
	440
	441	OUTPUT:
	442	RETVAL
	443
	444
	445	MODULE = MIME::Base64 PACKAGE = MIME::Base64