/usr/local/CPAN/Lufs/Lufs/NetHood.pm


package Lufs::NetHood;

use Fcntl qw/:mode/;

use strict;

sub init {
	my $self = shift;
	$self->{config} = shift;
	$self->{config}{smbdir} ||= './../../../campus';
	$self->{config}{netdb} ||= '/var/cache/nethood.pd';
	$self->read_db;
	1;
}

sub read_db {
	my $self = shift;
	open(DB,"< $self->{config}{netdb}") or return;
	my $ret;
	{
		my $VAR1;
		eval join('', <DB>);
		if ($@) {
			print STDERR "ERROR READING DB: $@\n";
			$ret = 0;
		}
		elsif (ref($VAR1)&& keys%{$VAR1}) {
			$self->{net} = $VAR1;
			$ret = 1;
		}
		$self->{lastdb} = -C $self->{config}{netdb};
	}
	close DB;
	$ret;
}

sub db_updated {
	my $self = shift;
	if (-C $self->{config}{netdb} != $self->{lastdb}) {
		print STDERR "db updated, reload\n";
		return 1;
	} 0
}


sub readdir {
	my $self = shift;
	my $dir = shift;
	if ($self->db_updated) { $self->read_db }
	$dir =~ s{^(/)(?:\.?(?:\/|$)?)}{$1};
	if ($dir eq '/') {
		push @{$_[-1]}, keys %{$self->{net}};
		$self->{abs} = '';
		return 1;
	}
	$self->{_abs} = $dir;
	my $host = (split/\//, $dir)[1];
	push @{$_[-1]}, $self->list_shares($host);
	return 1;
}

sub lookup {
	my $self = shift;
	my $name = shift;
	my $relstat = $name;
	if ($relstat !~ /^\//) {
		$relstat =~ s{^\./*}{};
		$relstat = $self->{_abs}.'/'.$relstat;
	}
	elsif ($relstat eq '/.') { return "" }
	$relstat =~ s{/+}{/}g;
	$relstat =~ s{/$}{};
	$relstat =~ s{^/}{};
	return $relstat;
}

sub _drr {
	my $ref = shift;
	$ref->{f_ino} = 1;
	$ref->{f_mode} = S_IFDIR | 0755;
	$ref->{f_nlink} = 1;
	$ref->{f_uid} = 0;
	$ref->{f_gid} = 0;
	$ref->{f_rdev} = 0;
	$ref->{f_size} = 2048;
	$ref->{f_atime} = time;
	$ref->{f_mtime} = time;
	$ref->{f_ctime} = time;
	$ref->{f_blksize} = 512;
	$ref->{f_blocks} = 4;
}

sub _lnk {
	my $ref = shift;
	$ref->{f_ino} = int(rand(10000));
	$ref->{f_mode} = 41471;
	$ref->{f_nlink} = 1;
	$ref->{f_uid} = 1;
	$ref->{f_gid} = 1;
	$ref->{f_rdev} = 0;
	$ref->{f_atime} = time;
	$ref->{f_mtime} = time;
	$ref->{f_ctime} = time;
	$ref->{f_blksize} = 512;
	$ref->{f_blocks} = 8;
}

sub stat {
	my $self = shift;
	my $raw = shift;
	my $node = $self->lookup($raw);	
	if ($node eq '') {
		# DIR
		_drr($_[-1]);
		return 1;
	}
	elsif ($node =~ m/\// == 1) {
		my ($host, $share) = split/\//, $node;
		print STDERR "SHARE='$share', HOST='$host', RETURN SYMLINK\n";
		# SYMLINK
		_lnk($_[-1]);
		my $target;
		unless ($self->readlink($raw, $target)) {
			$_[-1]->{f_size} = 0;
		} else {
			$_[-1]->{f_size} = length($target);
		}
		return 1;
	}
	# DIR
	_drr($_[-1]);
	return 1;
}

sub readlink {
	my $self = shift;
	my ($host, $share) = split/\//, $self->lookup(shift);
	my $ip = $self->get_ip($host);
	my $str = sprintf "%s/${host}${ip}_${share}", $self->{config}{smbdir};
	$_[0] = $str;
	return length($str);
}

sub list_shares { 
	my $self = shift;
	if ($self->db_updated) { $self->read_db }
	my $s = $self->{net}{uc($_[0])} or return;
	eval {@{$s->{shares}} };
}

sub get_ip {
	my $self = shift;
	my $ip = $self->{net}{$_[0]}{ip};
	if (length$ip) { $ip = "_$ip" }
	$ip
}

1;