#!/usr/bin/perl -w
use strict;

# fpkg -- Package Tool Wrapper for FreeBSD
# ver 0.2
# 2006/01/24
#
# Yuki SHIMAZU 
# y.shimazu@nifty.com
# http://www.shimazu.org/fpkg/
#
# Copyright (C) 2006 Yuki SHIMAZU. All Rights Reserved.

# Files:
# /usr/local/bin/fpkg
# /var/fpkg/INDEX_<version>_<ftphost>

# ----------------------------------------

# Please rewrite for your environment.
my $ftphost = "ftp.jp.freebsd.org";

# ----------------------------------------

my $indexdir = "/var/fpkg";
my $indexprefix = "INDEX_";
my $uid = $<;

my $usage = <<EOF;
Usage: fpkg [list|info] package name
       fpkg [search|allsearch] package name [-v|-vv]
       fpkg [update]
EOF

chomp (my $arch  = `uname -m`);
chomp (my $osver = `uname -r | tr "[A-Z]" "[a-z]"`);

if ( $^O !~ /freebsd/i ) { print "Error: This script runs on FreeBSD only.\n"; exit 1; }
if ( $#ARGV == -1 ) { print $usage; exit 1; }

my $mode = shift;
my $vflag = 0;
my @pkgnames;
for (my $i=0; $i<=$#ARGV; $i++) {
	if ($ARGV[$i] =~ /^-v$/) {
		$vflag = 1;
	} elsif ($ARGV[$i] =~ /^-vv$/) {
		$vflag = 2;
	} else {
		push(@pkgnames,$ARGV[$i]);
	}
}

if( ! eval "&$mode" ) { print $usage; exit 1; }

# ----------------------------------------

#
# Display a list of files in package (list)
# Intalled package only
#
sub list {
	# [-x] option ... use regular expression
	system "pkg_info -x -L @pkgnames";
	exit;
}

#
# Display a package information (info)
# Intalled package only
#
sub info {
	# [-x] option ... use regular expression
	system "pkg_info -x @pkgnames";
	exit;
}

#
# Install package from ftp server (install)
# No need to specify version of package
# Version auto recognition
#
sub install {
	if ($uid != 0) { print "Error: This script should be executed by root.\n"; exit 1; }

	my @urls;
	foreach(@pkgnames) {
		push(@urls,"ftp://$ftphost/pub/FreeBSD/ports/$arch/packages-$osver/Latest/$_.tbz");
	}

	system "pkg_add -v @urls";

	if ($?) {
		print "failed: fpkg install @pkgnames\n";
		exit 1;
	} else {
		print "completed: fpkg install @pkgnames\n";
	}
	exit;
}

#
# Fetching package list (update)
#
sub update {
	if ($uid != 0) { print "Error: This script should be executed by root.\n"; exit 1; }

	my $indexpath = $indexdir . "/" . $indexprefix . $osver . "_" . $ftphost;
	if( ! -e $indexdir || ! -d $indexdir ) {
		system "mkdir $indexdir";
		print "created: $indexdir\n";
	}

	# ex.
	# ftp://ftp.jp.FreeBSD.org/pub/FreeBSD/ports/packages/INDEX
	# ftp://ftp.jp.FreeBSD.org/pub/FreeBSD/ports/i386/packages-6-stable/INDEX
	my $url = "ftp://$ftphost/pub/FreeBSD/ports/$arch/packages-$osver/INDEX";

	system "ftp -o $indexpath $url";

	if ($?) {
		print "failed: fpkg update\n";
		exit 1;
	} else {
		print "completed: fpkg update\n";
	}
	exit;
}

#
# Package name search on package list (search)
#
sub search {
	if ( ! @pkgnames ) { print $usage; exit 1; }

	my $indexpath = $indexdir . "/" . $indexprefix . $osver . "_" . $ftphost;
	if ( ! -e $indexpath ) { print "Error: You need to execute \"fpkg update\".\n"; exit 1; }

	my $searchkey = join("|",@pkgnames);
	open(IN,$indexpath);
	while(<IN>){
		chomp;
		my ($name,$ports,undef,$desc,undef,undef,undef,undef,undef,$www,undef,undef) = split(/\|/,$_);

		if ( $name =~ /$searchkey/i ) {
			if( $vflag == 1 ) {
				print "$name ($ports) - $desc\n";
			} elsif ( $vflag == 2 ) {
				print "[ $name ]\nports: $ports\ndesc:  $desc\nwww:   $www\n";
			} else {
				print "$name\n";
			}
		}
	}
	close(IN);
	exit;
}

#
# All text search on package list (allsearch)
#
sub allsearch {
	if ( ! @pkgnames ) { print $usage; exit 1; }

	my $indexpath = $indexdir . "/" . $indexprefix . $osver . "_" . $ftphost;
	if ( ! -e $indexpath ) { print "Error: You need to execute \"fpkg update\".\n"; exit; }

	my $searchkey = join("|",@pkgnames);
	open(IN,$indexpath);
	while(<IN>){
		chomp;
		my ($name,$ports,undef,$desc,undef,undef,undef,undef,undef,$www,undef,undef) = split(/\|/,$_);

		if ( $_ =~ /$searchkey/i ) {
			if( $vflag == 1 ) {
				print "$name ($ports) - $desc\n";
			} elsif ( $vflag == 2 ) {
				print "[ $name ]\nports: $ports\ndesc:  $desc\nwww:   $www\n";
			} else {
				print "$name\n";
			}
		}
	}
	close(IN);
	exit;
}