#!/usr/bin/env perl # +-======-+ # Copyright (c) 2003-2018 United States Government as represented by # the Admistrator of the National Aeronautics and Space Administration. # All Rights Reserved. # # THIS OPEN SOURCE AGREEMENT ("AGREEMENT") DEFINES THE RIGHTS OF USE, # REPRODUCTION, DISTRIBUTION, MODIFICATION AND REDISTRIBUTION OF CERTAIN # COMPUTER SOFTWARE ORIGINALLY RELEASED BY THE UNITED STATES GOVERNMENT AS # REPRESENTED BY THE GOVERNMENT AGENCY LISTED BELOW ("GOVERNMENT AGENCY"). # THE UNITED STATES GOVERNMENT, AS REPRESENTED BY GOVERNMENT AGENCY, IS AN # INTENDED THIRD-PARTY BENEFICIARY OF ALL SUBSEQUENT DISTRIBUTIONS OR # REDISTRIBUTIONS OF THE SUBJECT SOFTWARE. ANYONE WHO USES, REPRODUCES, # DISTRIBUTES, MODIFIES OR REDISTRIBUTES THE SUBJECT SOFTWARE, AS DEFINED # HEREIN, OR ANY PART THEREOF, IS, BY THAT ACTION, ACCEPTING IN FULL THE # RESPONSIBILITIES AND OBLIGATIONS CONTAINED IN THIS AGREEMENT. # # Government Agency: National Aeronautics and Space Administration # Government Agency Original Software Designation: GSC-15354-1 # Government Agency Original Software Title: GEOS-5 GCM Modeling Software # User Registration Requested. Please Visit http://opensource.gsfc.nasa.gov # Government Agency Point of Contact for Original Software: # Dale Hithon, SRA Assistant, (301) 286-2691 # # +-======-+ #======================================================================= # name - datank # purpose - # Provide a set of commands for interfacing with data files stored # in the DataTank. # # Notes # 1. There are two sets of commands: regular and admin # 2. admin commands are invoked by typing "admin" as the first # runtime paramter # 3. admin commands are for setting up the DataTank # 4. regular commands are those which will typically be used in the # day-to-day maintenance of files in the DataTank and in the staged # data directory # 5. this code is based on the concept developed by Arlindo daSilva # (GSFC) to store data file revisions in a "DataTank" # # !Revision History # 05Jun2009 Stassi Initial version. # 09Apr2010 Stassi new commands added; admin commands separated out #======================================================================= use strict; use warnings; # global variables #----------------- my ($admin, $cmd, $script, $Xlabel, %aliases, %descr, %do_not_ask); my ($batch, $datankroot, $checkoutdir, $force, $localonly, $nooverwrite); my (%message, $msgtype, $revision, $verbose, $quiet, @skip, $fflag, $vflag); my (@nonFL, %DTlist); # main program #------------- { init(); if ($admin) { if ($cmd eq "checkout") { checkout(); exit } if ($cmd eq "flimp") { flncvs(); exit } if ($cmd eq "import") { importdt(); exit } if ($cmd eq "help") { help(); exit } } else { if ($cmd eq "add") { add(); exit } if ($cmd eq "annotate") { annotate(); exit } if ($cmd eq "commit") { commit(); exit } if ($cmd eq "flco") { flncvs(); exit } if ($cmd eq "log") { showlog(); exit } if ($cmd eq "sync") { sync(); exit } if ($cmd eq "stage") { stage(); exit } if ($cmd eq "update") { update(); exit } if ($cmd eq "help") { help(); exit } } # if code gets here, then $cmd is not correct #-------------------------------------------- print "\n!!! Unknown $script command: $cmd !!!!\n"; show_commands(); } #...................................................................... # name - init # purpose - get runtime flags #...................................................................... sub init { use File::Basename; use Getopt::Long; my ($admflg, $user_message, $recurse); # check for admin commands #------------------------- $admflg = alias($ARGV[0]) if $ARGV[0]; $admflg = "" unless $admflg; if ($admflg eq "admin") { $admin = " admin"; shift @ARGV } else { $admin = "" } $script = basename $0; $script .= $admin; # get runtime options #------------------------------------------------------- # THESE MUST BE SINGLE LETTER BECAUSE OF BUNDLING OPTION #------------------------------------------------------- Getopt::Long::Configure ("bundling", "pass_through", "no_ignore_case"); GetOptions("b" => \$batch, "D=s" => \$datankroot, "d=s" => \$checkoutdir, "f" => \$force, "l" => \$localonly, "N" => \$nooverwrite, "m=s" => \$user_message, "r=i" => \$revision, "R" => \$recurse, "q" => \$quiet, "I=s@" => \@skip); if ($quiet) { $verbose = 0 } else { $verbose = 1 } $localonly = 0 if $recurse; # hash containing command aliases #-------------------------------- $aliases{"add" } = "ad"; $aliases{"admin" } = "adm"; $aliases{"annotate"} = "an ann anno"; $aliases{"checkout"} = "co get"; $aliases{"commit" } = "com comm"; $aliases{"flco" } = "flget"; $aliases{"flimp" } = "flim"; $aliases{"help" } = "he"; $aliases{"import" } = "im imp"; $aliases{"log" } = "lo"; $aliases{"stage" } = "st sta"; $aliases{"sync" } = "syn"; $aliases{"update" } = "up upd"; # hash containing command descriptions #------------------------------------- if ($admin) { $descr{"checkout"} = "Checkout latest revision of DataTank files"; $descr{"flimp" } = "Wrapper for CVS import of FlexLinks"; $descr{"help" } = "Display help information"; $descr{"import" } = "Import files and directories into DataTank"; $descr{"stage" } = "Stage data links from a tree of flexlinks"; } else { $descr{"add" } = "Add file to be imported to DataTank"; $descr{"admin" } = "Run admin commands"; $descr{"annotate"} = "Add description to file log"; $descr{"commit" } = "Commit changed file back to DataTank"; $descr{"flco" } = "Wrapper for CVS checkout of FlexLinks"; $descr{"help" } = "Display help information"; $descr{"log" } = "Display log information for a file"; $descr{"sync" } = "Add new data from DataTank to staged directory"; $descr{"update" } = "Update a file from DataTank"; } # get datank command #------------------- $cmd = shift @ARGV; $cmd = alias($cmd); show_commands() unless $cmd; # message is either file description or log revision message #----------------------------------------------------------- $msgtype = 0; $msgtype = "fdsc" if $cmd eq "add" or $cmd eq "annotate"; $msgtype = "lmsg" if $cmd eq "flimp" or $cmd eq "commit" or $cmd eq "import"; $message{$msgtype} = $user_message if defined($user_message); # create label to use in abort messages #-------------------------------------- $Xlabel = "$script [$cmd aborted]"; } #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ # ADD command #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ #...................................................................... # name - add # purpose - add file(s) to DataTank # # Runtime arguments # => filename: name of file(s) to add to DataTank #...................................................................... sub add { my (@files, $name, $root, $basename); my ($rev, $template, $logfile); # check runtime arguments for files #---------------------------------- wrongInputs() unless scalar(@ARGV) >= 1; @files = @ARGV; foreach $name (@files) { # skip directories and files identified to skip #---------------------------------------------- if (-d $name) { print "$script $cmd: skipping directory $name\n"; next; } if (skip($name)) { print "$script $cmd: skipping $name\n"; next; } # file already in DataTank #------------------------- $template = get_repository_template($name); $rev = last_repository_rev($template); if ($rev) { print "$script $cmd: $name already in DataTank with rev, $rev\n"; next; } # logfile already in DataTank #---------------------------- $logfile = "${template};log"; if (-e $logfile) { print "$script $cmd: logfile for $name already exists\n"; } else { $rev = 0; write_log($template, $rev); } print "use '$script commit' to add $name permanently to DataTank\n"; } } #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ # ANNOTATE command #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ #...................................................................... # name - annotate # purpose - add file descriptions into log files # # Runtime arguments # => @filename: list of files for which to add description #...................................................................... sub annotate { my (@files, $name, @dirArr, @fileArr); # check runtime arguments for files #---------------------------------- @files = @ARGV; @files = (<*>) unless @files; # annotate each file #------------------- print "\nGive 1-line file descriptions\n" unless $message{"fdsc"}; foreach $name (@files) { if (-d $name) { push @dirArr, $name } else { push @fileArr, $name } } foreach $name (@fileArr) { annotate_file($name) } foreach $name (@dirArr) { annotate_dirfiles($name) } } #...................................................................... # name - annotate_dirfiles # purpose - annotate each file in a directory # # input parameter # => dir: name of directory containing files for which to add description #...................................................................... sub annotate_dirfiles { my ($dir, @files, $name, @dirArr, @fileArr); # short-circuit if local-only #---------------------------- return if $localonly; # input parameter #---------------- $dir = shift @_; @files = <$dir/*>; foreach $name (@files) { if (-d $name) { push @dirArr, $name } else { push @fileArr, $name } } foreach $name (@fileArr) { annotate_file($name) } foreach $name (@dirArr) { annotate_dirfiles($name) } } #...................................................................... # name - annotate_file # purpose - add description of file into its log # # input parameter # => filename: name of file for which to add description #...................................................................... sub annotate_file { use XML::Simple; my ($filename, $descript); my ($root, $repository, $basename); my ($template, $logfile, $hashref, $xmlref); # input parameter #---------------- $filename = shift @_; ($root, $repository, $basename) = root_repos_name($filename); # determine logfile #------------------ $template = get_repository_template($filename); $logfile = "${template};log"; die "$Xlabel: $logfile not found;" unless -e $logfile; # extract information from logfile #--------------------------------- $hashref = XMLin($logfile, forcearray=>["rev"]); $descript = get_message("$basename: "); $hashref->{file}->{description} = $descript; # convert hash to XML format #--------------------------- $xmlref = XMLout($hashref); # write XML to logfile #--------------------- print "annotating $logfile\n" unless $quiet; open LOG, "> $logfile" or die "$Xlabel: error open $logfile: $!"; print LOG $xmlref or die "$Xlabel: error print $logfile: $!"; close LOG or die "$Xlabel: error close $logfile: $!"; return; } # end ANNOTATE command #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ # CHECKOUT command #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ #...................................................................... # name - checkout # purpose - command for checking out the data from the DataTank # # Runtime arguments # => desthead: top directory location for the checked out data # # Notes: # 1. The location of the DataTank must be specified, either by the # environment variable, $DATANKROOT, or with the -d flag. # 2. This command checks out the entire set of data in the DataTank. # 3. If more than one revision of a data file is available, only the # latest revision is grabbed. #...................................................................... sub checkout { my $desthead; # runtime arguments #------------------ $desthead = $checkoutdir; $desthead = "ExtData" unless $desthead; $desthead = clean_name($desthead); # verify before proceeding #------------------------- verify("Checkout files from DATATANKROOT directly " ."to staged data directory: $desthead"); # check out data #--------------- check_datankroot_envvar("1"); makepath($desthead); checkout_dir($datankroot, $desthead); } #...................................................................... # name - checkout_dir # purpose - check out files from a DataTank directory # # input parameters # => dir: directory within DataTank to check out # => desthead: top directory location for checked out data # # Notes: # 1. This routine calls itself recursively for subdirectories. # 2. This routine is intentionally structured to checkout files within # a directory before moving to its subdirectories. This will keep # the code from querying to clean a destination directory after files # have been checked out into its subdirectories. #...................................................................... sub checkout_dir { my ($datankdir, $desthead); my ($dir, @dirArr, $name, $rev, $key, %revision, %head); # input parameters #----------------- $datankdir = shift @_; $desthead = shift @_; foreach $name (<$datankdir/*>) { # identify directory files #------------------------- if (-d $name) { push @dirArr, $name; next; } # extract revision number of file #-------------------------------- $rev = file_revision_number($name); next unless $rev; ($key = $name) =~ s/;$rev//; $revision{$key} = 0 unless $revision{$key}; # determine whether file is latest revision #------------------------------------------ if ($rev > $revision{$key}) { $revision{$key} = $rev; $head{$key} = $name; } } # checkout plain files #--------------------- foreach (keys %head) { checkout_file($head{$_}, $desthead) } # checkout directory files #------------------------- foreach $dir (@dirArr) { checkout_dir($dir, $desthead) } write_hidden_files($desthead, $desthead); } #...................................................................... # name - checkout_file # purpose - check out an individual DataTank file # # input parameters # => datafile: file within DataTank to check out # => desthead: top directory location for checked out data #...................................................................... sub checkout_file { use File::Basename; use File::Path; my ($datafile, $desthead); my ($stub, $symlnk, $symlnkdir, $ans); # input parameters #----------------- $datafile = shift @_; $desthead = shift @_; ($stub = $datafile) =~ s/$datankroot\///; $symlnk = remove_rev("$desthead/$stub"); $symlnkdir = dirname $symlnk; makepath($symlnkdir); # overwrite pre-existing file? #----------------------------- if (-e $symlnk) { unless ($force) { inquireYN("$script: $symlnk already exists\noverwrite it", \$ans) unless $nooverwrite; unless ($ans eq "y") { $do_not_ask{$symlnkdir} = 1; return; } } rmtree($symlnk,$verbose) or die "$Xlabel: error rmtree $symlnk: $!"; } # create link to datank file #--------------------------- print "$symlnk\n" unless $quiet; symlink $datafile, $symlnk or die "$Xlabel: error symlink $datafile $symlnk: $!"; } # end CHECKOUT command #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ # COMMIT command #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ #...................................................................... # name - commit # purpose - command for saving a new revision of a file back to the # DataTank and updating the file's log # # Runtime arguments # => filename: file to be committed # # Notes: # 1. filename can contain its directory path info but is not required to do so # 2. $template = $root/$repository/$basename #...................................................................... sub commit { use File::Basename; use File::Compare; use File::Copy; my (@files, $name, $basename, $template, $logfile); my ($head, $status, $revA, $revB, $revL); my ($newfile, $save); # check runtime arguments for files #---------------------------------- wrongInputs() unless scalar(@ARGV) >= 1; @files = @ARGV; # commit each file #----------------- foreach $name (@files) { $basename = basename $name; $template = get_repository_template($name); # check existence of log file #---------------------------- $logfile = $template .";log"; die "use '$script add' to create an entry for '$name'\n" . "$Xlabel: correct above errors first!\n" unless -e $logfile; # compare to latest revision, if file already in DataTank #-------------------------------------------------------- $revA = last_repository_rev($template, "1"); if ($revA) { $head = "${template};$revA"; $status = compare($name, $head); unless ($status) { print "$basename: file is unchanged; " . "reverting to previous revision $revA\n"; next; } } $message{$msgtype} = get_message(); # get new revision number (revB) #------------------------------- $revL = last_log_rev($name); if ($revA > $revL) { $revB = $revA + 1 } else { $revB = $revL + 1 } # copy file to repository #------------------------ $newfile = "${template};$revB"; unless (copy $name, $newfile) { die "$Xlabel: error copy $name, $newfile\n$!"; } print "$newfile\n" unless $quiet; $quiet = 1; # update log file #---------------- write_log($template, $revB); # update link to point to DataTank #--------------------------------- $save = 0; unless (-l $name) { $save = 1 if -f $name } $revision = 0; # zero-out revision so that latest is retrieved update_file($name, $save); } } # end COMMIT command #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ # FLNCVS command #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ #...................................................................... # name - flncvs # purpose - wrapper for cvs import and checkout of FlexLinks # # key local variables # => $pre_add: cvs options which must precede repository name # => $post_add: this contains repository name, vendortag, and releasetag # # notes # 1. @ARGV potentially contains other cvs flags # 2. The advantage of using this wrapper versus using the CVS command # directly is that it automatically points to the correct CVSROOT # location. # 3. It is necessary to capture the message and explicitly pass it through # to the CVS command rather than letting it pass through in @ARGV. This # is because a mult-word message does not get passed correctly in @ARGV. #...................................................................... sub flncvs { use Cwd; my ($DATANKROOT, $cvscmd, $CVSrepository, $lcmd); my ($post_add, $pre_add, $str); # checks and initializations #--------------------------- check_datankroot_envvar("1"); mkdir "$datankroot/CVSROOT" unless -d "$datankroot/CVSROOT"; $CVSrepository = "FlexLinks"; # get CVS command #---------------- $cvscmd = "checkout" if $cmd eq "flco"; $cvscmd = "import" if $cmd eq "flimp"; die "$Xlabel: unrecognizable flncvs command: $cmd;" unless $cvscmd; # special handling for cvs import command #---------------------------------------- if ($cvscmd eq "import") { $post_add = "$CVSrepository vtag rtag"; push @ARGV, $post_add; } # special handling for cvs checkout command #------------------------------------------ if ($cvscmd eq "checkout") { $checkoutdir = "Flexlinks" unless $checkoutdir; $post_add = "-d $checkoutdir $CVSrepository"; push @ARGV, $post_add; } # verify before proceeding #------------------------- $str = "Checkout from FlexLinks CVS repository to directory: $checkoutdir" if $cvscmd eq "checkout"; $str = "Import flexlinks from local directory to FlexLinks CVS repository" if $cvscmd eq "import"; verify($str); if ($cvscmd eq "import") { @nonFL = (); check_fl_import(cwd) } # pass message through to cvs command #------------------------------------ $message{$msgtype} = get_message() if $cvscmd eq "import"; $pre_add = "-m \"$message{$msgtype}\"" if $message{$msgtype}; unshift @ARGV, $pre_add if $pre_add; # send CVS command #----------------- $lcmd = "cvs -d $datankroot $cvscmd @ARGV"; print "$lcmd\n"; system $lcmd; } #...................................................................... # name - check_fl_import # purpose - check whether list contains only flexlink files # # input parameter # => @filelist: list of files # # global variable # => @nonFL: list of non-flexlink files found; this array should be # nulled-out prior to calling this routine # Notes # 1. this routine calls itself recursively for directory files # 2. this routine exits if non-flexlink file found #...................................................................... sub check_fl_import { my (@filelist, $name, @plain, @dirs, @dirlist); # input parameter #---------------- @filelist = @_; # separate filelist into plain files and directory files #------------------------------------------------------- foreach $name (@filelist) { push @plain, $name if -f $name; push @dirs, $name if -d $name; } # check whether plain files are flexlinks #---------------------------------------- foreach $name (@plain) { push @nonFL, $name unless $name=~/\@$/ } if (@nonFL) { print "$Xlabel: Cannot import non-flexlink files " . "into CVS repository of flexlinks:\n"; foreach (@nonFL) { print " - $_\n" } die; } # now check the directory files #------------------------------ foreach $name (@dirs) { @dirlist = (<$name/*>); check_fl_import(@dirlist); } } # end FLNCVS command #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ # IMPORT command #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ #...................................................................... # name - importdt # purpose - import data from local directory into the DataTank # # Runtime arguments # => repoz: repository in DataTank in which data is to be imported # => @files: files and/or directories to import into the DataTank; # defaults to files in local directory if not supplied #...................................................................... sub importdt { use Cwd ("abs_path", "cwd"); my ($repoz, $repozdir, @add, $name, $pwd); check_datankroot_envvar("0"); $pwd = cwd; # check runtime arguments for repository name #-------------------------------------------- wrongInputs() unless scalar(@ARGV) >= 1; $repoz = shift @ARGV; $repoz = clean_name($repoz); # verify before proceeding #------------------------- verify("Import data files from local directory to DATANKROOT repository"); # create repository directory in Datankroot, if it does not already exist #------------------------------------------------------------------------ $repozdir = "$datankroot/$repoz"; makepath($repozdir, "1"); # prompt for message, if not supplied #------------------------------------ $message{$msgtype} = get_message(); # check that all remaining arguments represent files or directories #------------------------------------------------------------------ @add = @ARGV; foreach (@add) { die "Xlabel: not found: $_\n" unless -e $_ } push @add, $pwd unless @add; # import data into the repository #-------------------------------- foreach $name (@add) { $name = abs_path($name); if (-d $name) { print "name = $name\n"; import_dir ($name, $pwd, $repozdir); } else { import_file($name, $pwd, $repozdir); } } return; } #...................................................................... # name - import_dir # purpose - import a directory into the DataTank # # input parameters # => dir: directory containing data to import into DataTank # => root: main root of directory being imported into DataTank # => repozdir: Datank repository where data is being imported # # Notes: # 1. This routine calls itself recursively for subdirectories. # 2. This routine is intentionally structured to import files within # a directory before moving to its subdirectories. This will keep # the code from querying to clean a DataTank directory after files # have been imported to its subdirectories. #...................................................................... sub import_dir { my ($dir, $root, $repozdir, $name); my (@dirArr, @fileArr); # input parameters #----------------- $dir = shift @_; $root = shift @_; $repozdir = shift @_; return if skip($dir); if ($localonly) { return unless $dir eq $root } # empty arrays if not otherwise empty #------------------------------------ while (@dirArr) { pop @dirArr } while (@fileArr) { pop @fileArr } # separate directory files from plain files #------------------------------------------ foreach $name (<$dir/*>) { if (-d $name) { push @dirArr, $name } else { push @fileArr, $name } } # process plain files; recurse subdirectories #-------------------------------------------- foreach $name (@fileArr) { import_file($name, $root, $repozdir) } foreach $name (@dirArr) { import_dir ($name, $root, $repozdir) } } #...................................................................... # name - import_file # purpose - import an individual file into the DataTank # # input parameters # => file: file to input # => root: main root of directory being imported into DataTank # => repozdir: Datank repository where data is being imported # # Notes: # 1. If the file already exists in the DataTank, then the file is # updated. # 2. The user can specify files to skip by using the -I flag (use # multiple times to skip more than one pattern). For example, # specifying "-I \.hdf" will skip all files which contain the # pattern ".hdf" anywhere within their file names. #...................................................................... sub import_file { use File::Compare; use File::Copy; my ($file, $root, $repozdir); my ($stem, $template, $templatedir, $stub); my ($templateA, $templateV, $rev, $revA); my (@all, $size, $fn, $status); # input parameters #----------------- $file = shift @_; $root = shift @_; $repozdir = shift @_; return if skip($file); # check for existence of file #---------------------------- die "$Xlabel: nothing known about $file\n" unless -e $file; # make template name #--------------------- $stem = $1 if $file =~ /$root\/*(.*)/; $template = "$repozdir/$stem"; $template = clean_name($template); # create datank sudirectory if required #-------------------------------------- $templatedir = dirname $template; makepath($templatedir); # get pre-existing revisions of file #----------------------------------- @all = <$template;*>; $size = scalar(@all); foreach (1..$size) { $fn = shift @all; push @all, $fn if $fn =~ /;(\d+)$/; } # find latest revision #--------------------- $revA = 0; if (@all) { @all = sort @all; $templateA = $all[-1]; $revA = $1 if $templateA =~ /;(\d+)$/; } $rev = $revA + 1; # new revision number # check to see if new revision is different from head #---------------------------------------------------- if ($revA > 1) { $status = compare($file, $templateA); unless ($status) { print "$stem is unchanged; " . "reverting to previous revision $revA\n"; return; } } # copy file to DATANKROOT #------------------------ $templateV = $template . ";$rev"; print "$templateV\n" unless $quiet; copy $file, $templateV or die "$Xlabel: error copy $file $templateV: $!"; write_log($template, $rev); } #...................................................................... # name - skip # purpose - determine whether a file should be skipped during import # (i.e. does it contain a skip pattern within its name) # # input parameter # => name: name of file to check whether it should be skipped # # return value # =0 .. do not skip this file # =1 .. skip this file (i.e. do not import) # # Notes: # 1. The patterns in @skip array are specified with the -I runtime flag #...................................................................... sub skip { use File::Basename; my ($name, $base, $pattern, $skipflg); $name = shift @_; $base = basename($name); $skipflg = 0; foreach $pattern (@skip) { if ($base =~ /$pattern/) { $skipflg = 1; last; } } return $skipflg; } # end IMPORT command #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ # LOG command #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ #...................................................................... # name - showlog # purpose - display DataTank logfile information # # Runtime arguments # => @filename: list of files for which to show the log information #...................................................................... sub showlog { my (@files, $name, @dirArr, @fileArr); # check runtime arguments for files #---------------------------------- @files = @ARGV; @files = (<*>) unless @files; # show log for each file #----------------------- foreach $name (@files) { if (-d $name) { push @dirArr, $name } else { push @fileArr, $name } } foreach $name (@fileArr) { showfilelog($name) } foreach $name (@dirArr) { showdirfilelogs($name) } } #...................................................................... # name - showdirfilelogs # purpose - display log information for each file in a directory # # Runtime arguments # => dir: name of directory containing files for which to show log info #...................................................................... sub showdirfilelogs { my ($dir, @files, $name, @dirArr, @fileArr); # short-circuit if local-only #---------------------------- return if $localonly; # input parameter #---------------- $dir = shift @_; @files = <$dir/*>; foreach $name (@files) { if (-d $name) { push @dirArr, $name } else { push @fileArr, $name } } foreach $name (@fileArr) { showfilelog($name) } foreach $name (@dirArr) { showdirfilelogs($name) } } #...................................................................... # name - showfilelog # purpose - display DataTank log information for a specified file # # Runtime arguments # => filename: name of file for which to show the log information #...................................................................... sub showfilelog { use XML::Simple; my ($filename, $template, $logfile, $hashref, $arrRef); my ($name, $descript, $num, @num, %user, %date, %msg); my ($root, $repository, $basename); # input parameter #---------------- $filename = shift @_; ($root, $repository, $basename) = root_repos_name($filename); # determine logfile #------------------ $template = get_repository_template($filename); $logfile = "${template};log"; die "$Xlabel: $logfile not found;" unless -e $logfile; # extract information from logfile #--------------------------------- $hashref = XMLin($logfile, forcearray=>["rev"]); $arrRef = $hashref->{file}->{rev}; # organize information within hashes #----------------------------------- $name = $hashref->{file}->{name}; $descript = $hashref->{file}->{description}; foreach (0..$#$arrRef) { $num = $hashref->{file}->{rev}[$_]->{num}; $user{$num} = $hashref->{file}->{rev}[$_]->{user}; $date{$num} = $hashref->{file}->{rev}[$_]->{date}; $msg{$num} = $hashref->{file}->{rev}[$_]->{message}; push @num, $num; } @num = reverse sort @num; # write information to standard output #------------------------------------- print "\nname: $basename\n"; print "description: $descript\n" if $descript; print "root: $root\n"; print "repository: $repository\n"; print "\nfile: $name\n"; foreach $num (@num) { print "----------------------------\n"; print "revision: $num\n"; print "date: $date{$num}; author: $user{$num}\n"; print "$msg{$num}\n"; } print "="x77 ."\n"; } # end LOG command #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ # STAGE command #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ #...................................................................... # name - stage # purpose - stage a directory tree of links which point back into the # DataTank, using a directory tree of flexlinks as input. # # Runtime arguments # => flexdir: top directory flexlinks to stage # => desthead: directory location for the staged data #...................................................................... sub stage { use FindBin; my ($flexdir, $desthead, $lcmd); check_datankroot_envvar("1"); # get runtime arguments #---------------------- wrongInputs() unless scalar(@ARGV) == 2; $flexdir = shift @ARGV; $desthead = shift @ARGV; # set flags for calling flexlink stage command #---------------------------------------------- if ($quiet) { $vflag = "-q" } else { $vflag = "" } if ($force) { $fflag = "-f" } else { $fflag = "" } # call flexlink stage command #---------------------------- $lcmd = "$FindBin::Bin/fln admin stage -b $flexdir $desthead $vflag $fflag"; system($lcmd); # write .root and .repository files #---------------------------------- write_hidden_files($desthead, $desthead); } # end STAGE command #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ # SYNC command #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ #...................................................................... # name - sync # purpose - sync the staged data directory with the DataTank; i.e. # add new directories and data files # # Note # 1. This operation will only add files. It will not impact any files # already in the staged data directory. Use the "datank upd" command # to update files to a different version. #...................................................................... sub sync { use Cwd; use File::Find; my ($top, $desthead); my ($root, $repository, $DTdir); my (@list, @notStaged, $ans); # runtime arguments #------------------ $top = shift @ARGV; $top = cwd unless $top; # get DataTank location #---------------------- chdir $top or die "Xlabel: cannot chdir to $top: $!"; $root = get_line(".root"); $repository = get_line(".repository"); # get $datankroot and $desthead from this $root and $repository #-------------------------------------------------------------- $datankroot = $root; ($desthead = $top) =~ s/$repository//; # make list of DataTank files #---------------------------- $DTdir = "$root/$repository"; find(\&findFiles, $DTdir); # list stored in global variable, %DTlist # find DataTank files which do not have corresponding staged file #---------------------------------------------------------------- @list = convert2local(\%DTlist, $DTdir); foreach (@list) { push @notStaged, $_ unless -e } if (@notStaged) { print "NEW FILES found in DATANKROOT\n" } else { print "NO new files were found in DATANKROOT\n"; return } # handle each new file #--------------------- foreach my $name (@notStaged) { inquireYN("ADD STAGED DATA? $name", \$ans); if ($ans eq "y") { add_staged($top, $name) } else { print "file not added\n\n" } } # write .root and .repository files if they do not already exist #--------------------------------------------------------------- write_hidden_files($desthead, $top); # if subdirs have been added } #...................................................................... # name - findFiles # purpose - add names of DataTank files, minus the version number, to # a global hash. # Notes # 1. Used as \&wanted routine in File::Find call from sync() # 2. File names are stripped of the revision number before being # added to the list. # 3. Files without a revision number in their name are not included. #...................................................................... sub findFiles { use Cwd "abs_path"; my ($name, $key); $name = $File::Find::name; if (-f $name) { $name = abs_path($name); $key = remove_rev($name); $DTlist{$key} = 1 if $key ne $name; } } #...................................................................... # name - convert2local # purpose - take a list of DataTank files and substitute "." for # $DATANKROOT in the file path so that the list can be used # to search for files in the staged data directory. #...................................................................... sub convert2local { use Cwd "abs_path"; my ($addr, $DTdir); my (%list, @list, $name, $pwd); # input parameters #----------------- $addr = shift @_; $DTdir = shift @_; %list = %$addr; $DTdir = abs_path($DTdir); foreach $name (sort keys %list) { $name =~ s/$DTdir/./; push @list, $name; } return @list; } #...................................................................... # name - add_staged # purpose - #...................................................................... sub add_staged { use File::Path; my ($desthead, $name); my ($root, $repository, $template); my (@files, @versions, $log); my ($dflt, $ver, $ans); my ($staged, $destdir, $target); # input parameters #----------------- $desthead = shift @_; $name = shift @_; # get DataTank files which match the pattern #------------------------------------------- $root = $datankroot; $repository = get_line(".repository"); $template = clean_name("$root/$repository/$name;"); @files = <$template*>; die "$Xlabel: cannot find DataTank files: $template*\n" unless @files; # extract file extensions #------------------------ foreach (@files) { push @versions, $1 if /.*;(\d+)$/; $log = 1 if /.*;log$/; } @versions = sort numeric @versions; # skip if no log or no versions found for this file #-------------------------------------------------- unless ($log) { print "DataTank log file not found\n"; print "file not added\n\n"; return; } unless (@versions) { print "no versions found\n"; print "file not added\n\n"; return; } # which version? #--------------- $dflt = $versions[-1]; # defaults to latest version if (scalar @versions > 1) { while (1) { print "available versions:"; foreach (@versions) { print " $_" } print "\nwhich version? [$dflt] "; chomp($ver = ); $ver = $dflt unless $ver; last if found($ver, @versions); print "version=$ver is not available. Try again.\n\n"; } } $ver = $dflt unless $ver; $target = $template .$ver; # check for existence of directory #--------------------------------- $staged = clean_name("$desthead/$name"); $destdir = dirname $staged; unless (-d $destdir) { inquireYN("MKDIR $destdir", \$ans); unless ($ans eq "y") { print "file not added\n\n"; return; } mkpath($destdir,$verbose) or die "$Xlabel: error mkpath $destdir: $!"; } # create symbolic link to DataTank file #-------------------------------------- symlink $target, $staged or die "$Xlabel: error symlink $target, $staged: $!"; print "file added\n\n"; } # end SYNC command #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ # UPDATE command #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ #...................................................................... # name - update # purpose - update files from the DataTank # # Runtime arguments # => files: files to update # # Notes: # 1. Use the -r flag to update to a particular revision. This makes more # sense when updating a single file. #...................................................................... sub update { use File::Path; my (@files, $name); # check runtime arguments for files #---------------------------------- wrongInputs() unless scalar(@ARGV) >= 1; @files = @ARGV; # update each file #----------------- foreach $name (@files) { update_file($name) } } #...................................................................... # name - update_file # purpose - update a file from the DataTank # # Runtime arguments # => filename: file to update # => save: (optional) if exists and non-zero, then save copy of # original file, rather than deleting it, prior to updating # the link. # Notes: # 1. The file will be updated with the latest revision from the DataTank # if a revision number is not specified with the -r flag. #...................................................................... sub update_file { use File::Copy; my ($name, $save); my ($template, $updfile, $saveName); $name = shift @_; $save = shift @_; # skip directories #----------------- if (-d $name) { print "$script $cmd: skipping directory $name\n"; print "$script $cmd: not set up to recurse\n" unless $localonly; return; } # update to latest revision, unless other revision given #------------------------------------------------------- $template = get_repository_template($name); $revision = last_repository_rev($template, "1") unless $revision; $updfile = "${template};$revision"; die "$Xlabel: revision $revision not found for file $name;" unless -e $updfile; # either save or delete file if it already exists #------------------------------------------------ if (-e $name and $save) { $saveName = $name."~"; move($name, $saveName); } rmtree($name) if -e $name; # update the link #---------------- symlink $updfile, $name; print "$updfile\n" unless $quiet; return; } # end UPDATE command #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ # UTILITY subroutines #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ #...................................................................... # name - alias # purpose - recognize aliases for the flexlink commands # # input parameter # => cmd: flexlink command # # return value # => long version of command # # Notes: # 1. The aliases for each command are defined in a string in the %aliases hash #...................................................................... sub alias { my ($lcmd, $string); $lcmd = shift @_; return unless $lcmd; foreach (keys %aliases) { $string = $aliases{$_}; if ($string =~ /\b$lcmd\b/) { $lcmd = $_; last; } } return $lcmd; } #...................................................................... # name - check_datankroot_envvar # purpose - check to be sure the datankroot environment variable is defined # # input parameter # => flag: if true (=1), then not only must the datankroot variable be # defined, but the directory it points to must pre-exist. # # Notes: # 1. The datankroot variable can be defined with the runtime flag, -d # 2. datankroot will take the value of the environment variable, # DATANKROOT, if it isn't otherwise defined with the -d runtime flag. #...................................................................... sub check_datankroot_envvar { my $flag; # input parameter #---------------- $flag = shift @_; # determine DATANKROOT value #--------------------------- $datankroot = $ENV{"DATANKROOT"} unless $datankroot; die "$Xlabel: \$DATANKROOT must be defined for command, $cmd;" unless $datankroot; $datankroot = clean_name($datankroot); # check for pre-existence of $datankroot directory #------------------------------------------------- if ($flag) { die "$Xlabel: DATANKROOT directory not found: $datankroot;" unless -d $datankroot; } } #...................................................................... # name - clean_name # purpose - clean file or directory name # # input parameter # => name: name to clean # # return value # => cleaned name #...................................................................... sub clean_name { my ($name, $cleanname, $cnt); $cnt = 0; # input parameter #---------------- $name = shift @_; # remove , leading & trailing blanks, double '/'s, and trailing '/' #---------------------------------------------------------------------- chomp($cleanname = $name); $cleanname = $1 if $cleanname =~ /^\s*(\S+)\s*$/; $cleanname = $1 if $cleanname =~ /^(.+)\/$/; $cleanname =~ s/\/\//\//; # remove all /./'s from path name #-------------------------------- while ($cleanname =~ /\/.\//) { $cleanname =~ s/\/.\//\//; die "$Xlabel: endless loop" if ++$cnt > 100; } return $cleanname; } #...................................................................... # name - found # purpose - determine whether an element is in an array # # input parameters # => $element: element to seek # => @array: array to search # # return values # =0 if not found # =1 if found #...................................................................... sub found { my ($element, @array) = @_; my $found = 0; foreach (@array) { $found = 1 if $element == $_ } return $found; } #...................................................................... # name - get_line # purpose - get a line from an input file # # input parameter # => infile: name of file to read # # return value # => top line read from file # # Notes: # 1. Only the top line of the file is read and returned #...................................................................... sub get_line { my ($infile, $line); # input parameter #---------------- $infile = shift @_; die "$Xlabel: file not found: $infile;" unless -e $infile; # open file and read first line #------------------------------ open(FILE, "< $infile" ) or die "$Xlabel: error opening $infile: $!"; chomp($line = ); close(FILE); die "$Xlabel: error reading $infile: $!" unless defined($line); return $line; } #...................................................................... # name - get_message # purpose - prompt user for file description or log message # # input parameter # => prompt: (optional) line to use when prompting user for input; # default prompt is for log message # return value # => message: description or log message # # Notes: # 1. returns runtime message from -m flag if available # 2. Can only take one line of input # 3. Leading and trailing blanks and quotes are removed from the line. #...................................................................... sub get_message { my ($prompt, $msg); # if this error occurs, then you need another msgtype definition in init() #------------------------------------------------------------------------- die "$Xlabel: msgtype not defined for this command;" unless $msgtype; # return user's input, if available #---------------------------------- return $message{$msgtype} if $message{$msgtype}; # prompt user for input #---------------------- $prompt = shift @_; unless ($prompt) { $prompt = "Enter 1-line log message: " if $msgtype eq "lmsg"; $prompt = "Enter 1-line file description: " if $msgtype eq "fdsc"; } print $prompt; chomp($msg = ); $msg = "" unless defined($msg); # remove leading and trailing blanks and quotes #---------------------------------------------- $msg = $1 if $msg =~ /^[\s\"\']*(\b.+\b)[\s\"\']*$/; return $msg; } #...................................................................... # name - get_repository_template # purpose - find the DataTank file template for a file in a # staged data directory # # input parameter # => filename: name of file for which to find the template # # return value # => DataTank file template #...................................................................... sub get_repository_template { use File::Basename; my ($filename, $root, $repository, $basename, $template); $filename = shift @_; ($root, $repository, $basename) = root_repos_name($filename); $template = "$root/$repository/$basename"; return $template; } #...................................................................... # name - makepath # purpose - fancy mkdir command # # input parameter # => dir: name of directory to mkdir # => flag: if true (=1) then prompt before creating new directory # # Notes: # 1. If the directory already exists, then the user will be prompted # whether or not to first clean the directory ... # 2. ... unless the user is already cd'ed into the directory; then # (s)he will not be given the option to clean it first. # 3. The %do_not_ask hash is used to keep user from being queried # multiple times for the same directory. #...................................................................... sub makepath { use Cwd; use File::Path; my ($dir, $flag, $ans, $here); $dir = shift @_; $here = cwd; if (-d $dir) { # if directory already exists #---------------------------- $do_not_ask{$dir} = 1 if $nooverwrite; return if $do_not_ask{$dir}; return if $dir eq $here; inquireYN("\nDirectory already exists: $dir\nclean it", \$ans); $do_not_ask{$dir} = 1; return unless $ans eq "y"; rmtree($dir,$verbose); } else { # if directory does not already exist #------------------------------------ if ($flag) { $ans = "y"; inquireYN("Directory does not exist: $dir\ncreate it", \$ans); die "Exiting \"$script $cmd\"\n" if $ans eq "n"; } } # make new directory #------------------- mkpath($dir,$verbose) or die "$Xlabel: error mkpath $dir: $!"; $do_not_ask{$dir} = 1; } #...................................................................... # name - last_log_rev # purpose - find the latest revision of file noted in its logfile # # input parameter # => filename: name of file from which to get its latest log revision number # # return value # => max: the largest revision number for file found in its logfile # # input files (in same directory as file) # >> .root # >> .repository # # Notes: # 1. if the latest revision of a file is removed from the DataTank, but # its corresponding entry is not removed from the logfile, then the # next committed revision should take an incremented revision number. #...................................................................... sub last_log_rev { use File::Basename; use XML::Simple; my ($filename, $basename, $dir); my ($root, $repository, $logfile, $hashref, $arrRef); my ($num, $max); # input parameter #---------------- $filename = shift @_; # determine basename and dir #--------------------------- $basename = basename $filename; $dir = "." if $basename eq $filename; $dir = dirname $filename unless $dir; # get root and repository information #------------------------------------ $root = get_line("$dir/.root"); $repository = get_line("$dir/.repository"); # input information from log file #-------------------------------- $logfile = "$root/$repository/$basename;log"; $hashref = XMLin($logfile, forcearray=>["rev"]); $arrRef = $hashref->{file}->{rev}; # find largest revision number in log file #----------------------------------------- $max = 0; foreach (0..$#$arrRef) { $num = $hashref->{file}->{rev}[$_]->{num}; $max = $num unless $max; $max = $num if $num > $max; } return $max; } #...................................................................... # name - last_repository_rev # purpose - find the latest revision of file in the DataTank # # input parameters # => template: name of DataTank file but without the ending revision number # Example: template ......... /data/tank/dir/myfile # DataTank files ... /data/tank/dir/myfile;1 # /data/tank/dir/myfile;2 # /data/tank/dir/myfile;3 # /data/tank/dir/myfile;log # => flag: if true (=1), then die if neither file nor logfile is in DataTank # # return value # => latest revision number of the file within the DataTank #...................................................................... sub last_repository_rev { my ($template, $flag); my (@files, $file, $last, $size); # input parameter #---------------- $template = shift @_; $flag = shift @_; # find largest revision number in repository #------------------------------------------- @files = (<$template;*>); @files = sort @files; # only include files with revision numbers appended to them #---------------------------------------------------------- $size = scalar @files; foreach (1..$size) { $file = shift @files; push @files, $file if $file =~ /;\d+$/; } # if no files found #------------------ unless (@files) { return "0" if -e "$template;log"; return unless $flag; die "$Xlabel: unable to find repository files for $template;"; } # sort names and then return the revision number from last #--------------------------------------------------------- @files = sort @files; $last = file_revision_number($files[-1]); return $last; } #...................................................................... # name - file_revision_number # purpose - return the revision number found in a file name # (i.e. the numeric value following ";") # # input parameter # => filename: name of file for which to get the revision number # # return value # => revision number found in the file name #...................................................................... sub file_revision_number { my ($filename, $number); $filename = shift @_; $number = ""; $number = $1 if $filename =~ /^.*;(\d+)$/; return $number; } #...................................................................... # name - inquireYN # purpose - get and return response to y/n question # # input parameters # => $prompt: string to prompt for user response # => $addr: address for variable $YN which contains a default response # either "y" or "n"; will be set to "n" unless it equals "y" # # output # => sent back through address, $addr #...................................................................... sub inquireYN { my ($prompt, $addr, $YN, $ans); while (1) { # input parameters #----------------- $prompt = shift @_; $addr = shift @_; $YN = $$addr; # default response is "n" unless user specified "y" #------------------------------------------------- $YN = "n" unless $YN; # concatenate y/n choices and default to prompt #---------------------------------------------- $prompt .= " (y/n) [$YN]? "; # print prompt and get response #------------------------------ print $prompt; chomp($ans = lc ); $ans = $YN unless $ans; $ans = "n" if $ans eq "no"; $ans = "y" if $ans eq "yes"; last if $ans eq "y" or $ans eq "n"; print "Unrecognizable input. Try again\n"; } $$addr = $ans; } #...................................................................... # name - numeric # purpose - used with perl sort command to do a numeric sort #...................................................................... sub numeric { # a sort subroutine, expect $a and $b if ($a < $b) { -1 } elsif ($a > $b) { 1 } else { 0 } } #...................................................................... # name - pause # purpose - pause interactive processing # Note: useful with print statements when debugging code #...................................................................... sub pause { my $dummy; print "Hit to continue ... "; $dummy = ; return; } #...................................................................... # name - remove_rev # purpose - remove the revision number from a file name from the DataTank # # input parameter # => filename: file name from which to remove revision number # # return value # => template: name of DataTank file but without the ending revision number # # Example: remove_rev("fname;5") returns "fname" #...................................................................... sub remove_rev { my ($filename, $template); $filename = shift @_; $template = $filename; $template = $1 if ($template =~ /^(.*);\d+$/); return $template; } #...................................................................... # name - root_repos_name # purpose - find the DataTank root and repository for a file in a # staged data directory; return these values along with the # file's basename # # input parameter # => filename: name of file for which to return root, repository, basename # # input files (in same directory as file) # >> .root # >> .repository # # return values # => root: DataTank root directory # => repository: relative directory location with the DataTank # => basename: basename of file # #...................................................................... sub root_repos_name { use File::Basename; my ($filename, $basename, $dir); my ($root, $repository); # input parameter #---------------- $filename = shift @_; # determine basename and dir #--------------------------- $basename = basename $filename; $dir = "." if $basename eq $filename; $dir = dirname $filename unless $dir; # extract root and repository information #---------------------------------------- $root = get_line("$dir/.root"); $repository = get_line("$dir/.repository"); return $root, $repository, $basename; } #...................................................................... # name - verify # purpose - exit unless user gives positive affirmation #...................................................................... sub verify { my ($string, $ans); $string = shift @_; #----# return if $batch; #----# inquireYN("$string", \$ans); unless ($ans eq "y") { print "$Xlabel\n"; exit } return; } #...................................................................... # name - write_hidden_files # purpose - write hidden files, ".root" and ".repository", with a # staged data directory # # input parameters # => desthead: top directory location for checked out or staged data # => destdir: directory within the checked out or staged directory tree # # Notes # 1. the directory, $destdir, must be a subdirectory of $desthead # 2. This subroutine calls itself recursively for all subdirectories # contained within the directory. #...................................................................... sub write_hidden_files { my ($desthead, $destdir); my ($repository, $reposfile, $rootfile, $name); # input parameters #----------------- $desthead = shift @_; $destdir = shift @_; return unless -d $destdir; return unless $destdir =~ /$desthead/; # determine $repository #---------------------- ($repository = $destdir) =~ s/$desthead//; $repository =~ s/^\///; # do not combine with line above! $repository = "." unless $repository; # write .root and .repository files #---------------------------------- $reposfile = "$destdir/.repository"; $rootfile = "$destdir/.root"; unless (-e $reposfile) { print "$reposfile\n" unless $quiet; open RPOS, "> $reposfile" or die "$Xlabel: Error open $reposfile: $!"; print RPOS "$repository\n" or die "$Xlabel: Error print $reposfile: $!"; close RPOS; } unless (-e $rootfile) { print "$rootfile\n" unless $quiet; open ROOT, "> $rootfile" or die "$Xlabel: Error open $rootfile: $!"; print ROOT "$datankroot\n" or die "$Xlabel: Error print $rootfile: $!"; close ROOT; } # do same for each subdirectory #------------------------------ foreach $name (<$destdir/*>) { write_hidden_files($desthead,$name) if -d $name; } } #...................................................................... # name - write_log # purpose - write an entry to a file's DataTank logfile # # input parameters # => template: Datank template of file for which to write log entry # => rev: revision number of file # # Notes: # 1. If revision number of file is "0", then only write file name and # descriptionto logfile. #...................................................................... sub write_log { use XML::Simple; use Data::Dumper; my ($template, $rev, $index); my ($user, $date, $msg, $descript, $logfile); my ($hashref, $xmlref); # input parameters #----------------- $template = shift @_; $rev = shift @_; $logfile = $template .";log"; # determine array index, user, and date/time #------------------------------------------- $index = $rev - 1; $user = $ENV{"USER"}; chomp($date = `date "+%D %T %Z"`); # get log message or file description, if either is available #------------------------------------------------------------ $msg = $message{"lmsg"} if $message{"lmsg"}; $descript = $message{"fdsc"} if $message{"fdsc"}; # write logfile #-------------- $hashref->{file}->{description} = $descript if $descript; if (-e $logfile) { # update old ... ? #----------------- if ($rev == 1) { $msg = "Initial revision" unless $msg } $hashref = XMLin($logfile, forcearray=>["rev"]); $hashref->{file}->{rev}[$index]->{user} = $user; $hashref->{file}->{rev}[$index]->{date} = $date; $hashref->{file}->{rev}[$index]->{num} = $rev; $hashref->{file}->{rev}[$index]->{message} = $msg; } else { # ... or write new? #------------------ $hashref->{file}->{name} = $template; unless ($rev eq "0") { $msg = "Initial revision" unless $msg; $hashref->{file}->{rev}->{user} = $user; $hashref->{file}->{rev}->{date} = $date; $hashref->{file}->{rev}->{num} = $rev; $hashref->{file}->{rev}->{message} = $msg; } } # convert hash to XML format #--------------------------- $xmlref = XMLout($hashref); # write XML to logfile #--------------------- print "$logfile\n" unless $quiet; open LOG, "> $logfile" or die "$Xlabel: error open $logfile: $!"; print LOG $xmlref or die "$Xlabel: error print $logfile: $!"; close LOG or die "$Xlabel: error close $logfile: $!"; return; } #...................................................................... # name - wrongInputs # purpose - Print message that input parameters are incorrect and then # call the helpme subroutine. #...................................................................... sub wrongInputs { print "$Xlabel: incorrect number of input parameters.\n"; helpme($cmd); } # end UTILITY subroutines #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ # HELP command #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ #...................................................................... # name - help # purpose - print help information about datank commands # # Runtime arguments # => cmd (optional): datank command # # Notes: # 1. If no argument is supplied, then a list of possible commands is printed. # 2. If an argument is supplied, then help for that particular command # is printed. #...................................................................... sub help { my $lcmd; # datank command for which to get help #------------------------------------- $lcmd = shift @ARGV; if ($lcmd) { helpme($lcmd) } else { show_commands() } } #...................................................................... # name - helpme # purpose - print command-specific help # # input parameter # => cmd: command for which to print help info # # Notes: # 1. If an unrecognized command is given, then the show_commands() # subroutine is called. #...................................................................... sub helpme { my ($lcmd, $key, %help); # input parameter #---------------- $lcmd = shift @_; $key = alias($lcmd) if $lcmd; # initialize hash containing command-specific help #------------------------------------------------- $help{"add"} = "file(s) [options]\n" . "Options: -m message file description"; $help{"admin"} = "[command]\n" . "Type '$script admin help' to see list of commands"; $help{"annotate"} = "[files] [options]\n" . "Options: -l local; do not recurse subdirectories\n" . " -m message file description (annotation)\n" . " -R Annotate directories recursively. " . "This option is on by default\n" . "Defaults to local directory if no files specified.\n" . "User will be prompted for annotation if none given with -m flag."; $help{"checkout"} = "[options]\n" . "Options: -D \$DATANKROOT location of DATANKROOT\n" . " -d dir checkout directory name " . "(defaults to ExtData)\n" . " -f force overwrite of pre-existing links\n" . " -N do not overwrite pre-existing links\n" . " -q quiet mode (default is verbose)"; $help{"commit"} = "file [options]\n" . "Options: -m message log information"; $help{"flco"} = "[options]\n" . " -b batch mode; do not ask user to verify\n" . "other options: use cvs checkout command options\n" . "Example: $script flco -d FL"; $help{"flimp"} = "[options]\n" . " -b batch mode; do not ask user to verify\n" . "other options: use cvs import command options\n" . "Example: $script flimp -m'import dir into CVS repository'"; $help{"help"} = "[command]"; $help{"import"} = "repository [options]\n" . "Options: -D \$DATANKROOT location of DATANKROOT\n" . " -I spec Ignore; i.e. do not import file if " . "'spec' is substring of filename\n" . " (can be used multiple times)\n" . " -f force overwrite of pre-existing links\n" . " -N do not overwrite pre-existing links\n" . " -l local; do not recurse subdirectories\n" . " -R Import directories recursively. " . "This option is on by default\n" . " -m message log information\n" . " -q quiet mode (default is verbose)\n" . " -R Import directories recursively. " . "This option is on by default\n" . "Example: $script import /share/fvInput/g5chem -I \\.hdf -I \\.old"; $help{"log"} = "[filenames]\n" . "Options: -l local; do not recurse subdirectories"; $help{"stage"} = "/path/to/flexlink/dir /path/to/dest [options]\n" . "Options: -f force overwrite of pre-existing links\n" . " -q quiet mode (default is verbose)"; $help{"sync"} = "[/path/to/staged/data] [options]\n" . " -l local; do not recurse subdirectories\n" . "Defaults to local directory if /path/to/staged/data not given\n"; $help{"update"} = "file [options]\n" . "Options: -q quiet mode (default is verbose)\n" . " -r rev revision number\n" . "Example: $script update myfile -r 2"; # print help for specified command if available #---------------------------------------------- if ($lcmd and defined($help{$key})) { print "Usage: $script $key $help{$key}\n"; print "Aliases: $aliases{$key}\n" if $aliases{$key}; print "Purpose: ". $descr{$key} ."\n"; print "\n"; exit; } # else, print list of commands #----------------------------- print "\n!!! Unknown $script command: $lcmd !!!\n" if $lcmd; show_commands(); } #...................................................................... # name - show_commands # purpose - print the list of datank commands with a brief description of each #...................................................................... sub show_commands { my $key; # print list of commands and descriptions #---------------------------------------- print "Usage: $script command [command-options-and-arguments]\n" . "where $script commands are:\n"; foreach $key (sort keys %descr) { printf "%8s%-18s%-s%s", "", $key, $descr{$key}, "\n"; } print "Type \"$script help 'command'\" for command-specific help\n\n"; exit; } # end HELP command