+
+/*
+=for apidoc prescan_version
+
+Validate that a given string can be parsed as a version object, but doesn't
+actually perform the parsing. Can use either strict or lax validation rules.
+Can optionally set a number of hint variables to save the parsing code
+some time when tokenizing.
+
+=cut
+*/
+const char *
+Perl_prescan_version(pTHX_ const char *s, bool strict,
+ const char **errstr,
+ bool *sqv, int *ssaw_decimal, int *swidth, bool *salpha) {
+ bool qv = (sqv ? *sqv : FALSE);
+ int width = 3;
+ int saw_decimal = 0;
+ bool alpha = FALSE;
+ const char *d = s;
+
+ PERL_ARGS_ASSERT_PRESCAN_VERSION;
+
+ if (qv && isDIGIT(*d))
+ goto dotted_decimal_version;
+
+ if (*d == 'v') { /* explicit v-string */
+ d++;
+ if (isDIGIT(*d)) {
+ qv = TRUE;
+ }
+ else { /* degenerate v-string */
+ /* requires v1.2.3 */
+ BADVERSION(s,errstr,"Invalid version format (dotted-decimal versions require at least three parts)");
+ }
+
+dotted_decimal_version:
+ if (strict && d[0] == '0' && isDIGIT(d[1])) {
+ /* no leading zeros allowed */
+ BADVERSION(s,errstr,"Invalid version format (no leading zeros)");
+ }
+
+ while (isDIGIT(*d)) /* integer part */
+ d++;
+
+ if (*d == '.')
+ {
+ saw_decimal++;
+ d++; /* decimal point */
+ }
+ else
+ {
+ if (strict) {
+ /* require v1.2.3 */
+ BADVERSION(s,errstr,"Invalid version format (dotted-decimal versions require at least three parts)");
+ }
+ else {
+ goto version_prescan_finish;
+ }
+ }
+
+ {
+ int i = 0;
+ int j = 0;
+ while (isDIGIT(*d)) { /* just keep reading */
+ i++;
+ while (isDIGIT(*d)) {
+ d++; j++;
+ /* maximum 3 digits between decimal */
+ if (strict && j > 3) {
+ BADVERSION(s,errstr,"Invalid version format (maximum 3 digits between decimals)");
+ }
+ }
+ if (*d == '_') {
+ if (strict) {
+ BADVERSION(s,errstr,"Invalid version format (no underscores)");
+ }
+ if ( alpha ) {
+ BADVERSION(s,errstr,"Invalid version format (multiple underscores)");
+ }
+ d++;
+ alpha = TRUE;
+ }
+ else if (*d == '.') {
+ if (alpha) {
+ BADVERSION(s,errstr,"Invalid version format (underscores before decimal)");
+ }
+ saw_decimal++;
+ d++;
+ }
+ else if (!isDIGIT(*d)) {
+ break;
+ }
+ j = 0;
+ }
+
+ if (strict && i < 2) {
+ /* requires v1.2.3 */
+ BADVERSION(s,errstr,"Invalid version format (dotted-decimal versions require at least three parts)");
+ }
+ }
+ } /* end if dotted-decimal */
+ else
+ { /* decimal versions */
+ /* special strict case for leading '.' or '0' */
+ if (strict) {
+ if (*d == '.') {
+ BADVERSION(s,errstr,"Invalid version format (0 before decimal required)");
+ }
+ if (*d == '0' && isDIGIT(d[1])) {
+ BADVERSION(s,errstr,"Invalid version format (no leading zeros)");
+ }
+ }
+
+ /* and we never support negative versions */
+ if ( *d == '-') {
+ BADVERSION(s,errstr,"Invalid version format (negative version number)");
+ }
+
+ /* consume all of the integer part */
+ while (isDIGIT(*d))
+ d++;
+
+ /* look for a fractional part */
+ if (*d == '.') {
+ /* we found it, so consume it */
+ saw_decimal++;
+ d++;
+ }
+ else if (!*d || *d == ';' || isSPACE(*d) || *d == '{' || *d == '}') {
+ if ( d == s ) {
+ /* found nothing */
+ BADVERSION(s,errstr,"Invalid version format (version required)");
+ }
+ /* found just an integer */
+ goto version_prescan_finish;
+ }
+ else if ( d == s ) {
+ /* didn't find either integer or period */
+ BADVERSION(s,errstr,"Invalid version format (non-numeric data)");
+ }
+ else if (*d == '_') {
+ /* underscore can't come after integer part */
+ if (strict) {
+ BADVERSION(s,errstr,"Invalid version format (no underscores)");
+ }
+ else if (isDIGIT(d[1])) {
+ BADVERSION(s,errstr,"Invalid version format (alpha without decimal)");
+ }
+ else {
+ BADVERSION(s,errstr,"Invalid version format (misplaced underscore)");
+ }
+ }
+ else {
+ /* anything else after integer part is just invalid data */
+ BADVERSION(s,errstr,"Invalid version format (non-numeric data)");
+ }
+
+ /* scan the fractional part after the decimal point*/
+
+ if (!isDIGIT(*d) && (strict || ! (!*d || *d == ';' || isSPACE(*d) || *d == '{' || *d == '}') )) {
+ /* strict or lax-but-not-the-end */
+ BADVERSION(s,errstr,"Invalid version format (fractional part required)");
+ }
+
+ while (isDIGIT(*d)) {
+ d++;
+ if (*d == '.' && isDIGIT(d[-1])) {
+ if (alpha) {
+ BADVERSION(s,errstr,"Invalid version format (underscores before decimal)");
+ }
+ if (strict) {
+ BADVERSION(s,errstr,"Invalid version format (dotted-decimal versions must begin with 'v')");
+ }
+ d = (char *)s; /* start all over again */
+ qv = TRUE;
+ goto dotted_decimal_version;
+ }
+ if (*d == '_') {
+ if (strict) {
+ BADVERSION(s,errstr,"Invalid version format (no underscores)");
+ }
+ if ( alpha ) {
+ BADVERSION(s,errstr,"Invalid version format (multiple underscores)");
+ }
+ if ( ! isDIGIT(d[1]) ) {
+ BADVERSION(s,errstr,"Invalid version format (misplaced underscore)");
+ }
+ d++;
+ alpha = TRUE;
+ }
+ }
+ }
+
+version_prescan_finish:
+ while (isSPACE(*d))
+ d++;
+
+ if (!isDIGIT(*d) && (! (!*d || *d == ';' || *d == '{' || *d == '}') )) {
+ /* trailing non-numeric data */
+ BADVERSION(s,errstr,"Invalid version format (non-numeric data)");
+ }
+
+ if (sqv)
+ *sqv = qv;
+ if (swidth)
+ *swidth = width;
+ if (ssaw_decimal)
+ *ssaw_decimal = saw_decimal;
+ if (salpha)
+ *salpha = alpha;
+ return d;
+}
+
https://perl5.git.perl.org / perl5.git / blobdiff