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

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