#include "vutil.h"
const char *
Perl_scan_version(pTHX_ const char *s, SV *rv, bool qv)
{
const char *start;
const char *pos;
const char *last;
int saw_period = 0;
int alpha = 0;
int width = 3;
AV *av = newAV();
SV *hv = newSVrv(rv, "version");
(void)sv_upgrade(hv, SVt_PVHV);
#ifndef NODEFAULT_SHAREKEYS
HvSHAREKEYS_on(hv);
#endif
while (isSPACE(*s))
s++;
if (*s == 'v') {
s++;
qv = 1;
}
start = last = pos = s;
while ( *pos == '.' || *pos == '_' || isDIGIT(*pos) )
{
if ( *pos == '.' )
{
if ( alpha )
Perl_croak(aTHX_ "Invalid version format (underscores before decimal)");
saw_period++ ;
last = pos;
}
else if ( *pos == '_' )
{
if ( alpha )
Perl_croak(aTHX_ "Invalid version format (multiple underscores)");
alpha = 1;
width = pos - last - 1;
}
pos++;
}
if ( alpha && !saw_period )
Perl_croak(aTHX_ "Invalid version format (alpha without decimal)");
if ( saw_period > 1 )
qv = 1;
pos = s;
if ( qv )
hv_store((HV *)hv, "qv", 2, newSViv(qv), 0);
if ( alpha )
hv_store((HV *)hv, "alpha", 5, newSViv(alpha), 0);
if ( !qv && width < 3 )
hv_store((HV *)hv, "width", 5, newSViv(width), 0);
while (isDIGIT(*pos))
pos++;
if (!isALPHA(*pos)) {
I32 rev;
for (;;) {
rev = 0;
{
const char *end = pos;
I32 mult = 1;
I32 orev;
if ( !qv && s > start && saw_period == 1 ) {
mult *= 100;
while ( s < end ) {
orev = rev;
rev += (*s - '0') * mult;
mult /= 10;
if ( PERL_ABS(orev) > PERL_ABS(rev) )
Perl_croak(aTHX_ "Integer overflow in version");
s++;
if ( *s == '_' )
s++;
}
}
else {
while (--end >= s) {
orev = rev;
rev += (*end - '0') * mult;
mult *= 10;
if ( PERL_ABS(orev) > PERL_ABS(rev) )
Perl_croak(aTHX_ "Integer overflow in version");
}
}
}
av_push(av, newSViv(rev));
if ( *pos == '.' && isDIGIT(pos[1]) )
s = ++pos;
else if ( *pos == '_' && isDIGIT(pos[1]) )
s = ++pos;
else if ( isDIGIT(*pos) )
s = pos;
else {
s = pos;
break;
}
if ( qv ) {
while ( isDIGIT(*pos) )
pos++;
}
else {
int digits = 0;
while ( ( isDIGIT(*pos) || *pos == '_' ) && digits < 3 ) {
if ( *pos != '_' )
digits++;
pos++;
}
}
}
}
if ( qv ) {
I32 len = av_len(av);
len = 2 - len;
while (len-- > 0)
av_push(av, newSViv(0));
}
if ( av_len(av) == -1 )
av_push(av, newSViv(0));
hv_store((HV *)hv, "version", 7, newRV_noinc((SV *)av), 0);
return s;
}
SV *
Perl_new_version(pTHX_ SV *ver)
{
SV * const rv = newSV(0);
if ( sv_derived_from(ver,"version") )
{
I32 key;
AV * const av = newAV();
AV *sav;
SV * const hv = newSVrv(rv, "version");
(void)sv_upgrade(hv, SVt_PVHV);
#ifndef NODEFAULT_SHAREKEYS
HvSHAREKEYS_on(hv);
#endif
if ( SvROK(ver) )
ver = SvRV(ver);
if ( hv_exists((HV *)ver, "qv", 2) )
hv_store((HV *)hv, "qv", 2, &PL_sv_yes, 0);
if ( hv_exists((HV *)ver, "alpha", 5) )
hv_store((HV *)hv, "alpha", 5, &PL_sv_yes, 0);
if ( hv_exists((HV*)ver, "width", 5 ) )
{
const I32 width = SvIV(*hv_fetch((HV*)ver, "width", 5, FALSE));
hv_store((HV *)hv, "width", 5, newSViv(width), 0);
}
sav = (AV *)SvRV(*hv_fetch((HV*)ver, "version", 7, FALSE));
for ( key = 0; key <= av_len(sav); key++ )
{
const I32 rev = SvIV(*av_fetch(sav, key, FALSE));
av_push(av, newSViv(rev));
}
hv_store((HV *)hv, "version", 7, newRV_noinc((SV *)av), 0);
return rv;
}
#ifdef SvVOK
if ( SvVOK(ver) ) {
const MAGIC* const mg = mg_find(ver,PERL_MAGIC_vstring);
const STRLEN len = mg->mg_len;
char * const version = savepvn( (const char*)mg->mg_ptr, len);
sv_setpvn(rv,version,len);
Safefree(version);
}
else {
#endif
sv_setsv(rv,ver);
#ifdef SvVOK
}
#endif
upg_version(rv);
return rv;
}
SV *
Perl_upg_version(pTHX_ SV *ver)
{
const char *version, *s;
bool qv = 0;
if ( SvNOK(ver) )
{
char tbuf[64];
sprintf(tbuf,"%.9"NVgf, SvNVX(ver));
version = savepv(tbuf);
}
#ifdef SvVOK
else if ( SvVOK(ver) ) {
const MAGIC* const mg = mg_find(ver,PERL_MAGIC_vstring);
version = savepvn( (const char*)mg->mg_ptr,mg->mg_len );
qv = 1;
}
#endif
else
{
version = savepv(SvPV_nolen(ver));
}
s = scan_version(version, ver, qv);
if ( *s != '\0' )
if(ckWARN(WARN_MISC))
Perl_warner(aTHX_ packWARN(WARN_MISC),
"Version string '%s' contains invalid data; "
"ignoring: '%s'", version, s);
Safefree(version);
return ver;
}
bool
Perl_vverify(pTHX_ SV *vs)
{
SV *sv;
if ( SvROK(vs) )
vs = SvRV(vs);
if ( SvTYPE(vs) == SVt_PVHV
&& hv_exists((HV*)vs, "version", 7)
&& (sv = SvRV(*hv_fetch((HV*)vs, "version", 7, FALSE)))
&& SvTYPE(sv) == SVt_PVAV )
return TRUE;
else
return FALSE;
}
SV *
Perl_vnumify(pTHX_ SV *vs)
{
I32 i, len, digit;
int width;
bool alpha = FALSE;
SV * const sv = newSV(0);
AV *av;
if ( SvROK(vs) )
vs = SvRV(vs);
if ( !vverify(vs) )
Perl_croak(aTHX_ "Invalid version object");
if ( hv_exists((HV*)vs, "alpha", 5 ) )
alpha = TRUE;
if ( hv_exists((HV*)vs, "width", 5 ) )
width = SvIV(*hv_fetch((HV*)vs, "width", 5, FALSE));
else
width = 3;
if ( !(av = (AV *)SvRV(*hv_fetch((HV*)vs, "version", 7, FALSE)) ) ) {
sv_catpvn(sv,"0",1);
return sv;
}
len = av_len(av);
if ( len == -1 )
{
sv_catpvn(sv,"0",1);
return sv;
}
digit = SvIV(*av_fetch(av, 0, 0));
Perl_sv_setpvf(aTHX_ sv, "%d.", (int)PERL_ABS(digit));
for ( i = 1 ; i < len ; i++ )
{
digit = SvIV(*av_fetch(av, i, 0));
if ( width < 3 ) {
const int denom = (width == 2 ? 10 : 100);
const div_t term = div((int)PERL_ABS(digit),denom);
Perl_sv_catpvf(aTHX_ sv, "%0*d_%d", width, term.quot, term.rem);
}
else {
Perl_sv_catpvf(aTHX_ sv, "%0*d", width, (int)digit);
}
}
if ( len > 0 )
{
digit = SvIV(*av_fetch(av, len, 0));
if ( alpha && width == 3 )
sv_catpvn(sv,"_",1);
Perl_sv_catpvf(aTHX_ sv, "%0*d", width, (int)digit);
}
else
{
sv_catpvn(sv,"000",3);
}
return sv;
}
SV *
Perl_vnormal(pTHX_ SV *vs)
{
I32 i, len, digit;
bool alpha = FALSE;
SV * const sv = newSV(0);
AV *av;
if ( SvROK(vs) )
vs = SvRV(vs);
if ( !vverify(vs) )
Perl_croak(aTHX_ "Invalid version object");
if ( hv_exists((HV*)vs, "alpha", 5 ) )
alpha = TRUE;
av = (AV *)SvRV(*hv_fetch((HV*)vs, "version", 7, FALSE));
len = av_len(av);
if ( len == -1 )
{
sv_catpvn(sv,"",0);
return sv;
}
digit = SvIV(*av_fetch(av, 0, 0));
Perl_sv_setpvf(aTHX_ sv, "v%"IVdf, (IV)digit);
for ( i = 1 ; i < len ; i++ ) {
digit = SvIV(*av_fetch(av, i, 0));
Perl_sv_catpvf(aTHX_ sv, ".%"IVdf, (IV)digit);
}
if ( len > 0 )
{
digit = SvIV(*av_fetch(av, len, 0));
if ( alpha )
Perl_sv_catpvf(aTHX_ sv, "_%"IVdf, (IV)digit);
else
Perl_sv_catpvf(aTHX_ sv, ".%"IVdf, (IV)digit);
}
if ( len <= 2 ) {
for ( len = 2 - len; len != 0; len-- )
sv_catpvn(sv,".0",2);
}
return sv;
}
SV *
Perl_vstringify(pTHX_ SV *vs)
{
if ( SvROK(vs) )
vs = SvRV(vs);
if ( !vverify(vs) )
Perl_croak(aTHX_ "Invalid version object");
if ( hv_exists((HV *)vs, "qv", 2) )
return vnormal(vs);
else
return vnumify(vs);
}
int
Perl_vcmp(pTHX_ SV *lhv, SV *rhv)
{
I32 i,l,m,r,retval;
bool lalpha = FALSE;
bool ralpha = FALSE;
I32 left = 0;
I32 right = 0;
AV *lav, *rav;
if ( SvROK(lhv) )
lhv = SvRV(lhv);
if ( SvROK(rhv) )
rhv = SvRV(rhv);
if ( !vverify(lhv) )
Perl_croak(aTHX_ "Invalid version object");
if ( !vverify(rhv) )
Perl_croak(aTHX_ "Invalid version object");
lav = (AV *)SvRV(*hv_fetch((HV*)lhv, "version", 7, FALSE));
if ( hv_exists((HV*)lhv, "alpha", 5 ) )
lalpha = TRUE;
rav = (AV *)SvRV(*hv_fetch((HV*)rhv, "version", 7, FALSE));
if ( hv_exists((HV*)rhv, "alpha", 5 ) )
ralpha = TRUE;
l = av_len(lav);
r = av_len(rav);
m = l < r ? l : r;
retval = 0;
i = 0;
while ( i <= m && retval == 0 )
{
left = SvIV(*av_fetch(lav,i,0));
right = SvIV(*av_fetch(rav,i,0));
if ( left < right )
retval = -1;
if ( left > right )
retval = +1;
i++;
}
if ( retval == 0 && l == r && left == right && ( lalpha || ralpha ) )
{
if ( lalpha && !ralpha )
{
retval = -1;
}
else if ( ralpha && !lalpha)
{
retval = +1;
}
}
if ( l != r && retval == 0 )
{
if ( l < r )
{
while ( i <= r && retval == 0 )
{
if ( SvIV(*av_fetch(rav,i,0)) != 0 )
retval = -1;
i++;
}
}
else
{
while ( i <= l && retval == 0 )
{
if ( SvIV(*av_fetch(lav,i,0)) != 0 )
retval = +1;
i++;
}
}
}
return retval;
}