ronald@robobar.co.uk (Ronald S H Khoo) (02/11/91)
[ Yes, line-eater, this is *Yet* another feature request ]
I need nl_printf() -- my boss won't let me use perl without it.
(We have lots of foreign customers, and they seem to want reports
written in a language that they can understand :-( )
Is there any chance of adding a position independent sprintf() to perl?
Pretty please ? With a lump of sugar on top ?
A simple %<digit>$format a'la X/Open nl_sprintf() where <digit> from
1 to 9 specifies which parameter (plus corresponding nl_printf()) would be
adequate. I've actually hacked do_sprintf to recognise and obey this
format (diffs below) but I guess it really needs to be a separately named
nl_{s,}printf()... (which nevertheless is meant to work with non-position
specified args as well, to help with sanity...)
Anyone got any better ideas ? Any chance of some "Official" solution ?
Thanks...
*** doarg.c~ Mon Feb 11 11:17:47 1991
--- doarg.c Mon Feb 11 11:14:47 1991
***************
*** 774,779 ****
--- 774,795 ----
str_ncat(str, "\n", 1);
}
+ #ifndef CRIPPLED_CC
+ #define Sarg (nl_arg? ((nl_arg>n_arg)? &sargnull: sargsave+nl_arg): (sarg))
+ #define SargPP (nl_arg? ((nl_arg>n_arg)? &sargnull: sargsave+nl_arg): (sarg++))
+ #else
+ /* damn blasted SCO Xenix 286 2.2 compiler is busted */
+ #define Sarg \
+ (nl_arg? crippled_Sarg(nl_arg, n_arg, &sargnull, sargsave): (sarg))
+ #define SargPP \
+ (nl_arg? crippled_Sarg(nl_arg, n_arg, &sargnull, sargsave): (sarg++))
+ static STR **crippled_Sarg(nl_arg, n_arg, asargnull, sargsave)
+ STR **asargnull, **sargsave;
+ {
+ if (nl_arg > n_arg) return asargnull;
+ return sargsave+nl_arg;
+ }
+ #endif
void
do_sprintf(str,len,sarg)
register STR *str;
***************
*** 791,802 ****
int xlen;
double value;
char *origs;
str_set(str,"");
! len--; /* don't count pattern string */
origs = t = s = str_get(*sarg);
send = s + (*sarg)->str_cur;
! sarg++;
for ( ; ; len--) {
if (len <= 0 || !*sarg) {
sarg = &sargnull;
--- 807,821 ----
int xlen;
double value;
char *origs;
+ STR **sargsave;
+ int n_arg, nl_arg;
str_set(str,"");
! n_arg = --len; /* don't count pattern string */
origs = t = s = str_get(*sarg);
send = s + (*sarg)->str_cur;
! sargsave = sarg++;
!
for ( ; ; len--) {
if (len <= 0 || !*sarg) {
sarg = &sargnull;
***************
*** 805,810 ****
--- 824,834 ----
for ( ; t < send && *t != '%'; t++) ;
if (t >= send)
break; /* end of format string, ignore extra args */
+ if (t+2 < send && isdigit(t[1]) && t[2] == '$') {
+ nl_arg = t[1] - '0';
+ *(t+=2) = '%';
+ } else
+ nl_arg = 0;
f = t;
*buf = '\0';
xs = buf;
***************
*** 828,834 ****
case 'c':
ch = *(++t);
*t = '\0';
! xlen = (int)str_gnum(*(sarg++));
if (strEQ(f,"%c")) { /* some printfs fail on null chars */
*xs = xlen;
xs[1] = '\0';
--- 852,858 ----
case 'c':
ch = *(++t);
*t = '\0';
! xlen = (int)str_gnum(*(SargPP));
if (strEQ(f,"%c")) { /* some printfs fail on null chars */
*xs = xlen;
xs[1] = '\0';
***************
*** 846,854 ****
ch = *(++t);
*t = '\0';
if (dolong)
! (void)sprintf(xs,f,(long)str_gnum(*(sarg++)));
else
! (void)sprintf(xs,f,(int)str_gnum(*(sarg++)));
xlen = strlen(xs);
break;
case 'X': case 'O':
--- 870,878 ----
ch = *(++t);
*t = '\0';
if (dolong)
! (void)sprintf(xs,f,(long)str_gnum(*(SargPP)));
else
! (void)sprintf(xs,f,(int)str_gnum(*(SargPP)));
xlen = strlen(xs);
break;
case 'X': case 'O':
***************
*** 857,863 ****
case 'x': case 'o': case 'u':
ch = *(++t);
*t = '\0';
! value = str_gnum(*(sarg++));
if (dolong)
(void)sprintf(xs,f,U_L(value));
else
--- 881,887 ----
case 'x': case 'o': case 'u':
ch = *(++t);
*t = '\0';
! value = str_gnum(*(SargPP));
if (dolong)
(void)sprintf(xs,f,U_L(value));
else
***************
*** 867,885 ****
case 'E': case 'e': case 'f': case 'G': case 'g':
ch = *(++t);
*t = '\0';
! (void)sprintf(xs,f,str_gnum(*(sarg++)));
xlen = strlen(xs);
break;
case 's':
ch = *(++t);
*t = '\0';
! xs = str_get(*sarg);
! xlen = (*sarg)->str_cur;
if (*xs == 'S' && xs[1] == 't' && xs[2] == 'B'
&& xlen == sizeof(STBP) && strlen(xs) < xlen) {
STR *tmpstr = Str_new(24,0);
! stab_fullname(tmpstr, ((STAB*)(*sarg))); /* a stab value! */
sprintf(tokenbuf,"*%s",tmpstr->str_ptr);
/* reformat to non-binary */
xs = tokenbuf;
--- 891,909 ----
case 'E': case 'e': case 'f': case 'G': case 'g':
ch = *(++t);
*t = '\0';
! (void)sprintf(xs,f,str_gnum(*(SargPP)));
xlen = strlen(xs);
break;
case 's':
ch = *(++t);
*t = '\0';
! xs = str_get(*Sarg);
! xlen = (*Sarg)->str_cur;
if (*xs == 'S' && xs[1] == 't' && xs[2] == 'B'
&& xlen == sizeof(STBP) && strlen(xs) < xlen) {
STR *tmpstr = Str_new(24,0);
! stab_fullname(tmpstr, ((STAB*)(*Sarg))); /* a stab value! */
sprintf(tokenbuf,"*%s",tmpstr->str_ptr);
/* reformat to non-binary */
xs = tokenbuf;
***************
*** 886,892 ****
xlen = strlen(tokenbuf);
str_free(tmpstr);
}
! sarg++;
if (strEQ(f,"%s")) { /* some printfs fail on >128 chars */
break; /* so handle simple case */
}
--- 910,916 ----
xlen = strlen(tokenbuf);
str_free(tmpstr);
}
! (void) SargPP;
if (strEQ(f,"%s")) { /* some printfs fail on >128 chars */
break; /* so handle simple case */
}
***************
*** 899,906 ****
}
/* end of switch, copy results */
*t = ch;
STR_GROW(str, str->str_cur + (f - s) + len + 1);
! str_ncat(str, s, f - s);
str_ncat(str, xs, xlen);
s = t;
break; /* break from for loop */
--- 923,931 ----
}
/* end of switch, copy results */
*t = ch;
+ if (nl_arg) *f = '$';
STR_GROW(str, str->str_cur + (f - s) + len + 1);
! str_ncat(str, s, f - s - (nl_arg ? 2 : 0));
str_ncat(str, xs, xlen);
s = t;
break; /* break from for loop */
--
Ronald Khoo <ronald@robobar.co.uk> +44 81 991 1142 (O) +44 71 229 7741 (H)lwall@jpl-devvax.JPL.NASA.GOV (Larry Wall) (02/21/91)
In article <1991Feb11.113551.3857@robobar.co.uk> ronald@robobar.co.uk (Ronald S H Khoo) writes: : [ Yes, line-eater, this is *Yet* another feature request ] : : I need nl_printf() -- my boss won't let me use perl without it. : (We have lots of foreign customers, and they seem to want reports : written in a language that they can understand :-( ) : : Is there any chance of adding a position independent sprintf() to perl? : Pretty please ? With a lump of sugar on top ? : : A simple %<digit>$format a'la X/Open nl_sprintf() where <digit> from : 1 to 9 specifies which parameter (plus corresponding nl_printf()) would be : adequate. I've actually hacked do_sprintf to recognise and obey this : format (diffs below) but I guess it really needs to be a separately named : nl_{s,}printf()... (which nevertheless is meant to work with non-position : specified args as well, to help with sanity...) : : Anyone got any better ideas ? Any chance of some "Official" solution ? It seems that it's fairly easy to write a subroutine to do this: #!/usr/bin/perl sub nl_sprintf { local($f) = $_[0]; local(@ix); local($ix) = 1; $f =~ s/%(\d\$)?([-+ #\d.]*[\w%])/push(@ix,$1||$ix++) if $2 ne '%';"%$2"/eg; sprintf($f, @_[@ix]); } print &nl_sprintf('%s %s %s'."\n", "one", "two", "three"); print &nl_sprintf('%3$s %2$s %1$s'."\n", "one", "two", "three"); print &nl_sprintf('%1$s %2$s %3$s'."\n", "one", "two", "three"); print &nl_sprintf('%3$s %2$s %s'."\n", "one", "two", "three"); prints one two three three two one one two three three two one I'd probably choose some other character than $ to mark position selectors, though, so that I could use double-quoted strings without backwacking every $. Maybe :. Larry