source: trunk/dasscm/dasscm@ 274

Last change on this file since 274 was 274, checked in by joergs, on Mar 5, 2009 at 12:47:53 AM

removed commitall again and replced it with improved version of commit. Path handling is improved. Bugfixes

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