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

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