source: devel/pb/lib/ProjectBuilder/CMS.pm @ 2406

Last change on this file since 2406 was 2406, checked in by bruno, 3 months ago

Fix non test log extraction for git

File size: 8.1 KB
Line 
1#!/usr/bin/perl -w
2#
3# Project Builder CMS module
4# CMS subroutines brought by the the Project-Builder project
5# which can be easily used by pbinit scripts
6#
7# $Id$
8#
9# Copyright B. Cornec 2007-2016
10# Eric Anderson's changes are (c) Copyright 2012 Hewlett Packard
11# Provided under the GPL v2
12
13package ProjectBuilder::CMS;
14
15use strict 'vars';
16use Carp 'cluck';
17use Data::Dumper;
18use English;
19use File::Basename;
20use File::Copy;
21use POSIX qw(strftime);
22use lib qw (lib);
23use ProjectBuilder::Version;
24use ProjectBuilder::Base;
25use ProjectBuilder::Conf;
26use ProjectBuilder::VCS;
27
28# Inherit from the "Exporter" module which handles exporting functions.
29 
30use vars qw($VERSION $REVISION @ISA @EXPORT);
31use Exporter;
32 
33# Export, by default, all the functions into the namespace of
34# any code which uses this module.
35 
36our @ISA = qw(Exporter);
37our @EXPORT = qw(pb_cms_get_pkg pb_cms_get_real_pkg pb_cms_log);
38($VERSION,$REVISION) = pb_version_init();
39
40=pod
41
42=head1 NAME
43
44ProjectBuilder::CMS, part of the project-builder.org
45
46=head1 DESCRIPTION
47
48This modules provides configuration management system functions suitable for pbinit calls.
49
50=head1 USAGE
51
52=over 4
53
54=item B<pb_cms_get_pkg>
55
56This function returns the list of packages we are working on in a CMS action.
57The first parameter is the default list of packages from the configuration file.
58The second parameter is the optional list of packages from the configuration file.
59
60=cut
61
62sub pb_cms_get_pkg {
63
64my @pkgs = ();
65my $defpkgdir = shift;
66my $extpkgdir = shift;
67
68# Get packages list
69if (not defined $ARGV[0]) {
70    @pkgs = keys %$defpkgdir if (defined $defpkgdir);
71} elsif ($ARGV[0] =~ /^all$/) {
72    @pkgs = keys %$defpkgdir if (defined $defpkgdir);
73    push(@pkgs, keys %$extpkgdir) if (defined $extpkgdir);
74} else {
75    @pkgs = @ARGV;
76}
77return(\@pkgs);
78}
79
80=item B<pb_cms_get_real_pkg>
81
82This function returns the real name of a virtual package we are working on in a CMS action.
83It supports the following types: perl.
84The first parameter is the virtual package name
85
86=cut
87
88sub pb_cms_get_real_pkg {
89
90my $pbpkg = shift;
91my $dtype = shift;
92my $pbpkgreal = $pbpkg;
93
94my @nametype = pb_conf_get_if("namingtype");
95my $type = $nametype[0]->{$pbpkg};
96if (defined $type) {
97    if ($type eq "perl") {
98        if ($dtype eq "rpm") {
99            $pbpkgreal = "perl-".$pbpkg;
100        } elsif ($dtype eq "deb") {
101            # Only lower case allowed in Debian
102            # Cf: http://www.debian.org/doc/debian-policy/ch-controlfields.html#s-f-Package
103            $pbpkgreal = "lib".lc($pbpkg)."-perl";
104        } elsif ($dtype eq "ebuild") {
105            $pbpkgreal = $pbpkg;
106        } elsif ($dtype eq "apk") {
107            $pbpkgreal = $pbpkg;
108        } elsif ($dtype eq "hpux") {
109            $pbpkgreal = $pbpkg;
110        } elsif ($dtype eq "pkg") {
111            $pbpkgreal = "PB$pbpkg";
112        } else {
113            die "pb_cms_get_real_pkg not implemented for $dtype yet";
114        }
115    } else {
116        die "nametype $type not implemented yet";
117    }
118}
119
120pb_log(2,"pb_cms_get_real_pkg returns $pbpkgreal\n");
121return($pbpkgreal);
122}
123
124=item B<pb_cms_create_authors>
125
126This function creates a AUTHORS files for the project. It call it AUTHORS.pb if an AUTHORS file already exists.
127The first parameter is the source file for authors information.
128The second parameter is the directory where to create the final AUTHORS file.
129The third parameter is the schema of the CMS systems (svn, cvs, svn+ssh, ...)
130
131=cut
132
133sub pb_cms_create_authors {
134
135my $authors=shift;
136my $dest=shift;
137my $scheme=shift;
138
139return if ($authors eq "/dev/null");
140open(SAUTH,$authors) || die "Unable to open $authors";
141# Save a potentially existing AUTHORS file and write instead to AUTHORS.pb
142my $ext = "";
143if (-f "$dest/AUTHORS") {
144    $ext = ".pb";
145}
146open(DAUTH,"> $dest/AUTHORS$ext") || die "Unable to create $dest/AUTHORS$ext";
147print DAUTH "Authors of the project are:\n";
148print DAUTH "===========================\n";
149while (<SAUTH>) {
150    my ($nick,$gcos) = split(/:/);
151    chomp($gcos);
152    print DAUTH "$gcos";
153    if (defined $scheme) {
154        # Do not give a scheme for flat types
155        my $endstr="";
156        if ("$ENV{'PBREVISION'}" ne "flat") {
157            $endstr = " under $scheme";
158        }
159        print DAUTH " ($nick$endstr)\n";
160    } else {
161        print DAUTH "\n";
162    }
163}
164close(DAUTH);
165close(SAUTH);
166}
167
168=item B<pb_cms_log>
169
170This function creates a ChangeLog file for the project.
171The first parameter is the schema of the CMS systems (svn, cvs, svn+ssh, ...)
172The second parameter is the directory where the CMS content was checked out.
173The third parameter is the directory where to create the final ChangeLog file.
174The fourth parameter is unused.
175The fifth parameter is the source file for authors information.
176
177It may use a tool like svn2cl or cvs2cl to generate it if present, or the log file from the CMS if not.
178
179=cut
180
181
182sub pb_cms_log {
183
184my $scheme = shift;
185my $pkgdir = shift;
186my $dest = shift;
187my $chglog = shift;
188my $authors = shift;
189my $testver = shift;
190
191pb_cms_create_authors($authors,$dest,$scheme);
192my $vcscmd = pb_vcs_cmd($scheme);
193
194if ((defined $testver) && (defined $testver->{$ENV{'PBPROJ'}}) && ($testver->{$ENV{'PBPROJ'}} =~ /true/i)) {
195    if (! -f "$dest/ChangeLog") {
196        open(CL,"> $dest/ChangeLog") || cluck "Unable to create $dest/ChangeLog" && return;
197        # We need a minimal version for debian type of build
198        print CL "\n";
199        print CL "\n";
200        print CL "\n";
201        print CL "\n";
202        print CL "1990-01-01  none\n";
203        print CL "\n";
204        print CL "        * test version\n";
205        print CL "\n";
206        close(CL);
207        pb_log(0,"Generating fake ChangeLog for test version\n");
208        open(CL,"> $dest/$ENV{'PBCMSLOGFILE'}") || die "Unable to create $dest/$ENV{'PBCMSLOGFILE'}";
209        close(CL);
210    }
211}
212
213if (! -f "$dest/ChangeLog") {
214    if ($scheme =~ /^svn/) {
215        # In case we have no network, just create an empty one before to allow correct build
216        open(CL,"> $dest/ChangeLog") || die "Unable to create $dest/ChangeLog";
217        close(CL);
218        my $command = pb_check_req("svn2cl",1);
219        if ((defined $command) && (-x $command)) {
220            pb_system("$command --group-by-day --authors=$authors -i -o $dest/ChangeLog $pkgdir","Generating ChangeLog from SVN with svn2cl");
221        } else {
222            # To be written from pbcl
223            pb_system("$vcscmd log -v $pkgdir > $dest/$ENV{'PBCMSLOGFILE'}","Extracting log info from SVN");
224        }
225    } elsif ($scheme =~ /^svk/) {
226        pb_system("$vcscmd log -v $pkgdir > $dest/$ENV{'PBCMSLOGFILE'}","Extracting log info from SVK");
227    } elsif ($scheme =~ /^hg/) {
228        # In case we have no network, just create an empty one before to allow correct build
229        open(CL,"> $dest/ChangeLog") || die "Unable to create $dest/ChangeLog";
230        close(CL);
231        pb_system("$vcscmd log -v $pkgdir > $dest/$ENV{'PBCMSLOGFILE'}","Extracting log info from Mercurial");
232    } elsif ($scheme =~ /^git/) {
233        # In case we have no network, just create an empty one before to allow correct build
234        open(CL,"> $dest/ChangeLog") || die "Unable to create $dest/ChangeLog";
235        close(CL);
236        pb_system("(cd $pkgdir ; $vcscmd log -v > $dest/$ENV{'PBCMSLOGFILE'})","Extracting log info from GIT");
237    } elsif ($scheme =~ /^(flat)|(ftp)|(http)|(https)|(file)|(dir)\b/o) {
238        pb_system("echo ChangeLog for $pkgdir > $dest/ChangeLog","Empty ChangeLog file created");
239    } elsif ($scheme =~ /^cvs/) {
240        my $tmp=basename($pkgdir);
241        # CVS needs a relative path !
242        # In case we have no network, just create an empty one before to allow correct build
243        open(CL,"> $dest/ChangeLog") || die "Unable to create $dest/ChangeLog";
244        close(CL);
245        my $command = pb_check_req("cvs2cl",1);
246        if (-x $command) {
247            pb_system("$command --group-by-day -U $authors -f $dest/ChangeLog $pkgdir","Generating ChangeLog from CVS with cvs2cl");
248        } else {
249            # To be written from pbcl
250            pb_system("$vcscmd log $tmp > $dest/$ENV{'PBCMSLOGFILE'}","Extracting log info from CVS");
251        }
252    } else {
253        die "cms $scheme unknown";
254    }
255}
256if (! -f "$dest/ChangeLog") {
257    copy("$dest/$ENV{'PBCMSLOGFILE'}","$dest/ChangeLog");
258}
259}
260
261=back
262
263=head1 WEB SITES
264
265The main Web site of the project is available at L<http://www.project-builder.org/>. Bug reports should be filled using the trac instance of the project at L<http://trac.project-builder.org/>.
266
267=head1 USER MAILING LIST
268
269None exists for the moment.
270
271=head1 AUTHORS
272
273The Project-Builder.org team L<http://trac.project-builder.org/> lead by Bruno Cornec L<mailto:bruno@project-builder.org>.
274
275=head1 COPYRIGHT
276
277Project-Builder.org is distributed under the GPL v2.0 license
278described in the file C<COPYING> included with the distribution.
279
280=cut
281
2821;
Note: See TracBrowser for help on using the repository browser.