Plan 9 from Bell Labs’s /usr/web/sources/contrib/yk/lab/perl9p/Plan9str.pl

Copyright © 2021 Plan 9 Foundation.
Distributed under the MIT License.
Download the Plan 9 distribution.


# Copyright © 2016 by Yaroslav Kolomiiets
package Plan9;

sub vlongstrx($) {
	local $_ = shift;
	my ($lo, $hi);

	($lo, $hi) = ($_, 0);
	if($lo == ~0){
		$hi = ~0;
	}
	return sprintf("%.8lx%.8lx", $hi, $lo);
}

sub vlongstrd($) {
	local $_ = shift;
	my ($lo, $hi);

	($lo, $hi) = ($_, 0);
	if($lo == ~0){
		$hi = ~0;
	}
	sprintf("%lld", $hi<<32|$lo);
}

sub qidstr(\%) {
	local $_ = shift;
	my ($p, $t);

	$p = vlongstrx($_->{path});
	$t = qidtype($_->{type});
	return sprintf("(%s %lu %s)", $p, $_->{vers}, $t);
}

sub dirstr(\%) {
	my $d = shift;
	my $l;

	$l = vlongstrd($d->{length});
	return sprintf("'%s' '%s' '%s' '%s' q %s m %lo at %ld mt %ld l %s t %d d %d",
		@{$d}{qw(name uid gid muid)}, qidstr(%{$d->{qid}}),
		@{$d}{qw(mode atime mtime)}, $l, @{$d}{qw(type dev)});
}

sub qidtype($) {
	my $t = shift;
	my $s = '';

	$s .= 'd' if($t & QTDIR);
	$s .= 'a' if($t & QTAPPEND);
	$s .= 'l' if($t & QTEXCL);
	$s .= 'M' if($t & QTMOUNT);
	$s .= 'A' if($t & QTAUTH);
	$s .= 't' if($t & QTTMP);
	return $s;
}

sub fcallstr(\%) {
	my $f = shift;
	my ($i, $s, $nwname, $nwqid, $fntab, $fn);
	local $_;

	$fntab = {		
		&Tversion =>	sub {
			sprintf("Tversion tag %u msize %u version '%s'", @$f{'tag','msize','version'})
		},
		&Rversion =>	sub {
			sprintf("Rversion tag %u msize %u version '%s'", @$f{'tag','msize','version'})
		},
		&Tauth =>	sub {
			sprintf("Tauth tag %u afid %d uname %s aname %s",
				@{$f}{'tag','afid','uname','aname'})
		},
		&Rauth =>	sub { sprintf("Rauth tag %u aqid %s", $f->{tag}, qidstr(%{$f->{aqid}})) },
		&Rerror =>	sub { sprintf("Rerror tag %u ename '%s'", @{$f}{'tag','ename'}) },
		&Tflush =>	sub { sprintf("Tflush tag %u oldtag %u", @{$f}{'tag','oldtag'}) },
		&Rflush =>	sub { sprintf("Rflush tag %u", $f->{'tag'}) },
		&Tattach =>	sub { sprintf("Tattach tag %u fid %d afid %d uname '%s' aname '%s'",
			@{$f}{'tag','fid', 'afid','uname','aname'}) },
		&Rattach =>	sub { sprintf("Rattach tag %u qid %s", ${$f}{tag}, qidstr(%{$f->{qid}})) },
		&Twalk =>	sub {
			$nwname = @{$f->{wname}};
			$s = sprintf("Twalk tag %u fid %d newfid %d nwname %d",
				@{$f}{'tag','fid','newfid'}, $nwname);
			for($i=0; $i<$nwname; $i++){
				$s .= sprintf(" %d:%s", $i, $f->{wname}[$i]);
			}
			$s
		},
		&Rwalk =>	sub {
			$nwqid = @{$f->{wqid}};
			$s = sprintf("Rwalk tag %u nwqid %d", ${$f}{tag}, $nwqid);
			for($i=0; $i<$nwqid; $i++){
				$s .= sprintf(" %d:%s", $i, qidstr(%{$f->{wqid}[$i]}));
			}
			$s
		},
		&Topen =>	sub { sprintf("Topen tag %u fid %d mode %d", @{$f}{'tag', 'fid', 'mode'}) },
		&Ropen =>	sub { sprintf("Ropen tag %u qid %s iounit %u", $f->{tag}, qidstr(%{${$f}{qid}}), $f->{iounit}) },
		&Tcreate =>	sub { sprintf("Tcreate tag %u fid %d name %s perm %o mode %d", @{$f}{'tag','fid','name','perm','mode'}) },
		&Rcreate =>	sub { sprintf("Rcreate tag %u qid %s iounit %u", ${$f}{tag}, qidstr(%{${$f}{qid}}), ${$f}{iounit}) },
		&Tread =>	sub { 
sprintf("Tread tag %u fid %d offset %s count %u", @{$f}{'tag','fid'}, vlongstrd($f->{offset}), $f->{'count'}) },
		&Rread =>	sub { sprintf("Rread tag %u count %u ...", $f->{tag}, length($f->{data})) },
		&Twrite =>	sub { sprintf("Twrite tag %u fid %d offset %s count %u ...", @{$f}{'tag','fid'}, vlongstrd($f->{offset}), length($f->{data})) },
		&Rwrite =>	sub { sprintf("Rwrite tag %u count %u", @{$f}{'tag','count'}) },
		&Tclunk =>	sub { sprintf("Tclunk tag %u fid %d", @{$f}{'tag','fid'}) },
		&Rclunk =>	sub { sprintf("Rclunk tag %u", ${$f}{tag}) },
		&Tremove =>	sub { sprintf("Tremove tag %u fid %d", @{$f}{'tag','fid'}) },
		&Rremove =>	sub { sprintf("Rremove tag %u", ${$f}{tag}) },
		&Tstat =>	sub { sprintf("Tstat tag %u fid %d", @{$f}{'tag','fid'}) },
		&Rstat =>	sub { sprintf("Rstat tag %u %s", ${$f}{tag}, dirstr(%{$f->{stat}})) },
		&Twstat =>	sub { sprintf("Twstat tag %u %s", ${$f}{tag}, dirstr(%{$f->{stat}})) },
		&Rwstat =>	sub { sprintf("Rwstat tag %u", ${$f}{tag}) },
	};

	$fn = $fntab->{$f->{type}};
	if(defined $fn){
		$s = &$fn($f);
	}else{
		$s = sprintf("unknown type %d", $_);
	}
	return $s;
}
1;

Bell Labs OSI certified Powered by Plan 9

(Return to Plan 9 Home Page)

Copyright © 2021 Plan 9 Foundation. All Rights Reserved.
Comments to [email protected].