source: trunk/dasscm/dasscm@ 276

Last change on this file since 276 was 276, checked in by joergs, on Mar 6, 2009 at 4:53:20 PM

failed update is non fatal any more. Therefore normal users can do some commands, like status

  • Property keyword set to id
  • Property svn:executable set to *
  • Property svn:keywords set to Id
File size: 29.7 KB
RevLine 
[186]1#!/usr/bin/perl -w
2
3# $Id: dasscm 276 2009-03-06 15:53:20Z joergs $
4
5use strict;
6
[208]7use Env
[235]8 qw($DASSCM_PROD $DASSCM_REPO $USER $DASSCM_USERNAME $DASSCM_USER $DASSCM_PASSWORD $SHELL);
[186]9use Cwd;
[214]10use Getopt::Long;
[186]11use File::Basename;
[209]12use File::Compare;
13use File::Copy;
[237]14use File::Find;
[186]15use File::stat;
16use File::Path;
[214]17use Term::ReadKey;
[239]18
[234]19#use Data::Dumper;
[186]20
[189]21#####################################################################
22#
[186]23# global
[189]24#
[205]25
[253]26# shell exit codes
[252]27my $RETURN_OK = 0;
28my $RETURN_NOK = 1;
29
[215]30# file to store permissions
31my $permissions_file = "/etc/permissions.d/dasscm.permission_backup";
[220]32
[238]33# documentation file (for usage)
34my $doc_file = "/usr/share/doc/packages/dasscm/dasscm_howto.txt";
35
[253]36# commands that require write access (and therefore a login)
37# to the repository server
[274]38my @COMMANDS_REQUIRE_WRITE = ( "add", "commit" );
[252]39
[215]40# configuration file
[205]41my $config_file = "/etc/dasscm.conf";
[234]42my $config = get_config($config_file);
[205]43my $DASSCM_LOCAL_REPOSITORY_BASE;
44my $DASSCM_REPOSITORY_NAME;
45my $DASSCM_SVN_REPOSITORY;
[247]46my $DASSCM_CHECKOUT_USERNAME;
47my $DASSCM_CHECKOUT_PASSWORD;
[205]48
[238]49# current directory at program start
50my $StartDirectory = cwd();
51
[268]52my $diff = "diff --exclude .svn ";
[205]53my $SVN = "svn ";
54my $svnOptions = "";
55my $svnCheckoutCredentials = "";
56my $svnPasswordCredentials = "";
[275]57
[268]58# flag. Set to true by svn_update
59# This prevents, that svn_update is called multiple times
60my $svnRepositoryIsUptodate = 0;
[205]61
[196]62# command line options get stored in options hash
[205]63my %options = ();
64
[197]65# subcommand, that gets executed (add, commit, ...)
[196]66my $command;
[186]67
[205]68my $verbose = 0;
69
[189]70#####################################################################
71#
[186]72# util functions
[189]73#
[187]74sub usage()
75{
[205]76 print "usage: dasscm <subcommand> [options] [args]\n";
77 print "\n";
78 print "dasscm is intended to help versioning configuration files\n";
79 print "\n";
80 print "Available subcommands:\n";
[215]81 print " help <subcommand>\n";
[205]82 print " init\n";
[274]83 print " login <username>\n";
84 print " up <path>\n";
85 print " ls <path>\n";
86 print " add <path>\n";
87 print " commit <path>\n";
88 print " diff <path>\n";
89 print " status <path>\n";
90 print " cleanup\n";
[215]91 print " permissions\n";
[205]92 print "\n";
[238]93 print "preparation:\n", " if dasscm is already configured,\n",
[236]94 " use 'dasscm login' and then eg. 'add'.\n",
[220]95 " The environment variables\n", " DASSCM_REPO\n", " DASSCM_PROD\n",
96 " DASSCM_USERNAME\n", " DASSCM_PASSWORD\n",
97 " are evaluated, but set automatically by 'dasscm login'.\n", "\n",
[239]98 " If dasscm is not yet configured, read", " $doc_file\n";
[187]99}
100
[233]101sub warning(@)
102{
103 print "Warning: " . join( "\n ", @_ ) . "\n";
104}
105
106sub error(@)
107{
108 print "Error: " . join( "\n ", @_ ) . "\n";
109}
110
111sub fatalerror(@)
112{
[239]113 error(@_);
114
[233]115 #print "Exiting\n";
[239]116 exit 1;
[233]117}
118
[238]119#
120# reading config file and return key/value pairs as hash
121#
[234]122sub get_config
123{
[239]124 my $file = $_[0];
[234]125
[239]126 if ( !$file ) {
[234]127 fatalerror( "failed to open config file" . $file );
128 }
129
130 my $data = {};
131
132 # try to open config file
133 if ( !open( FH, $file ) ) {
134 fatalerror( "failed to open config file" . $file );
135 } else {
136 while (<FH>) {
137 chomp;
138 if (/^#/) {
139 next;
140 }
141 if ( $_ =~ /=/g ) {
[239]142
[238]143 # splitting in 2 fields at maximum
[234]144 my ( $option, $value ) = split( /=/, $_, 2 );
145 $option =~ s/^\s+//g;
146 $option =~ s/\s+$//g;
147 $option =~ s/\"+//g;
148 $value =~ s/^\s+//g;
149 $value =~ s/\s+$//g;
150 $value =~ s/\"+//g;
151
152 if ( length($option) ) {
153 $data->{$option} = $value;
154 }
155 }
156 }
157 }
158 close(FH);
159
160 return $data;
161}
162
[270]163#
164# check and evaluate environment variables
165#
[186]166sub check_env()
167{
[205]168
169 # DASSCM_PROD
170 if ( !$DASSCM_PROD ) {
171 $DASSCM_PROD = "/";
172 }
173
174 if ( !-d $DASSCM_PROD ) {
175 die "DASSCM_PROD ($DASSCM_PROD) is not set to a directory.\n";
176 }
177 if ($verbose) { print "DASSCM_PROD: " . $DASSCM_PROD . "\n"; }
178
179 # DASSCM_REPOSITORY_NAME
[208]180 if ( !$DASSCM_REPOSITORY_NAME ) {
181 die
182 "Variable DASSCM_REPOSITORY_NAME is not defined.\nIt needs to be a unique name.\nNormally the full qualified host name is used.\nUse file $config_file to configure it.\n";
183 }
[205]184
185 # DASSCM_REPO
186 if ( !$DASSCM_REPO ) {
187 if ( $DASSCM_LOCAL_REPOSITORY_BASE && $DASSCM_REPOSITORY_NAME ) {
188 $DASSCM_REPO =
189 $DASSCM_LOCAL_REPOSITORY_BASE . "/" . $DASSCM_REPOSITORY_NAME;
190 } else {
191 die
192 "Envirnonment variable DASSCM_REPO not set.\nSet DASSCM_REPO to the directory of the versioning system checkout for this machine.\n";
193 }
194 }
[215]195 if ($verbose) { print "DASSCM_REPO: " . $DASSCM_REPO . "\n"; }
[205]196
197 #
[248]198 # subversion checkout user
199 #
[252]200 if ( !$DASSCM_CHECKOUT_USERNAME ) {
201 fatalerror(
[248]202 "variable DASSCM_CHECKOUT_USERNAME is not defined.",
[252]203 "Use file $config_file to configure it."
204 );
[248]205 }
206
[252]207 if ( !$DASSCM_CHECKOUT_PASSWORD ) {
208 fatalerror(
[248]209 "variable DASSCM_CHECKOUT_PASSWORD is not defined.",
[252]210 "Use file $config_file to configure it."
211 );
[248]212 }
213
214 #
[239]215 # check if local repository directory exist
[235]216 # (if not creating by init)
[205]217 #
218 if ( $command ne "init" ) {
219 if ( not -d $DASSCM_REPO ) {
220 die
[208]221 "Can't access local repository DASSCM_REPO\n($DASSCM_REPO)\nCheck configuration and execute\n dasscm init\n";
[205]222 }
[208]223
[205]224 #
225 # user settings
226 #
[208]227
[205]228 # DASSCM_USER is legacy. Use DASSCM_USERNAME instead
[208]229 if ( !$DASSCM_USERNAME ) {
230 $DASSCM_USERNAME = $DASSCM_USER;
[205]231 }
232
233 # user root is not allowed for checkins.
234 # if user is root, DASSCM_USER has to be set,
235 # otherwise USER can be used
236 if ( "$USER" eq "root" ) {
[252]237 if ( ( not $DASSCM_USERNAME )
238 and ( grep { m|^$command$| } @COMMANDS_REQUIRE_WRITE ) )
239 {
240
241 #( $command ne "login" ) and ( $command ne "status" ) ) {
242 fatalerror(
243 "Envirnonment variable DASSCM_USERNAME not set.",
244 "Set DASSCM_USERNAME to your subversion user account or",
245 "use 'dasscm login'"
246 );
[205]247 }
248 $svnOptions .= " --no-auth-cache ";
249 } elsif ( !$DASSCM_USERNAME ) {
250 $DASSCM_USERNAME = $USER;
251 }
252
253 #
254 # password
255 #
[208]256 if ($DASSCM_PASSWORD) {
[267]257 $svnPasswordCredentials = " --password '$DASSCM_PASSWORD' ";
[205]258 }
259 }
260
261 #$svnOptions .= " --username $DASSCM_USERNAME "
[186]262}
263
[270]264#
265# has been intendend,
266# to check addtitional parameters.
267# Currently not used.
268#
[186]269sub check_parameter(@)
270{
271}
272
[238]273#
[239]274# generate from (relative) filename
[238]275# all required file and directory names:
276# $basename, $dirname_prod, $dirname_repo,
277# $filename_prod, $filename_repo
278#
[187]279sub get_filenames(@)
280{
[250]281 my $filename_prod = $_[0] || ".";
[237]282
[238]283 # make filename absolut
[205]284 if ( !( $filename_prod =~ m/^\// ) ) {
[270]285 $filename_prod = cwd() . '/' . $filename_prod;
[205]286 }
[187]287
[239]288 if ( not -r $filename_prod ) {
289 fatalerror( $filename_prod . " is not accessable" );
[233]290 }
[205]291
[274]292 # dirname buggy: eg. "/etc/" is reduced to "/",
293 # "/etc" is used as filename
294 # herefore make sure, that if filename is a directory,
295 # it will end by "/"
[275]296 if ( ( -d $filename_prod ) and ( !( $filename_prod =~ m/\/$/ ) ) ) {
[270]297 $filename_prod = $filename_prod . '/';
298 }
[238]299
[270]300 ( my $basename, my $dirname_prod ) = fileparse($filename_prod);
301
[238]302 # uses chdir to determine real directory in a unique way
[205]303 chdir $dirname_prod or die $!;
[270]304 $dirname_prod = cwd() . '/';
[238]305 chdir $StartDirectory;
306
[214]307 if ($verbose) {
308 print "dir: " . $dirname_prod . "\n";
309 print "fn: " . $basename . "\n";
310 }
[205]311
312 my $dirname_repo = $DASSCM_REPO . "/" . $dirname_prod;
313 my $filename_repo = "$dirname_repo/$basename";
314
315 return (
316 $basename, $dirname_prod, $dirname_repo,
317 $filename_prod, $filename_repo
318 );
[187]319}
320
[271]321sub copy_file_to_repository( $ )
322{
323 my $filename = shift;
[256]324
[271]325 (
326 my $basename,
327 my $dirname_prod,
328 my $dirname_repo,
329 my $filename_prod,
330 my $filename_repo
[275]331 )
332 = get_filenames($filename);
[271]333
334 # TODO: are permissions also copied?
335 copy( $filename_prod, $filename_repo )
[275]336 or error "failed to copy $filename_prod to repository: $!";
[271]337}
338
[256]339#
340# creates a file with permissions
341#
[215]342sub generatePermissionList
[209]343{
344
[215]345 # generieren der Zeilen für Permission-Savefile
346 my @files = @_;
347 my @permlist = ();
348 foreach my $file (@files) {
[227]349 $file = "/" . $file;
[239]350 if ( -e $file ) {
351 my $info = stat($file) || die "failed to stat $file: aborting";
352 my $mode = get_type( $info->mode ) & 07777;
[227]353 my $modestring = sprintf( "%04o", $mode );
354 my $uid = $info->uid;
355 my $uidname = getpwuid($uid);
356 my $gid = $info->gid;
357 my $gidname = getgrgid($gid);
358 push(
359 @permlist,
360 sprintf( "%-55s %-17s %4d",
361 $file, "${uidname}:${gidname}", $modestring )
362 );
363 } else {
[239]364 print
365 "failed to get status of $file. It exists in the repository, but not on the system\n";
[227]366 }
[215]367 }
368 return @permlist;
369}
[209]370
[215]371sub get_type
372{
[209]373
[215]374 # Funktion übernommen aus /usr/bin/chkstat
375 my $S_IFLNK = 0120000; # symbolic link
376 my $S_IFREG = 0100000; # regular file
377 my $S_IFDIR = 0040000; # directory
378 my $S_IFCHAR = 0020000; # character device
379 my $S_IFBLK = 0060000; # block device
380 my $S_IFFIFO = 0010000; # fifo
381 my $S_IFSOCK = 0140000; # socket
382 my $S_IFMT = 0170000; # type of file
[209]383
[215]384 my $S_m;
385 if ( ( $_[0] & $S_IFMT ) == $S_IFLNK ) { $S_m = $_[0] - $S_IFLNK; }
386 elsif ( ( $_[0] & $S_IFMT ) == $S_IFREG ) { $S_m = $_[0] - $S_IFREG; }
387 elsif ( ( $_[0] & $S_IFMT ) == $S_IFDIR ) { $S_m = $_[0] - $S_IFDIR; }
388 elsif ( ( $_[0] & $S_IFMT ) == $S_IFCHAR ) { $S_m = $_[0] - $S_IFCHAR; }
389 elsif ( ( $_[0] & $S_IFMT ) == $S_IFBLK ) { $S_m = $_[0] - $S_IFBLK; }
390 elsif ( ( $_[0] & $S_IFMT ) == $S_IFFIFO ) { $S_m = $_[0] - $S_IFFIFO; }
391 elsif ( ( $_[0] & $S_IFMT ) == $S_IFSOCK ) { $S_m = $_[0] - $S_IFSOCK; }
392 $S_m;
[209]393}
394
[186]395sub run_command
396{
[205]397 my $command = shift;
[186]398
[205]399 #print "executing command: " . $command . "\n";
[186]400
[205]401 open( RESULT, $command . ' 2>&1 |' );
402 my @result = <RESULT>;
403 close(RESULT);
404 my $retcode = $? >> 8;
[186]405
[205]406 #print @result;
407 #if( $retcode ) { print "return code: " . $retcode . "\n"; }
[186]408
[205]409 return ( $retcode, @result );
[186]410}
411
[205]412sub run_interactive
413{
[186]414
[208]415 if ($verbose) {
[205]416 print "run_interactive:" . join( " ", @_ ) . "\n";
417 }
[196]418
[205]419 system(@_);
420 if ( $? == -1 ) {
421 printf "failed to execute: $!\n";
422 } elsif ( $? & 127 ) {
423 printf "child died with signal %d, %s coredump\n", ( $? & 127 ),
424 ( $? & 128 ) ? 'with' : 'without';
425 } elsif ( $? >> 8 != 0 ) {
426 printf "child exited with value %d\n", $? >> 8;
427 }
428 return ( $? >> 8 );
429}
430
[247]431sub svn_check_credentials( $$;$$ )
[196]432{
[205]433 my $username = shift;
434 my $password = shift;
435
[252]436 # check silently are allow user interaction?
[247]437 my $interactive = shift || 0;
[220]438
[247]439 # default: exit program, if repository is not accessable
440 # (do not exit for 'init')
441 my $fatalerror = shift || 1;
442
443 print "checking credentials ";
444
[239]445 if ( !$username ) {
446 fatalerror("no username given");
[238]447 }
448
[239]449 if ( !$password ) {
450 fatalerror("no password given");
[238]451 }
452
[247]453 print "for " . $username . "@" . $DASSCM_SVN_REPOSITORY . ": ";
454
[220]455 # Options for "svn info" are not supported by subversion 1.0.0 (SLES9),
456 # therefore switching to "svn status"
457 # ( my $rc_update, my @result ) =
458 # run_command(
459 # "$SVN info --non-interactive --no-auth-cache --username $username --password $password $DASSCM_SVN_REPOSITORY"
460 # );
461 #print @result;
462
[247]463 my $rc_update;
[252]464 if ($interactive) {
465 $rc_update =
466 run_interactive(
[267]467 "$SVN ls --no-auth-cache --username '$username' --password '$password' $DASSCM_SVN_REPOSITORY"
[252]468 );
[247]469 } else {
470 ( $rc_update, my @result ) =
[252]471 run_command(
[267]472 "$SVN ls --non-interactive --no-auth-cache --username '$username' --password '$password' $DASSCM_SVN_REPOSITORY"
[252]473 );
474
[247]475 if ( $rc_update != 0 ) {
476 print "\n", @result;
[252]477 if ($fatalerror) {
[247]478 fatalerror();
479 }
480 return;
481 }
[205]482 }
483
[247]484 # return success
485 return $rc_update == 0;
[196]486}
487
[205]488sub svn_update( ;$ )
489{
[270]490 my $update_path = shift || "";
491
492 # use this flag to do only one update per run
[275]493 if ( !$svnRepositoryIsUptodate ) {
[268]494 ( my $rc_update, my @result ) =
[275]495 run_command(
496 "$SVN update --non-interactive $svnCheckoutCredentials '$DASSCM_REPO/$update_path'"
497 );
[268]498 print @result;
499 if ( $rc_update != 0 ) {
[276]500 error( "failed to update local repository ($update_path)" );
[270]501 } elsif ( not $update_path ) {
[275]502
[270]503 # set this flag if a full update is done
[268]504 $svnRepositoryIsUptodate = 1;
505 }
[205]506 }
[215]507}
[196]508
[271]509sub svn_ls( ;@ )
[215]510{
[270]511 (
512 my $basename,
513 my $dirname_prod,
514 my $dirname_repo,
515 my $filename_prod,
516 my $filename_repo
517 )
518 = get_filenames( $_[0] );
[220]519
[218]520 # svn ls -R is better, but much, much slower
521 # ( my $rc, my @result ) = run_command("$SVN ls --recursive $svnCheckoutCredentials $path");
[270]522
[271]523 my @files = ();
524 my @links = ();
525 my @dirs = ();
526 my @others = ();
527
[275]528 if ( -f $filename_prod ) {
529 @files = ($filename_prod);
[271]530 } elsif ( -d $dirname_repo ) {
531 find(
532 {
533 wanted => sub {
534 my $name = $File::Find::name;
535 $name =~ s|^$dirname_repo||;
536 if ( $name =~ m/\.svn/ ) {
[275]537
[271]538 # skip svn meta data
539 } elsif ( -l $_ ) {
[275]540
[271]541 # soft link
542 # important: check for links first
543 # to exclude them from further checks
544 push( @links, $name );
545 } elsif ( -d $_ ) {
[275]546
[271]547 # directories
548 push( @dirs, $name );
549 } elsif ( -f $_ ) {
[275]550
[271]551 # regular file
552 push( @files, $name );
553 } else {
554 push( @others, $name );
555 }
[275]556 }
[271]557 },
[275]558 ($dirname_repo)
[271]559 );
[215]560 }
[271]561
562 return @files;
[205]563}
564
[274]565sub svn_revert( ;$ )
566{
567 my $path = shift || $DASSCM_REPO;
568
[275]569 ( my $rc_update, my @result ) = run_command("$SVN revert -R '$path'");
[274]570
571 if ( $rc_update != 0 ) {
572 print "\n", @result;
[275]573 error("failed to revert subversion repository changes");
[274]574 }
575}
576
[268]577sub getModifiedFiles( ;$ )
578{
[270]579 (
580 my $basename,
581 my $dirname_prod,
582 my $dirname_repo,
583 my $filename_prod,
584 my $filename_repo
585 )
586 = get_filenames( $_[0] );
[268]587
[275]588 my @files = svn_ls($filename_prod);
[270]589
[268]590 # stores result from status (cvscheck)
591 my %removedfiles = ();
592 my %changedfiles = ();
593
594 # create list of modified files
595 if (@files) {
596
597 foreach my $file (@files) {
598
[271]599 my $realfile = $dirname_prod . $file;
600 my $cvsworkfile = $dirname_repo . $file;
[268]601
602 if ( -d $realfile ) {
603 ## directory. do nothing
604 } elsif ( !-r $realfile ) {
605 $removedfiles{"$realfile"} = $cvsworkfile;
606 } else {
607 ( -r "$cvsworkfile" )
608 || die("Fehler: $cvsworkfile ist nicht lesbar");
609 if ( compare( $cvsworkfile, $realfile ) != 0 ) {
610 $changedfiles{"$realfile"} = $cvsworkfile;
611 }
612 }
613 }
614 }
615
616 return ( \%changedfiles, \%removedfiles );
617}
618
[238]619#
620# from an array of files/dirs,
621# generates list of files
622# sorted by type
623#
[237]624sub get_files( @ )
625{
626 my @files = ();
627 my @links = ();
628 my @dirs = ();
629 my @others = ();
630
[239]631 if (@_) {
632 find(
633 {
634 wanted => sub {
635 my $fullname = cwd() . "/" . $_;
636 if ( -l $_ ) {
637
638 # soft link
639 # important: check for links first
640 # to exclude them from further checks
641 push( @links, $fullname );
642 } elsif ( -d $_ ) {
[271]643
644 # directories
[239]645 push( @dirs, $fullname );
646 } elsif ( -f $_ ) {
647
648 # regular file
649 push( @files, $fullname );
650 } else {
651 push( @others, $fullname );
652 }
653 }
654 },
655 @_
656 );
[237]657 }
658
[239]659 # don't rely on others.
[237]660 # If more specific file types are needed,
661 # they will be added
662 return {
[239]663 files => \@files,
664 links => \@links,
665 dirs => \@dirs,
666 others => \@others
667 };
[237]668}
669
[189]670#####################################################################
671#
[186]672# functions
673
674sub help(;@)
675{
[205]676 if ( @_ == 0 ) {
677 usage();
678 } else {
679 print "help for @_: ...\n";
[214]680 usage();
[205]681 }
[186]682}
683
[203]684sub login(@)
685{
[205]686 check_parameter( @_, 1 );
687 check_env();
[203]688
[235]689 my $input_username = $_[0];
[214]690
691 if ( not $input_username ) {
692 my $output_username = "";
693 if ($DASSCM_USERNAME) {
694 $output_username = " ($DASSCM_USERNAME)";
695 }
696
697 print "Enter DASSCM user name", $output_username, ": ";
698 $input_username = <STDIN>;
699 chomp($input_username);
[247]700
701 $input_username = $input_username || $DASSCM_USERNAME;
[205]702 }
[203]703
[205]704 # hidden password input
[247]705 print "Enter password for $input_username: ";
[205]706 ReadMode('noecho');
707 my $input_password = <STDIN>;
708 ReadMode('normal');
709 chomp($input_password);
[220]710 print "\n";
[203]711
[247]712 # checking checkout username/password
[252]713 svn_check_credentials( $DASSCM_CHECKOUT_USERNAME,
714 $DASSCM_CHECKOUT_PASSWORD );
[247]715 print "checkout access okay\n";
[205]716
[247]717 svn_check_credentials( $input_username, $input_password );
718
[205]719 #
720 # set environment variables
721 #
[267]722 $ENV{'DASSCM_USERNAME'} = "$input_username";
723 $ENV{'DASSCM_PASSWORD'} = "$input_password";
[205]724
[209]725 print "subversion access okay\n\n", "DASSCM_USERNAME: $input_username\n",
726 "DASSCM_PASSWORD: (hidden)\n", "DASSCM_PROD: $DASSCM_PROD\n",
727 "DASSCM_REPO: $DASSCM_REPO\n",
728 "Server Repository: $DASSCM_SVN_REPOSITORY\n", "\n", "[dasscm shell]\n\n";
[205]729
[235]730 my $shell = $SHELL || "bash";
731 exec($shell) or die "failed to start new shell";
[203]732}
733
[260]734#
735# initialize local checkout directory (initial checkout)
736#
[205]737sub init(@)
738{
739 check_parameter( @_, 1 );
740 check_env();
741
[235]742 # don't do repository creation (svn mkdir) here,
743 # because then their must be a lot of prior checks
744
[205]745 # update complete repository
[216]746 # and create permission file
[208]747 my $retcode =
748 run_interactive(
[252]749 "cd $DASSCM_LOCAL_REPOSITORY_BASE; $SVN checkout $svnCheckoutCredentials $svnOptions $DASSCM_SVN_REPOSITORY; mkdir -p `dirname $permissions_file`; touch $permissions_file"
[208]750 );
[205]751}
752
[215]753sub ls(@)
[186]754{
[205]755 check_parameter( @_, 1 );
756 check_env();
[186]757
[271]758 my @files = svn_ls(@_);
[215]759
[275]760 if (@files) {
[274]761 print join( "\n", @files );
762 print "\n";
763 }
[215]764}
765
766sub update(@)
767{
768 check_parameter( @_, 1 );
769 check_env();
770
771 #
772 # update local repository
773 #
774 svn_update();
775}
776
[237]777#
778# helper function for "add" command
779#
[215]780sub add_helper(@)
781{
[205]782 (
783 my $basename,
784 my $dirname_prod,
785 my $dirname_repo,
786 my $filename_prod,
787 my $filename_repo
788 )
789 = get_filenames( $_[0] );
[186]790
[274]791 mkpath($dirname_repo);
[186]792
[238]793 # TODO: are permissions also copied?
[239]794 copy( $filename_prod, $filename_repo )
795 or error "failed to copy $filename_prod to repository: $!";
[205]796
[274]797 # already checked in?
798 chdir $DASSCM_REPO;
[205]799
[274]800 # also add the path to filename.
801 for my $dir ( split( '/', $dirname_prod ) ) {
802 if ($dir) {
[275]803 my ( $rc, @out ) = run_command("$SVN add --non-recursive '$dir'");
[274]804 if ( $rc > 0 ) {
805 print join( "\n", @out );
[205]806 }
[274]807 chdir $dir;
[205]808 }
809 }
[275]810 my ( $rc, @out ) = run_command("$SVN add '$basename'");
[274]811 if ( $rc > 0 ) {
812 print join( "\n", @out );
813 }
814 chdir $StartDirectory;
815
[215]816}
[205]817
[215]818#
[274]819# adding new files (or directories)
[215]820#
821sub add(@)
822{
823 check_parameter( @_, 1 );
824 check_env();
825
826 #
827 # update local repository
828 #
829 svn_update();
830
[237]831 # get all regular files and links
[239]832 my $href_files = get_files(@_);
[220]833
[237]834 #print Dumper( $href_files );
835
[239]836 my @files = @{ $href_files->{files} };
837 my @links = @{ $href_files->{links} };
[237]838
[239]839 if (@files) {
[237]840 my $number = $#files + 1;
841 print "files to check-in ($number): \n";
842 print join( "\n", @files );
843 print "\n";
844 }
845
[268]846 # TODO: check in links and also link target? At least warn about link target
[239]847 if (@links) {
[237]848 my $number = $#links + 1;
849 print "\n";
850 print "ignoring links ($number):\n";
851 print join( "\n", @links );
852 print "\n";
853 }
854
[238]855 # TODO: confirm
856
[237]857 # copy files one by one to local repository
858 for my $file (@files) {
[239]859
[233]860 # add file
[239]861 add_helper($file);
[233]862 }
863
[215]864 # create new permissions file
865 permissions();
[220]866
[215]867 # add permissions file
[220]868 add_helper($permissions_file);
[215]869
[205]870 if ( $options{'message'} ) {
871 $svnOptions .= " --message \"$options{'message'}\" ";
872 }
873
[239]874 # commit calls $EDITOR.
[237]875 # use "interactive" here, to display output
[215]876 my $retcode =
[205]877 run_interactive(
[267]878 "$SVN commit $svnOptions --username '$DASSCM_USERNAME' $svnPasswordCredentials $DASSCM_REPO"
[208]879 );
[205]880
[274]881 # svn commit does not deliever an error return code, if commit is canceld,
882 # so a revert is performed in any case
883 svn_revert();
[186]884}
885
[271]886#
887# checks in all modified files
888#
889sub commit(@)
890{
891 check_parameter( @_, 1 );
892 check_env();
893
894 (
895 my $basename,
896 my $dirname_prod,
897 my $dirname_repo,
898 my $filename_prod,
899 my $filename_repo
[275]900 )
901 = get_filenames( $_[0] );
[271]902
903 #
904 # update local repository
905 #
906 svn_update();
907
[275]908 ( my $refChangedFiles, my $refRemovedFiles ) =
909 getModifiedFiles($filename_prod);
[271]910 my %changedfiles = %{$refChangedFiles};
911 my %removedfiles = %{$refRemovedFiles};
912
[275]913 if (%removedfiles) {
914 my $removedFilesString =
915 '"' . join( '" "', values(%removedfiles) ) . '"';
916 my ( $rc, @out ) = run_command("$SVN rm $removedFilesString");
[271]917 if ( $rc > 0 ) {
918 print join( "\n", @out );
919 }
920 }
921
922 # copy files one by one to local repository
923 for my $file ( keys(%changedfiles) ) {
[275]924 copy_file_to_repository($file);
[271]925 }
926
927 # create new permissions file
928 permissions();
929
930 # add permissions file
931 add_helper($permissions_file);
932
933 if ( $options{'message'} ) {
934 $svnOptions .= " --message \"$options{'message'}\" ";
935 }
936
937 # commit calls $EDITOR.
938 # use "interactive" here, to display output
939 my $retcode =
940 run_interactive(
941 "$SVN commit $svnOptions --username '$DASSCM_USERNAME' $svnPasswordCredentials $DASSCM_REPO"
942 );
[274]943
944 # svn commit does not deliever an error return code, if commit is canceld,
945 # so a revert is performed in any case
946 svn_revert();
[271]947}
948
[193]949sub blame(@)
950{
[205]951 check_parameter( @_, 1 );
952 check_env();
[193]953
[205]954 (
955 my $basename,
956 my $dirname_prod,
957 my $dirname_repo,
958 my $filename_prod,
959 my $filename_repo
960 )
961 = get_filenames( $_[0] );
962
963 my $retcode = run_interactive("$SVN blame $svnOptions $filename_repo");
[193]964}
965
[187]966sub diff(@)
967{
[205]968 check_parameter( @_, 1 );
969 check_env();
[187]970
[205]971 (
972 my $basename,
973 my $dirname_prod,
974 my $dirname_repo,
975 my $filename_prod,
976 my $filename_repo
977 )
978 = get_filenames( $_[0] );
979
980 #print "$basename,$dirname_prod,$dirname_repo\n";
981
982 ( my $rc_update, my @result ) = run_command("$SVN update $filename_repo");
983 if ( $rc_update != 0 ) {
984 print @result;
985 die;
986 }
987
[238]988 ( my $rc_diff, my @diff_result ) =
[239]989 run_command( $diff . " $filename_repo $filename_prod" );
[238]990
991 print @diff_result;
[187]992}
993
[209]994sub status(@)
995{
996 check_parameter( @_, 1 );
997 check_env();
998
[270]999 (
1000 my $basename,
1001 my $dirname_prod,
1002 my $dirname_repo,
1003 my $filename_prod,
1004 my $filename_repo
1005 )
1006 = get_filenames( $_[0] || "/" );
1007
[252]1008 # return code for the shell
1009 # default: error
1010 my $return_code = $RETURN_NOK;
1011
[209]1012 #
1013 # update local repository
1014 #
[276]1015 svn_update( $filename_prod );
[209]1016
[275]1017 ( my $refChangedFiles, my $refRemovedFiles ) =
1018 getModifiedFiles($dirname_prod);
[268]1019 my %changedfiles = %{$refChangedFiles};
1020 my %removedfiles = %{$refRemovedFiles};
[209]1021
[275]1022 if ( %removedfiles or %changedfiles ) {
[215]1023 if (%removedfiles) {
1024 print "deleted files (found in repository, but not in system):\n";
1025 foreach my $key ( values %removedfiles ) {
[209]1026 print "$key\n";
1027 }
1028 print "\n";
1029 }
1030
[215]1031 if (%changedfiles) {
[209]1032 print "modified files:\n";
[215]1033 foreach my $key ( keys %changedfiles ) {
[209]1034 print "$key\n";
1035 }
1036 }
1037 } else {
[270]1038 print "no modified files found in $dirname_repo\n";
[252]1039 $return_code = $RETURN_OK;
[209]1040 }
[215]1041
[252]1042 return $return_code;
[215]1043}
[209]1044
[270]1045sub permissions()
[215]1046{
1047 check_parameter( @_, 1 );
1048 check_env();
1049
1050 #
1051 # update local repository
1052 #
1053 #svn_update();
1054
[220]1055 my $dir = $DASSCM_REPO;
[275]1056 my @files = svn_ls("/");
[215]1057
1058 if (@files) {
1059
1060 # generieren der Permissions
1061 my @permissions = generatePermissionList(@files);
1062 my $OUTFILE;
1063 my $tofile = 0; # Status für schreiben in File
[220]1064
[215]1065 if ( -w dirname($permissions_file) ) {
1066
1067 # Verzeichnis existiert => schreiben
1068 print "storing permissions in file $permissions_file\n";
1069 open( OUTFILE, ">$permissions_file" )
[216]1070 || die("failed to write to $permissions_file: $!");
[215]1071 $tofile = 1; # Merken, daß in File geschrieben wird
1072 print OUTFILE "#\n";
1073 print OUTFILE "# created by dasscm permissions\n";
[220]1074 print OUTFILE
1075 "# It is intended to be used for restoring permissions\n";
[215]1076 } else {
1077
1078 # Pfad für Sicherungsdatei existiert nicht => schreiben auf stdout
1079 # Alias Filehandle für stdout erzeugen
1080 *OUTFILE = *STDOUT;
1081 }
1082 foreach my $line (@permissions) {
1083 print OUTFILE "$line\n";
1084 }
1085
[220]1086 if ($tofile) {
[215]1087 close(OUTFILE);
1088 }
1089 }
[209]1090}
1091
[274]1092#
1093# remove all uncommited changes in the repository
1094#
1095sub cleanup()
1096{
1097 check_parameter( @_, 1 );
1098 check_env();
[268]1099
[275]1100 svn_revert($DASSCM_REPO);
[274]1101}
1102
[189]1103#####################################################################
1104#
[186]1105# main
[189]1106#
[186]1107
[252]1108my $return_code = $RETURN_OK;
[186]1109my $number_arguments = @ARGV;
1110
[205]1111if ( $number_arguments > 0 ) {
[186]1112
[205]1113 # get subcommand and remove it from @ARGV
1114 $command = $ARGV[0];
1115 shift @ARGV;
[196]1116
[205]1117 $DASSCM_LOCAL_REPOSITORY_BASE = $config->{'DASSCM_LOCAL_REPOSITORY_BASE'};
1118 $DASSCM_REPOSITORY_NAME = $config->{'DASSCM_REPOSITORY_NAME'};
[196]1119
[205]1120 # TODO: check variables
1121 $DASSCM_SVN_REPOSITORY =
1122 $config->{'DASSCM_SVN_REPOSITORY_BASE'} . "/" . $DASSCM_REPOSITORY_NAME;
1123
[247]1124 $DASSCM_CHECKOUT_USERNAME = $config->{'DASSCM_CHECKOUT_USERNAME'};
1125 $DASSCM_CHECKOUT_PASSWORD = $config->{'DASSCM_CHECKOUT_PASSWORD'};
[205]1126
1127 #
1128 # if a user is given by dasscm configuration file, we use it.
1129 # Otherwise we expect that read-only account is configured
1130 # as local subversion configuration.
1131 # If this is also not the case,
1132 # user is required to type username and password.
1133 # This will be stored as local subversion configuration thereafter.
1134 #
1135 if ( $DASSCM_CHECKOUT_USERNAME && $DASSCM_CHECKOUT_PASSWORD ) {
1136 $svnCheckoutCredentials =
1137 " --username $DASSCM_CHECKOUT_USERNAME --password $DASSCM_CHECKOUT_PASSWORD ";
1138 }
1139
1140 # get command line options and store them in options hash
[214]1141 my $result = GetOptions( \%options, 'verbose', 'message=s' );
[205]1142
1143 # print options
1144 foreach my $option ( keys %options ) {
[215]1145 print "${option}: $options{$option}\n";
[205]1146 }
1147
[214]1148 # set verbose to command line option
1149 $verbose = $options{'verbose'};
1150
1151 #
1152 # action accordinly to command are taken
1153 # $command is rewritten in standard format,
1154 # so we can test for it later on more simply
1155 #
[205]1156 $_ = $command;
[274]1157 if (m/^help$/i) {
[205]1158 help(@ARGV);
[274]1159 } elsif (m/^login$/i) {
[208]1160 $command = "login";
[205]1161 login(@ARGV);
[274]1162 } elsif (m/^init$/i) {
[208]1163 $command = "init";
[205]1164 init(@ARGV);
[274]1165 } elsif (m/^ls$/i) {
[215]1166 $command = "ls";
1167 ls(@ARGV);
[274]1168 } elsif ( (m/^update$/i) || (m/^up$/i) ) {
[215]1169 $command = "update";
1170 update(@ARGV);
[274]1171 } elsif (m/^add$/i) {
[205]1172 $command = "add";
1173 add(@ARGV);
[274]1174 } elsif ( (m/^commit$/i) || (m/^checkin$/i) || (m/^ci$/i) ) {
[205]1175 $command = "commit";
[271]1176 commit(@ARGV);
[274]1177 } elsif (m/^blame$/i) {
[208]1178 $command = "blame";
[205]1179 blame(@ARGV);
[274]1180 } elsif (m/^diff$/i) {
[208]1181 $command = "diff";
[205]1182 diff(@ARGV);
[274]1183 } elsif ( (m/^status$/i) || (m/^st$/i) ) {
[252]1184 $command = "status";
1185 $return_code = status(@ARGV);
[274]1186 } elsif (m/^permissions$/i) {
[215]1187 $command = "permissions";
[270]1188 permissions();
[274]1189 } elsif (m/^cleanup$/i) {
1190 $command = "cleanup";
1191 cleanup();
[205]1192 } else {
[215]1193 print "unknown command: $command\n\n";
[205]1194 usage();
1195 check_env();
[252]1196 $return_code = $RETURN_NOK;
[205]1197 }
1198
1199 # revert
[252]1200
[186]1201}
[252]1202
1203exit $return_code;
Note: See TracBrowser for help on using the repository browser.