pts/perl/common.pl

# Configuration and some common code

use vars qw($pts_dir $spool_dir $conf_template $db_filename $db_tags_filename
            $sendmail $sources $pts_email @available_tags @default_tags
            %db_content $db %db_tags_content $db_tags
            %bin2src %src $open_count);

# Configuration variables
$pts_dir = "/org/packages.qa.debian.org";
$spool_dir = "$pts_dir/spool";
$conf_template = "$pts_dir/etc/conf_tpl.txt";
$db_filename = "$pts_dir/db/subscription.db";
$db_tags_filename = "$pts_dir/db/tags.db";
$sendmail = '/usr/sbin/sendmail -f owner@packages.qa.debian.org';
$sources = "/org/bugs.debian.org/etc/indices/sources";
$pts_email = 'pts@qa.debian.org';
@available_tags = qw(default bts bts-control cvs summary ddtp
                     upload-source upload-binary katie-other);
@default_tags = qw(default bts bts-control summary upload-source katie-other);

# Global variables
%db_content = ();
$db = undef;
%db_tags_content = ();
$db_tags = undef;
%bin2src = ();
%src = ();
$open_count = 0;

# Common code
sub open_db_write {
    $DB_BTREE->{'flags'} = R_DUP;
    if ($open_count <= 0) {
        $db = tie %db_content, "DB_File", $db_filename, O_RDWR|O_CREAT,
                      0660, $DB_BTREE
            or die "Can't open database $db_filename : $!\n";
        $db_tags = tie %db_tags_content, "DB_File", $db_tags_filename,
                    O_RDWR|O_CREAT, 0660, $DB_HASH
            or die "Can't open database $db_tags_filename : $!\n";
    }
    $open_count++;
}
sub open_db_read {
    $DB_BTREE->{'flags'} = R_DUP;
    if ($open_count <= 0) {
        if (-f $db_filename and -f $db_tags_filename) {
            $db = tie %db_content, "DB_File", $db_filename, O_RDONLY,
                          0660, $DB_BTREE
                or die "Can't open database $db_filename : $!\n";
            $db_tags = tie %db_tags_content, "DB_File", $db_tags_filename,
                        O_RDONLY, 0660, $DB_HASH
                or die "Can't open database $db_tags_filename : $!\n";
        } else {
            open_db_write();
        }
    }
    $open_count++;
}
sub close_db {
    $open_count--;
    if ($open_count <= 0) {
        undef $db;
        untie %db_content;
    }
}
sub subscribe {
    my ($address, $package) = @_;
    open_db_write();
    my @emails = $db->get_dup($package);
    my $found = 0;
    foreach (@emails) {
        $found = 1 if ($_ eq $address);
    }
    $db_content{$package} = $address if (! $found);
    close_db();
    return ! $found;
}
sub unsubscribe {
    my ($address, $package) = @_;
    my $ok = 1;
    open_db_write();
    if ($db->find_dup($package, $address) == 0) {
        $db->del_dup($package, $address);
    } else {
        $ok = 0;
    }
    close_db();
    return $ok;
}
sub which {
    my ($address) = @_;
    my @l;
    my %seen;
    open_db_read();
    foreach my $p (keys %db_content) {
        next if (exists $seen{$p});
        $seen{$p} = 1;
        if ($db->find_dup($p, $address) == 0) {
            push @l, $p;
        }
    }
    close_db();
    return @l;
}
sub list {
    my ($package) = @_;
    open_db_read();
    my @l = $db->get_dup($package);
    close_db();
    return @l;
}
sub load_sources {
    return if (scalar(keys %bin2src));
    open(SOURCES, "< $sources") || warn "Can't open $sources: $!\n";
    while(defined($_=<SOURCES>)) {
        my ($bin, $comp, $src) = (split(/\s+/));
        $bin2src{lc($bin)} = lc($src);
        $src{lc($src)} = 1;
    }
    close(SOURCES);
}
sub map_package {
    my ($pkg) = @_;
    my ($package, @msg);
    load_sources();
    if (exists $src{$pkg}) {
        $package = $pkg;
    } elsif (exists $bin2src{$pkg}) {
        $package = $bin2src{$pkg};
        push @msg, "$pkg is not a source package. However $package is \n";
        push @msg, "the source package for the $pkg binary package.\n";
        push @msg, "\n";
    } else {
        $package = $pkg;
        push @msg, "$pkg is neither a source package nor a binary package. \n";
        push @msg, "It may be a 'virtual package' or a mistake...\n";
        push @msg, "\n";
    }
    return ($package, @msg);
}
sub available_tags {
    return @available_tags;
}
sub is_valid_tag {
    my ($tag) = @_;
    $tag = lc($tag);
    foreach (available_tags()) {
        return 1 if ($tag eq $_);
    }
    return 0;
}
sub clean_tags {
    my %h;
    foreach (@_) { $h{lc($_)} = 1 }
    return grep { defined($h{$_}) && $h{$_} } available_tags();
}
sub get_default_tags {
    my ($email) = @_;
    $email = lc($email);
    open_db_read();
    my @res;
    if (exists $db_tags_content{$email}) {
        @res = split(/,/, $db_tags_content{$email});
    } else {
        @res = @default_tags;
    }
    close_db();
    return @res;
}
sub set_default_tags {
    my ($email, @tags) = @_;
    open_db_write();
    $db_tags_content{lc($email)} = join(",", clean_tags(@tags));
    close_db();
}
sub get_tags {
    my ($email, $package) = @_;
    $email = lc($email);
    $package = lc($package);
    open_db_read();
    my @res;
    if (exists $db_tags_content{"$email#$package"}) {
        @res = split(/,/, $db_tags_content{"$email#$package"});
    } elsif (exists $db_tags_content{$email}) {
        @res = split(/,/, $db_tags_content{$email});
    } else {
        @res = @default_tags;
    }
    close_db();
    return @res;
}
sub set_tags {
    my ($email, $package, @tags) = @_;
    open_db_write();
    $db_tags_content{lc("$email#$package")} = join(",", clean_tags(@tags));
    close_db();
}

