Merge remote-tracking branch 'origin/github/pr/116'
[grml-live.git] / db / dpkg-to-db
1 #!/usr/bin/perl -w
2 # Filename:      dpkg-to-db
3 # Purpose:       add grml build information into a sqlite database
4 # Authors:       grml-team (grml.org)
5 # Bug-Reports:   see http://grml.org/bugs/
6 # License:       This file is licensed under the GPL v2 or any later version.
7 ################################################################################
8 # Requires the following Debian packages (handled via grml-live-db depends):
9 # libdbd-sqlite3-perl libdbi-perl libtimedate-perl perl-doc sqlite3
10 ################################################################################
11
12 use strict;
13
14 use warnings;
15 use Getopt::Long;
16 use Pod::Usage;
17 use DBI;
18 use Date::Format;
19
20
21 my ($db, $logfile, $flavour, $help, $dpkgfile);
22 my $rc = GetOptions (
23                 'database|db=s' => \$db,
24                 'dpkg|d=s'      => \$dpkgfile,
25                 'logfile|l=s'   => \$logfile,
26                 'flavour|f=s'   => \$flavour,
27                 'help|h'        => \$help,
28         );
29
30 pod2usage(1) if $help;
31
32 pod2usage(-message => "$0: Need a sqlite database through --database ....\n") unless $db;
33 pod2usage(-message => "$0: Need a logfile to insert through --database ...\n") unless $logfile;
34 pod2usage(-message => "$0: Need the flavour information through --flavour ...\n") unless $flavour;
35 pod2usage(-message => "$0: Need the dpkg file through --dpkg ...\n") unless $dpkgfile;
36
37 open (my $fh, '<', $logfile) or die "Could not open $logfile: $!";
38 open (my $dpkg_handle, '<', $dpkgfile) or die "Could not open $dpkgfile: $!";
39
40 my $dbh = DBI->connect("dbi:SQLite:dbname=$db","","") or die "Could not connect to database: " . $DBI::err;
41
42 # We use foreign key - beware this needs sqlite > 3.6.19
43 $dbh->do("PRAGMA foreign_keys = ON");
44
45 # read content of log file - please do not try this at home :)
46 my $log = do { local $/; <$fh> };
47
48 my $identifier = "$flavour-". time2str('%Y%m%d%H%M%S', time());
49
50 # Prepare tables if not yet present {{{
51 my $create_table_build = $dbh->prepare("
52 CREATE TABLE if not exists build ( id integer primary key autoincrement,
53 identifier varchar(30),
54 flavour varchar(30),
55 date varchar(30),
56 logfile blob);
57 ")
58   or die "Could not create tables: " . $dbh->errstr."\n";
59
60 $create_table_build->execute()
61   or die "Can't execute SQL statement: " . $dbh->errstr."\n";
62
63 my $create_table_packages = $dbh->prepare("
64 CREATE TABLE if not exists packages (  id integer primary key autoincrement,
65 package varchar(30),
66 status varchar(2),
67 version varchar(30),
68 build integer,
69 FOREIGN KEY(build) REFERENCES build(id));
70 ")
71   or die "Could not create tables: " . $dbh->errstr."\n";
72
73 $create_table_packages->execute()
74   or die "Can't execute SQL statement: " . $dbh->errstr."\n";
75 # }}}
76
77
78 # Write information to database {{{
79 my $sth = $dbh->prepare("INSERT into build ('identifier','flavour','date','logfile') VALUES (?,?,?,?)")
80         or die "Could not prepare db statement: " . $dbh->errstr;
81
82 # Execute the query
83 $sth->execute($identifier, $flavour, time(), $log)
84         or die "Could not add build to db: " . $sth->errstr;
85
86 $sth = $dbh->prepare("SELECT id from build where identifier = ?");
87 $sth->execute($identifier) or die "Couldn't execute statement: " . $sth->errstr;
88 my $row = $sth->fetch;
89 my $id = $row->[0];
90
91 die "No id?" unless $id;
92
93 $sth = $dbh->prepare("INSERT into packages (package, status, version, build) VALUES (?,?,?,?)")
94         or die "Could not prepare db statement: " . $dbh->errstr;
95
96 while (my $line = <$dpkg_handle>) {
97         next unless $line =~ /^[a-z]{2} /;
98         # remove new lines
99         my ($status, $package, $version, $desc) = split (/\s+/, $line, 4);
100         $sth->execute($package, $status, $version, $id)
101                 or die "Couldn't execute statement: " . $sth->errstr;
102
103 }
104 # }}}
105
106 print "recorded buildinformation with identifier $identifier as id $id\n";
107
108 # perldoc -F ./dpkg-to-db
109
110 __END__
111
112 =head1 dpkg-to-db
113
114 dpkg-to-db - add grml build information into a sqlite database
115
116 =head1 SYNOPSIS
117
118 dpkg-to-db <options>
119
120 =head1 OPTIONS
121
122 =over 8
123
124 =item B<--help>
125
126 Print a brief help message and exits.
127
128 =item B<--database <database>>
129
130 Database file.
131
132 =item B<--dpkg <dpkglist>>
133
134 `dpkg --list` output file of grml-live build.
135
136 =item B<--logfile <logfile>>
137
138 Logfile which should be added.
139
140 =item B<--flavour <flavour>>
141
142 Name of the grml-flavour the build is.
143
144 =back
145
146 =head1 DESCRIPTION
147
148 B<dpkg-to-db> will read the given input file(s) and stores the
149 information to the specified database.
150
151 =head1 USAGE EXAMPLES
152
153 Please see B<man 8 grml-live-db> for further information.
154
155 =cut