File: Fromdeb.pm

package info (click to toggle)
alien 6.54
  • links: PTS
  • area: main
  • in suites: potato
  • size: 364 kB
  • ctags: 62
  • sloc: perl: 974; makefile: 117; sh: 8
file content (131 lines) | stat: -rw-r--r-- 3,143 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
#!/usr/bin/perl
#
# Package for converting from a .deb file.

package From::deb;

use strict;

# Global variable initialization.

# This is set to 1 if dpkg-deb is in the path.
my $dpkg_deb=undef;
my $dir;
foreach $dir (split(/:/,$ENV{PATH})) {
  if (-x "$dir/dpkg-deb") {
    $dpkg_deb=1;
    last;
  }
}

# Query a deb file for fields, and return a hash of the fields found.
# Pass the filename of the deb file to query.
sub GetFields { my ($self,$file)=@_;
	my %fields;
	
	# Extract the control file from the deb file.
	my @control;
	if ($dpkg_deb) {
		@control = `dpkg-deb --info $file control`;
	}
	else {
		@control = `ar p $file control.tar.gz | tar Oxzf - control`;
	}

	# Parse control file and extract fields.
	my $i=0;
	while ($i<=$#control) {
		$_ = $control[$i];
		chomp;
		$fields{NAME} = $1 if (/^Package:\s*(.+)/i);
		$fields{VERSION} = $1 if (/^Version:\s*(.+)/i);
		$fields{ARCH} = $1 if (/^Architecture:\s*(.+)/i);
		$fields{MAINTAINER} = $1 if (/^Maintainer:\s*(.+)/i);
		$fields{DEPENDS} = $1 if (/^Depends:\s*(.+)/i);
		$fields{REQUIRES} = $1 if (/^Requires:\s*(.+)/i);
		$fields{GROUP} = $1 if (/^Section:\s*(.+)/i);
		if (/^Description:\s*(.+)/i) {
			$fields{SUMMARY} = "$1";
			$i++;
				while (($i<=$#control) && ($control[$i])) {
				$control[$i] =~ s/^ //g; #remove leading space
				$control[$i] = "\n" if ($control[$i] eq ".\n");
				$fields{DESCRIPTION}.=$control[$i];
				$i++;
			}
			$i--;
		}
		$i++;
	}

	$fields{COPYRIGHT}="see /usr/share/doc/$fields{NAME}/copyright";
	$fields{GROUP}="unknown" if (!$fields{GROUP});
	$fields{DISTRIBUTION}="Debian";
	if ($fields{VERSION} =~ /(.+)-(.+)/) {
		$fields{VERSION} = $1;
		$fields{RELEASE} = $2;
	} else {
		$fields{RELEASE} = '1';
	}
	# Just get rid of epochs for now.
	if ($fields{VERSION} =~ /\d+:(.*)/) { 
		$fields{VERSION} = $1;
	}

	# Read in the list of conffiles, if any.
	if ($dpkg_deb) {
		$fields{CONFFILES}=`dpkg-deb --info $file conffiles 2>/dev/null`;
	}
	else {
		$fields{CONFFILES}=
			`ar p $file control.tar.gz | tar Oxzf - conffiles 2>/dev/null`;
	}

	# Read in the list of all files.
	# Note that tar doesn't supply a leading `/', so we have to add that.
	$fields{FILELIST}=undef;
	if ($dpkg_deb) {
		my $fn;
		foreach $fn (`dpkg-deb --fsys-tarfile $file | tar tf -`) {
			$fields{FILELIST}.="/$fn";
		}
	}
	else {
		my $fn;
		foreach $fn (`ar p $file data.tar.gz | tar tzf -`) {
			$fields{FILELIST}.="/$fn";
		}
	}

	if ($main::scripts) {
		# Read in the scripts, if any.
		my $field;
		for $field ('postinst', 'postrm', 'preinst', 'prerm') {
			if ($dpkg_deb) {
				$fields{uc($field)}=`dpkg-deb --info $file $field 2>/dev/null`;
			}
			else {
				$fields{uc($field)}=
					`ar p $file control.tar.gz | tar Oxzf - $field 2>/dev/null`;
			}
		}
	}

	$fields{RELEASE}++ unless $main::keep_version;

	return %fields;
}

# Handles unpacking of debs.
sub Unpack { my ($self,$file,%fields)=@_;
	if ($dpkg_deb) {
		Alien::SafeSystem ("(cd ..;dpkg-deb -x $file $fields{NAME}-$fields{VERSION})",
			"Error unpacking $file\n");
	}
	else {
		Alien::SafeSystem ("(cd ..;ar p $file data.tar.gz) | tar zxpf -",
			"Error unpacking $file\n");
	}
}

1