adl_cvs_diff.pl 4.94 KB
Newer Older
1
2
3
4
5
eval 'exec perl -S $0 ${1+"$@"}' # -*- Mode: perl -*-
    if 0;
# the above is a more portable way to find perl
# ! /usr/bin/perl

6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
# Copyright 2015 Helmholtz-Zentrum Berlin für Materialien und Energie GmbH
# <https://www.helmholtz-berlin.de>
#
# Author: Goetz Pfeiffer <Goetz.Pfeiffer@helmholtz-berlin.de>
#
# This program is free software: you can redistribute it and/or modify it under
# the terms of the GNU General Public License as published by the Free Software
# Foundation, either version 3 of the License, or (at your option) any later
# version.
# 
# This program is distributed in the hope that it will be useful, but WITHOUT
# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
# FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
# details.
# 
# You should have received a copy of the GNU General Public License along with
# this program.  If not, see <http://www.gnu.org/licenses/>.
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
# @STATUS: release
# @PLATFORM: home bessy
# @CATEGORY: search


# [adl_cvs_diff.pl] -- compare an adl file against the repository

use strict;

use FindBin;
use Getopt::Long;
use Config;
use File::Spec;

use vars qw($opt_help 
            $opt_summary 
	    $opt_svn
	    $opt_revision $opt_revision2
	    $opt_legacy);


my $sc_version= "1.0";

my $sc_name= $FindBin::Script;
my $sc_summary= "compare an adl file against the repository"; 
my $sc_author= "Goetz Pfeiffer";
my $sc_year= "2007";

my $debug= 0; # global debug-switch

my $tmpdir= "/tmp";
pfeiffer's avatar
pfeiffer committed
56
my $adlsort= "adlsort.pl";
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


#Getopt::Long::config(qw(no_ignore_case));

if (!GetOptions("help|h","summary",
                "svn",
                "revision|r=s","revision2|s=s","legacy"
                ))
  { die "parameter error!\n"; };

if ($opt_help)
  { help();
    exit;
  };

if ($opt_summary)
  { print_summary();
    exit;
  };

if ($opt_legacy)
  { $adlsort.= " --legacy"; };

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

my $filename= shift(@ARGV);

if (!defined $filename)
  { die "error: name of the capfast file is missing!\n"; };

print "file $filename:\ncomparing ";

my $file1= process($filename,$opt_revision,1);

if (!defined $file1)
  { die; };

print " against ";

$opt_revision2= "local" if (!defined $opt_revision2);
my $file2= process($filename,$opt_revision2,2);

if (!defined $file2)
  { unlink($file1);  
    die; 
  };

print "\n";

show_diff($file1,$file2);
unlink($file1);
unlink($file2);

exit(0);

# fit in program text here

sub basename
  { my($path)= @_;
116

117
    my ($volume,$directories,$file) = File::Spec->splitpath( $path );
118

119
120
    if ($file!~ /(.*)\.(?:adl|cdl)$/)
      { die "error: file $file is not a capfast file\n"; };
121

122
123
124
125
126
    return($1);
  }

sub process
  { my($filename,$rev,$no)= @_;
127

128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
    if ($rev eq "local")
      { print "working copy";
        return(local_process($filename,$no)); 
      }
    else
      { if (!defined $rev)
          { print "trunk"; }
	else
	  { print "revision $rev";
	  };
        if (!defined ($opt_svn))
	  { return(cvs_process($filename,$rev,$no)); }
	else
	  { return(svn_process($filename,$rev,$no)); }
      }
  }

sub local_process
  { my($filename,$no)= @_;
    my $cmd;
148

149
150
    my $base= basename($filename) . ".$no.db";
    $base= File::Spec->catfile($tmpdir,$base);
151

152
153
154
155
    if (!sys("$adlsort -f $filename > $base"))
      { return; };
    return($base);
  }
156

157
158
159
sub cvs_process
  { my($filename,$rev,$no)= @_;
    my $cmd;
160

161
162
163
164
165
166
167
    my $cvs_options;
    if (defined $rev)
      { $cvs_options= "-r $rev"; 
      };

    my $base= basename($filename) . ".$no.db";
    $base= File::Spec->catfile($tmpdir,$base);
168

169
170
171
172
173
    if (!sys("cvs update $cvs_options -p $filename 2> /dev/null | " .
             "$adlsort > $base"))
      { return; };
    return($base);
  }
174

175
176
177
sub svn_process
  { my($filename,$rev,$no)= @_;
    my $cmd;
178

179
180
181
    if (!defined $rev)
      { $rev= 'HEAD'; }; 
    # else: leave revision number 
182

183
184
    my $base= basename($filename) . ".$no.db";
    $base= File::Spec->catfile($tmpdir,$base);
185

186
187
188
189
190
    if (!sys("svn cat -r $rev $filename 2> /dev/null | " .
             "$adlsort > $base"))
      { return; };
    return($base);
  }
191

192
193
sub show_diff
  { my($f1,$f2)= @_;
194

195
196
197
    my $cmd= "tkdiff $f1 $f2 2>/dev/null";
    sys($cmd);
  }
198

199
200
sub sys
  { my($cmd)= @_;
201

202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
    print "\n$cmd\n" if ($debug);
    if (system($cmd))
      { warn "\"$cmd\" failed : $?"; 
        return;
      };
    return(1);
  }

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

sub print_summary
  { printf("%-20s: $sc_summary\n",
           $sc_name);
  }

sub h_center
  { my($st)= @_;
    return( (' ' x (38 - length($st)/2)) . $st );
  }

sub help
  { my $l1= h_center("**** $sc_name $sc_version -- $sc_summary ****");
    my $l2= h_center("$sc_author $sc_year");
    print <<END;

$l1
$l2

Syntax:
  $sc_name {options} [file]

  options:
    -h: help
    --summary: give a summary of the script
    --svn: use subversion instead of cvs
    -r [cvs-revision] (mandatory)
    -s [2nd cvs revision] (optional)
    --legacy: allow old-style meta-commands in *.cdl files
      (like #if and #endif)    
END
  }