1;
1	hertzog	294	# Configuration and some common code
2
3			use vars qw($pts_dir $spool_dir $conf_template $db_filename $db_tags_filename
4	hertzog	298	$sendmail $sources $pts_email @available_tags @default_tags
5	hertzog	294	%db_content $db %db_tags_content $db_tags
6			%bin2src %src $open_count);
7
8			# Configuration variables
9	hertzog	348	$pts_dir = "/org/packages.qa.debian.org";
10	hertzog	294	$spool_dir = "$pts_dir/spool";
11			$conf_template = "$pts_dir/etc/conf_tpl.txt";
12			$db_filename = "$pts_dir/db/subscription.db";
13			$db_tags_filename = "$pts_dir/db/tags.db";
14			$sendmail = '/usr/sbin/sendmail -f owner@packages.qa.debian.org';
15	hertzog	348	$sources = "/org/bugs.debian.org/etc/indices/sources";
16	hertzog	294	$pts_email = 'pts@qa.debian.org';
17	hertzog	475	@available_tags = qw(default bts bts-control cvs summary ddtp
18	hertzog	295	upload-source upload-binary katie-other);
19	hertzog	298	@default_tags = qw(default bts bts-control summary upload-source katie-other);
20	hertzog	294
21			# Global variables
22			%db_content = ();
23			$db = undef;
24			%db_tags_content = ();
25			$db_tags = undef;
26			%bin2src = ();
27			%src = ();
28			$open_count = 0;
29
30			# Common code
31			sub open_db_write {
32			$DB_BTREE->{'flags'} = R_DUP;
33			if ($open_count <= 0) {
34			$db = tie %db_content, "DB_File", $db_filename, O_RDWR\|O_CREAT,
35			0660, $DB_BTREE
36			or die "Can't open database $db_filename : $!\n";
37			$db_tags = tie %db_tags_content, "DB_File", $db_tags_filename,
38			O_RDWR\|O_CREAT, 0660, $DB_HASH
39			or die "Can't open database $db_tags_filename : $!\n";
40			}
41			$open_count++;
42			}
43			sub open_db_read {
44			$DB_BTREE->{'flags'} = R_DUP;
45			if ($open_count <= 0) {
46	hertzog	295	if (-f $db_filename and -f $db_tags_filename) {
47			$db = tie %db_content, "DB_File", $db_filename, O_RDONLY,
48			0660, $DB_BTREE
49			or die "Can't open database $db_filename : $!\n";
50			$db_tags = tie %db_tags_content, "DB_File", $db_tags_filename,
51			O_RDONLY, 0660, $DB_HASH
52			or die "Can't open database $db_tags_filename : $!\n";
53			} else {
54			open_db_write();
55			}
56	hertzog	294	}
57			$open_count++;
58			}
59			sub close_db {
60			$open_count--;
61			if ($open_count <= 0) {
62			undef $db;
63			untie %db_content;
64			}
65			}
66			sub subscribe {
67			my ($address, $package) = @_;
68			open_db_write();
69			my @emails = $db->get_dup($package);
70			my $found = 0;
71			foreach (@emails) {
72			$found = 1 if ($_ eq $address);
73			}
74			$db_content{$package} = $address if (! $found);
75			close_db();
76			return ! $found;
77			}
78			sub unsubscribe {
79			my ($address, $package) = @_;
80			my $ok = 1;
81			open_db_write();
82			if ($db->find_dup($package, $address) == 0) {
83			$db->del_dup($package, $address);
84			} else {
85			$ok = 0;
86			}
87			close_db();
88			return $ok;
89			}
90			sub which {
91			my ($address) = @_;
92			my @l;
93	hertzog	349	my %seen;
94	hertzog	294	open_db_read();
95			foreach my $p (keys %db_content) {
96	hertzog	349	next if (exists $seen{$p});
97			$seen{$p} = 1;
98	hertzog	294	if ($db->find_dup($p, $address) == 0) {
99			push @l, $p;
100			}
101			}
102			close_db();
103			return @l;
104			}
105			sub list {
106			my ($package) = @_;
107			open_db_read();
108			my @l = $db->get_dup($package);
109			close_db();
110			return @l;
111			}
112			sub load_sources {
113			return if (scalar(keys %bin2src));
114			open(SOURCES, "< $sources") \|\| warn "Can't open $sources: $!\n";
115			while(defined($_=<SOURCES>)) {
116	hertzog	423	my ($bin, $comp, $src) = (split(/\s+/));
117	hertzog	294	$bin2src{lc($bin)} = lc($src);
118			$src{lc($src)} = 1;
119			}
120			close(SOURCES);
121			}
122			sub map_package {
123			my ($pkg) = @_;
124			my ($package, @msg);
125			load_sources();
126			if (exists $src{$pkg}) {
127			$package = $pkg;
128			} elsif (exists $bin2src{$pkg}) {
129			$package = $bin2src{$pkg};
130			push @msg, "$pkg is not a source package. However $package is \n";
131			push @msg, "the source package for the $pkg binary package.\n";
132			push @msg, "\n";
133			} else {
134			$package = $pkg;
135			push @msg, "$pkg is neither a source package nor a binary package. \n";
136			push @msg, "It may be a 'virtual package' or a mistake...\n";
137			push @msg, "\n";
138			}
139			return ($package, @msg);
140			}
141			sub available_tags {
142			return @available_tags;
143			}
144			sub is_valid_tag {
145			my ($tag) = @_;
146			$tag = lc($tag);
147			foreach (available_tags()) {
148			return 1 if ($tag eq $_);
149			}
150			return 0;
151			}
152			sub clean_tags {
153			my %h;
154			foreach (@_) { $h{lc($_)} = 1 }
155			return grep { defined($h{$_}) && $h{$_} } available_tags();
156			}
157			sub get_default_tags {
158			my ($email) = @_;
159			$email = lc($email);
160			open_db_read();
161			my @res;
162			if (exists $db_tags_content{$email}) {
163			@res = split(/,/, $db_tags_content{$email});
164			} else {
165	hertzog	298	@res = @default_tags;
166	hertzog	294	}
167			close_db();
168			return @res;
169			}
170			sub set_default_tags {
171			my ($email, @tags) = @_;
172			open_db_write();
173			$db_tags_content{lc($email)} = join(",", clean_tags(@tags));
174			close_db();
175			}
176			sub get_tags {
177			my ($email, $package) = @_;
178			$email = lc($email);
179			$package = lc($package);
180			open_db_read();
181			my @res;
182			if (exists $db_tags_content{"$email#$package"}) {
183			@res = split(/,/, $db_tags_content{"$email#$package"});
184			} elsif (exists $db_tags_content{$email}) {
185			@res = split(/,/, $db_tags_content{$email});
186			} else {
187	hertzog	298	@res = @default_tags;
188	hertzog	294	}
189			close_db();
190			return @res;
191			}
192			sub set_tags {
193			my ($email, $package, @tags) = @_;
194			open_db_write();
195			$db_tags_content{lc("$email#$package")} = join(",", clean_tags(@tags));
196			close_db();
197			}
198
199			1;
Name	Value
svn:eol-style	native
svn:keywords	Author Date Id Revision