#! /usr/bin/env perl use strict; use warnings; use Getopt::Std; $Getopt::Std::STANDARD_HELP_VERSION = 1; my %subst_map = ( i => 'EXP_ID', a => 'ATMO_GRID_ID', o => 'OCEAN_GRID_ID', A => 'ATMO_GRID_TYPE', O => 'OCEAN_GRID_TYPE', ); my $direct = 0; my $xlog = ''; my %opts = (); for my $var (keys %subst_map) { $opts{$var} = ''; } getopts('dx'.join(':', keys(%subst_map), ''), \%opts) or die("\n"); exists $opts{d} and $direct = 1; exists $opts{x} and $xlog = '\+'; my %file_info = (); while(<>) { s/^\d{4,}-\d\d-\d\dT\d\d:\d\d:\d\d(?:[,.]\d+)?: //; # Remove log time stamps if(my ($mtd, undef, $src, $dst) = m{^$xlog\s*((cdo|cp|ln)\s.*)\s+(\S+)\s+(\S+)\s*$}) { #DEBUG# warn($_, join(':', $mtd, $src, $dst), "\n"); #DEBUG# # Clean source file name $src =~ s{/+$}{}; $src =~ s{^\./+}{}; # Clean destination file name $dst =~ s{/+$}{}; $dst =~ s{^\./+}{}; my $dir = $src; if($dir =~ m{/}) { $dir =~ s{^(.*)/.*$}{$1}; $src =~ s{^.*/}{}; } else { $dir = '.'; } unless($dst && $dst ne '.') { $dst = $src } $direct and print($_, join(':', $mtd, $dir, $src, $dst), "\n"); my $key = "$dir:$src:$dst"; exists $file_info{$key} and die("duplicate key '$key'\n"); $file_info{$key} = [$mtd, $dir, $src, $dst]; } } sub subst_key($) { my $key = shift; for my $var (keys %subst_map) { if($opts{$var}) { $key =~ s/[._]$opts{$var}//; } } return $key; } sub subst_value($) { my $value = shift; # Hack to avoid clash between exp ID and grid ID my $var = 'i'; if($opts{$var}) { $value =~ s/$opts{$var}(\w)/\${$subst_map{$var}}$1/; $value =~ s/$opts{$var}/\$$subst_map{$var}/; } if($opts{a} && $opts{A}) { $value =~ s/$opts{a}_$opts{A}(\w)/\${$subst_map{a}}_\${$subst_map{A}}$1/; $value =~ s/$opts{a}_$opts{A}/\${$subst_map{a}}_\$$subst_map{A}/; } if($opts{o} && $opts{O}) { $value =~ s/$opts{o}_$opts{O}(\w)/\${$subst_map{o}}_\${$subst_map{O}}$1/; $value =~ s/$opts{o}_$opts{O}/\${$subst_map{o}}_\$$subst_map{O}/; } for my $var (qw(a A o O)) { if($opts{$var}) { $value =~ s:([-_/])$opts{$var}(\w):$1\${$subst_map{$var}}$2:; $value =~ s:([-_/])$opts{$var}:$1\$$subst_map{$var}:; } } ### for my $var (keys %subst_map) { ### if($opts{$var}) { ### $value =~ s/$opts{$var}(\w)/\${$subst_map{$var}}$1/; ### $value =~ s/$opts{$var}/\$$subst_map{$var}/; ### } ### } return $value; } unless($direct) { print("[files]\n"); my $last_mtd = ''; my $last_dir = ''; for my $key (sort(keys %file_info)) { my ($mtd, $dir, $src, $dst) = @{$file_info{$key}}; if($last_dir ne $dir || $last_mtd ne $mtd) { my $subst_dir = subst_value($dir); print(" [[$subst_dir $mtd]]\n"); print(" .base_dir = $subst_dir\n"); print(" .method = $mtd\n"); } if($last_dir ne $dir) { $last_dir = $dir; } if($last_mtd ne $mtd) { $last_mtd = $mtd; } $dst = subst_key($dst); $src = subst_value($src); $src = '.' if $dst eq $src; print(" $dst = $src\n"); ### print(join(' ', @{$file_info{$key}}), "\n"); } }