-/* $Id: Base64.xs,v 1.18 2001/02/24 06:27:01 gisle Exp $
+/* $Id: Base64.xs,v 1.41 2004/01/08 14:07:26 gisle Exp $
-Copyright 1997-1999,2001 Gisle Aas
+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.
}
#endif
-#include "patchlevel.h"
+#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[] =
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
int chunk;
CODE:
-#ifdef sv_utf8_downgrade
+#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 */
chunk = 0;
}
c1 = *str++;
- c2 = *str++;
+ c2 = len > 1 ? *str++ : '\0';
*r++ = basis_64[c1>>2];
*r++ = basis_64[((c1 & 0x3)<< 4) | ((c2 & 0xF0) >> 4)];
if (len > 2) {
if (str == end) {
if (i < 4) {
- if (i && PL_dowarn)
+ if (i && DOWARN)
warn("Premature end of base64 data");
if (i < 2) goto thats_it;
if (i == 2) c[2] = EQ;
} while (i < 4);
if (c[0] == EQ || c[1] == EQ) {
- if (PL_dowarn) warn("Premature padding of base64 data");
+ 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]);/**/
+ /* 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);
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
projects / p5sagit/p5-mst-13.2.git / blobdiff