view release on metacpan or  search on metacpan

perllib/Arch/Inventory.pm  view on Meta::CPAN

		type     => DIRECTORY,
		path     => '',
		id       => undef,
		id_type  => undef,
		children => _build_inv_tree(0, @inv_entries),
	};

	my $self = {
		directory => $dir,
		root      => $root,
	};

	return bless $self, $class;
}

sub directory ($) {
	my $self = shift;

	return $self->{directory};
}

sub get_root_entry ($) {
	my $self = shift;

	return $self->{root};
}

sub get_entry ($@) {
	my $self = shift;
	my @path = @_;

	@path = split /\//, $path[0]
		if @path == 1;

	my $entry = $self->get_root_entry;
	while (@path && defined $entry && ($entry->{type} eq DIRECTORY)) {
		$entry = $entry->{children}->{shift @path};
	}

	return @path ? undef : $entry;
}

sub get_listing ($) {
	my $self = shift;

	my $str;
	$self->foreach(sub {
		return unless $_[0]->{path};

		$str .= Arch::Inventory->to_string($_[0]);
		$str .= "\n";
	});

	return $str;
}

sub annotate_fs ($;$) {
	my $self = shift;

	if (@_) {
		$_[0]->{stat} = [ lstat("$self->{directory}/$_[0]->{path}") ];
		$_[0]->{symlink} = readlink("$self->{directory}/$_[0]->{path}")
			if $_[0]->{type} eq SYMLINK;
	} else {
		$self->foreach(sub { $self->annotate_fs($_[0]) });
	}
}

*annotate_stat = *annotate_fs; *annotate_fs = *annotate_fs;

sub foreach ($$) {
	my $self = shift;
	my $sub  = shift;
	my $root = shift || $self->get_root_entry;

	$sub->($root);

	if ($root->{type} eq DIRECTORY) {
		foreach my $child (sort keys %{$root->{children}}) {
			$self->foreach($sub, $root->{children}->{$child});
		}
	}
}

sub dump ($) {
	my $self = shift;

	require Data::Dumper;
	my $dumper = Data::Dumper->new([$self->get_root_entry]);
	$dumper->Sortkeys(1) if $dumper->can('Sortkeys');
	$dumper->Quotekeys(0);
	$dumper->Indent(1);
	$dumper->Terse(1);

	return $dumper->Dump;
}

sub to_string ($$) {
	my $class = shift;
	my $entry = shift;

	return sprintf("%s%s %s %s\t%s",
		$entry->{category},
		$entry->{untagged} ? '?' : ' ',
		$entry->{type},
		$entry->{path},
		$entry->{id} ? $entry->{id} : '???',
	);
}

# this assumes depth first ordering of @items
sub _build_inv_tree ($@) {
	my ($cut, @entries) = @_;

	my %toplevel = ();
	while (@entries) {
		my $child = shift @entries;
		my $name  = substr($child->{path}, $cut);

		die("invalid name $name; input not in correct order\n")
			if $name =~ m!/!;