#!/usr/pkg/bin/perl

=begin metadata

Name: printf
Description: format and print data
Author: Tom Christiansen, tchrist@perl.com
License: perl

=end metadata

=cut


# printf - format and print data

use strict;

use File::Basename qw(basename);

use constant EX_SUCCESS => 0;
use constant EX_FAILURE => 1;

my $Program = basename($0);

unless (@ARGV) {
    warn "usage: $Program format [argument ...]\n";
    exit EX_FAILURE;
}

my @fmt;
my $format = shift;
exit EX_SUCCESS unless (length $format);
@ARGV = () if (parse_fmt() == 0);
do {
    foreach my $part (@fmt) {
        if ($part->[0] eq 'str') {
            print escape_str($part->[1]);
    } elsif ($part->[0] eq 'ifmt') {
        my $fmt = $part->[1];
        my $arg = shift;
	$arg = 0 unless defined $arg;
	if ($arg =~ m/\A0x/i) {
            $arg = hex $arg;
	}
        printf $fmt, $arg;
    } elsif ($part->[0] eq 'sfmt') {
        my $fmt = $part->[1];
        my $arg = shift;
	$arg = '' unless defined $arg;
        printf $fmt, $arg;
    } else {
        die "internal error";
    }
    }
} while (@ARGV);
exit EX_SUCCESS;

sub parse_fmt {
    my $f = $format;
    $f =~ s/\%c/\%\.1s/g; # standard printf: %c == 1st char

    my $i = 0;
    while (length $f) {
        if ($f =~ s/\A([^%]+)//) {
            push @fmt, [ 'str', $1 ];
        } elsif ($f =~ s/\A\%\%//) {
            push @fmt, [ 'str', '%%' ];
        } elsif ($f =~ s/\A(\%[0-9\.\-]*s)//) {
            push @fmt, [ 'sfmt', $1 ];
            $i++;
        } elsif ($f =~ s/\A(\%[0-9\.\-]*[diouXx])//) {
            push @fmt, [ 'ifmt', $1 ];
            $i++;
        } elsif ($f =~ s/\A(\%[0-9\.\-]*[a-zA-Z])//) {
            push @fmt, [ 'str', $1 ]; # unsupported
        } else {
            if ($f =~ m/\A[^\%]*(\%[\S]+)/) {
                warn "$Program: invalid format: '$1'\n";
                exit EX_FAILURE;
            }
            die "internal error";
        }
    }
    return $i;
}

sub oct2char {
    my $str = shift;
    my $n = oct($str) & 255;
    return chr($n);
}

sub hex2char {
    my $str = shift;
    my $n = hex($str) & 255;
    return chr($n);
}

sub escape_str {
    my $str = shift;
    $str =~ s/\\a/\a/g;
    $str =~ s/\\b/\b/g;
    $str =~ s/\\f/\f/g;
    $str =~ s/\\n/\n/g;
    $str =~ s/\\r/\r/g;
    $str =~ s/\\t/\t/g;
    $str =~ s/\\v/\x0b/g;
    $str =~ s/\\([0-7]{1,3})/oct2char($1)/eg;
    $str =~ s/\\x([0-9a-fA-F]{1,2})/hex2char($1)/eg;
    return $str;
}

__END__

=head1 NAME

printf - format and print data

=head1 SYNOPSIS

B<printf> I<format> [ I<argument> ... ]

=head1 DESCRIPTION

The B<printf> command uses the first argument as the format that describes
how to print the remaining arguments.  Unlike the standard
printf(1) command, this one uses the Perl version.
See L<perlfunc/sprintf> for details.

=head1 SEE ALSO

printf(3), L<perlfunc/sprintf>

=head1 AUTHOR

Tom Christiansen, I<tchrist@perl.com>.

=head1 COPYRIGHT and LICENSE

This program is copyright (c) Tom Christiansen 1999.

This program is free and open software. You may use, modify, distribute,
and sell this program (and any modified variants) in any way you wish,
provided you do not restrict others from doing the same.
