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

/* $Id: Base64.xs,v 3.5 2005/11/26 10:44:14 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 const char basis_64[] =
   "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/";

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

static const 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;
	int binary;
	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;
	}

	binary = (items > 2 && SvTRUE(ST(2)));

	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 && !binary) {
	        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);
	    }
        }

	if (SvCUR(RETVAL) && eol_len && linelen) {
	    sv_catpvn(RETVAL, "=", 1);
	    sv_catpvn(RETVAL, eol, eol_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
e1839706	1	/* $Id: Base64.xs,v 3.5 2005/11/26 10:44:14 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 */
6fba102d	58
27da23d5	59	static const char basis_64[] =
6fba102d	60	"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/";
	61
	62	#define XX 255 /* illegal base64 char */
	63	#define EQ 254 /* padding */
	64	#define INVALID XX
	65
27da23d5	66	static const unsigned char index_64[256] = {
6fba102d	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
9e87bee3	266	PROTOTYPE: $;$$
6a63fb82	267
	268	PREINIT:
	269	char *eol;
	270	STRLEN eol_len;
9e87bee3	271	int binary;
6a63fb82	272	STRLEN sv_len;
	273	STRLEN linelen;
	274	char *beg;
	275	char *end;
	276	char *p;
	277	char *p_beg;
	278	STRLEN p_len;
	279
	280	CODE:
	281	#if PERL_REVISION == 5 && PERL_VERSION >= 6
	282	sv_utf8_downgrade(sv, FALSE);
	283	#endif
	284	/* set up EOL from the second argument if present, default to "\n" */
	285	if (items > 1 && SvOK(ST(1))) {
	286	eol = SvPV(ST(1), eol_len);
	287	} else {
	288	eol = "\n";
	289	eol_len = 1;
	290	}
	291
9e87bee3	292	binary = (items > 2 && SvTRUE(ST(2)));
9e87bee3	293
6a63fb82	294	beg = SvPV(sv, sv_len);
	295	end = beg + sv_len;
	296
	297	RETVAL = newSV(sv_len + 1);
	298	sv_setpv(RETVAL, "");
	299	linelen = 0;
	300
	301	p = beg;
	302	while (1) {
	303	p_beg = p;
	304
	305	/* skip past as much plain text as possible */
	306	while (p < end && qp_isplain(*p)) {
	307	p++;
	308	}
8be5f608	309	if (p == end \|\| *p == '\n') {
6a63fb82	310	/* whitespace at end of line must be encoded */
	311	while (p > p_beg && ((p - 1) == '\t' \|\| (p - 1) == ' '))
	312	p--;
	313	}
	314
	315	p_len = p - p_beg;
	316	if (p_len) {
	317	/* output plain text (with line breaks) */
	318	if (eol_len) {
8be5f608	319	STRLEN max_last_line = (p == end \|\| *p == '\n')
6a63fb82	320	? MAX_LINE /* .......\n */
8be5f608	321	: ((p + 1) == end \|\| *(p + 1) == '\n')
6a63fb82	322	? MAX_LINE - 3 /* ....=XX\n */
	323	: MAX_LINE - 4; /* ...=XX=\n */
	324	while (p_len + linelen > max_last_line) {
	325	STRLEN len = MAX_LINE - 1 - linelen;
	326	if (len > p_len)
	327	len = p_len;
	328	sv_catpvn(RETVAL, p_beg, len);
	329	p_beg += len;
	330	p_len -= len;
	331	sv_catpvn(RETVAL, "=", 1);
	332	sv_catpvn(RETVAL, eol, eol_len);
	333	linelen = 0;
	334	}
	335	}
	336	if (p_len) {
	337	sv_catpvn(RETVAL, p_beg, p_len);
	338	linelen += p_len;
	339	}
	340	}
	341
8be5f608	342	if (p == end) {
	343	break;
	344	}
9e87bee3	345	else if (*p == '\n' && eol_len && !binary) {
6a63fb82	346	sv_catpvn(RETVAL, eol, eol_len);
	347	p++;
	348	linelen = 0;
	349	}
8be5f608	350	else {
6a63fb82	351	/* output escaped char (with line breaks) */
1b96abaf	352	assert(p < end);
6a63fb82	353	if (eol_len && linelen > MAX_LINE - 4) {
	354	sv_catpvn(RETVAL, "=", 1);
	355	sv_catpvn(RETVAL, eol, eol_len);
	356	linelen = 0;
	357	}
	358	sv_catpvf(RETVAL, "=%02X", (unsigned char)*p);
	359	p++;
	360	linelen += 3;
	361	}
6a63fb82	362
	363	/* optimize reallocs a bit */
	364	if (SvLEN(RETVAL) > 80 && SvLEN(RETVAL) - SvCUR(RETVAL) < 3) {
	365	STRLEN expected_len = (SvCUR(RETVAL) * sv_len) / (p - beg);
	366	SvGROW(RETVAL, expected_len);
	367	}
	368	}
	369
9e87bee3	370	if (SvCUR(RETVAL) && eol_len && linelen) {
	371	sv_catpvn(RETVAL, "=", 1);
	372	sv_catpvn(RETVAL, eol, eol_len);
	373	}
	374
6a63fb82	375	OUTPUT:
	376	RETVAL
	377
	378	SV*
	379	decode_qp(sv)
	380	SV* sv
	381	PROTOTYPE: $
	382
	383	PREINIT:
	384	STRLEN len;
7235ff25	385	char *str = SvPVbyte(sv, len);
6a63fb82	386	char const* end = str + len;
	387	char *r;
	388	char *whitespace = 0;
	389
	390	CODE:
	391	RETVAL = newSV(len ? len : 1);
	392	SvPOK_on(RETVAL);
	393	r = SvPVX(RETVAL);
	394	while (str < end) {
	395	if (str == ' ' \|\| str == '\t') {
	396	if (!whitespace)
	397	whitespace = str;
	398	str++;
	399	}
	400	else if (*str == '\r' && (str + 1) < end && str[1] == '\n') {
	401	str++;
	402	}
	403	else if (*str == '\n') {
	404	whitespace = 0;
	405	r++ = str++;
	406	}
	407	else {
	408	if (whitespace) {
	409	while (whitespace < str) {
	410	r++ = whitespace++;
	411	}
	412	whitespace = 0;
	413	}
ea0e37e4	414	if (*str == '=') {
691d66bd	415	if ((str + 2) < end && isXDIGIT(str[1]) && isXDIGIT(str[2])) {
ea0e37e4	416	char buf[3];
	417	str++;
	418	buf[0] = *str++;
	419	buf[1] = *str++;
	420	buf[2] = '\0';
	421	*r++ = (char)strtol(buf, 0, 16);
	422	}
	423	else {
	424	/* look for soft line break */
	425	char *p = str + 1;
	426	while (p < end && (p == ' ' \|\| p == '\t'))
	427	p++;
	428	if (p < end && *p == '\n')
	429	str = p + 1;
	430	else if ((p + 1) < end && p == '\r' && (p + 1) == '\n')
	431	str = p + 2;
	432	else
	433	r++ = str++; /* give up */
	434	}
6a63fb82	435	}
ea0e37e4	436	else {
ea0e37e4	437	r++ = str++;
6a63fb82	438	}
6a63fb82	439	}
6a63fb82	440	}
2c634edc	441	if (whitespace) {
	442	while (whitespace < str) {
	443	r++ = whitespace++;
	444	}
	445	}
6a63fb82	446	*r = '\0';
	447	SvCUR_set(RETVAL, r - SvPVX(RETVAL));
	448
	449	OUTPUT:
	450	RETVAL
	451
	452
	453	MODULE = MIME::Base64 PACKAGE = MIME::Base64