# IBM(c) 2007 EPL license http://www.eclipse.org/legal/epl-v10.html ##################################################### # # xCAT plugin package to handle various commands that work with the # xCAT tables # ##################################################### package xCAT_plugin::tabutils; use strict; use warnings; use xCAT::Table; use xCAT::Schema; use Data::Dumper; use xCAT::NodeRange qw/noderange abbreviate_noderange/; use xCAT::Schema; use xCAT::Utils; use xCAT::MsgUtils; use xCAT::DBobjUtils; use Getopt::Long; my $requestcommand; 1; #some quick aliases to table/value my %shortnames = ( groups => [qw(nodelist groups)], tags => [qw(nodelist groups)], mgt => [qw(nodehm mgt)], #switch => [qw(switch switch)], ); ##################################################### # Return list of commands handled by this plugin ##################################################### sub handled_commands { return { gettab => "tabutils", tabdump => "tabutils", lsxcatd => "tabutils", tabprune => "tabutils", tabrestore => "tabutils", tabch => "tabutils", nodegrpch => "tabutils", nodech => "tabutils", nodeadd => "tabutils", noderm => "tabutils", tabls => "tabutils", # not implemented yet nodels => "tabutils", getnodecfg => "tabutils", # not implemented yet (?? this doesn't seem much different from gettab) addattr => "tabutils", # not implemented yet delattr => "tabutils", # not implemented yet chtype => "tabutils", # not implemented yet nr => "tabutils", # not implemented yet rnoderange => "tabutils", # not implemented yet tabgrep => "tabutils", gennr => "tabutils" }; } # Each cmd now returns its own usage inside its function ##################################################### # Process the command ##################################################### sub process_request { #use Getopt::Long; Getopt::Long::Configure("bundling"); #Getopt::Long::Configure("pass_through"); Getopt::Long::Configure("no_pass_through"); my $request = shift; my $callback = shift; $requestcommand = shift; my $nodes = $request->{node}; my $command = $request->{command}->[0]; my $args = $request->{arg}; #unless ($args or $nodes or $request->{data}) #{ #if ($usage{$command}) #{ #$callback->({data => [$usage{$command}]}); #return; #} #} if ($command eq "nodels") { return nodels($nodes, $args, $callback, $request->{emptynoderange}->[0]); } elsif ($command eq "rnoderange") { return rnoderange($nodes,$args,$callback); } elsif ($command eq "noderm" or $command eq "rmnode") { return noderm($nodes, $args, $callback); } elsif ($command eq "nodeadd" or $command eq "addnode") { return nodech($nodes, $args, $callback, 1); } elsif ($command eq "nodegrpch" or $command eq "chnodegrp") { return nodech($nodes, $args, $callback, "groupch"); } elsif ($command eq "gennr") { return gennr($nodes, $args, $callback); } elsif ($command eq "nodech" or $command eq "chnode") { return nodech($nodes, $args, $callback, 0); } elsif ($command eq "tabrestore") { return tabrestore($request, $callback); } elsif ($command eq "tabdump") { return tabdump($args, $callback); } elsif ($command eq "lsxcatd") { return lsxcatd($args, $callback); } elsif ($command eq "tabprune") { return tabprune($args, $callback); } elsif ($command eq "gettab") { return gettab($request, $callback); } elsif ($command eq "tabgrep") { return tabgrep($nodes, $callback); } elsif ($command eq "tabch"){ return tabch($request, $callback); } else { print "$command not implemented yet\n"; return (1, "$command not written yet"); } } # Display particular attributes, using query strings. sub gettab { my $req = shift; my $callback = shift; my $HELP; my $NOTERSE; my $gettab_usage = sub { my $exitcode = shift @_; my %rsp; push @{$rsp{data}}, "Usage: gettab [-H|--with-fieldname] key=value,... table.attribute ..."; push @{$rsp{data}}, " gettab [-?|-h|--help]"; if ($exitcode) { $rsp{errorcode} = $exitcode; } $callback->(\%rsp); }; # Process arguments if (!defined($req->{arg})) { $gettab_usage->(1); return; } @ARGV = @{$req->{arg}}; if (!GetOptions('h|?|help' => \$HELP,'H|with-fieldname' => \$NOTERSE)) { $gettab_usage->(1); return; } if ($HELP) { $gettab_usage->(0); return; } if (scalar(@ARGV)<2) { $gettab_usage->(1); return; } # Get all the key/value pairs into a hash my $keyspec = shift @ARGV; my @keypairs = split /,/, $keyspec; my %keyhash; foreach (@keypairs) { (my $key, my $value) = split /=/, $_; unless (defined $key) { $gettab_usage->(1); return; } $keyhash{$key} = $value; } # Group the columns asked for by table (so we can do 1 query per table) my %tabhash; my $terse = 2; if ($NOTERSE) { $terse = 0; } foreach my $tabvalue (@ARGV) { $terse--; (my $table, my $column) = split /\./, $tabvalue; $tabhash{$table}->{$column} = 1; } #Sanity check the key against all tables in question foreach my $tabn (keys %tabhash) { foreach my $kcheck (keys %keyhash) { unless (grep /^$kcheck$/, @{$xCAT::Schema::tabspec{$tabn}->{cols}}) { $callback->({error => ["Unkown key $kcheck to $tabn"],errorcode=>[1]}); return; } } } # Get the requested columns from each table foreach my $tabn (keys %tabhash) { my $tab = xCAT::Table->new($tabn); (my $ent) = $tab->getAttribs(\%keyhash, keys %{$tabhash{$tabn}}); foreach my $coln (keys %{$tabhash{$tabn}}) { if ($terse > 0) { $callback->({data => ["" . $ent->{$coln}]}); } else { $callback->({data => ["$tabn.$coln: " . $ent->{$coln}]}); } } $tab->close; } } sub noderm { my $nodes = shift; my $args = shift; my $cb = shift; my $VERSION; my $HELP; my $noderm_usage = sub { my $exitcode = shift @_; my %rsp; push @{$rsp{data}}, "Usage:"; push @{$rsp{data}}, " noderm noderange"; push @{$rsp{data}}, " noderm {-v|--version}"; push @{$rsp{data}}, " noderm [-?|-h|--help]"; if ($exitcode) { $rsp{errorcode} = $exitcode; } $cb->(\%rsp); }; if ($args) { @ARGV = @{$args}; } else { @ARGV = (); } if (!GetOptions('h|?|help' => \$HELP, 'v|version' => \$VERSION) ) { $noderm_usage->(1); return; } if ($HELP) { $noderm_usage->(0); return; } if ($VERSION) { my %rsp; my $version = xCAT::Utils->Version(); $rsp{data}->[0] = "$version"; $cb->(\%rsp); return; } if (!$nodes) { $noderm_usage->(1); return; } my $sitetab = xCAT::Table->new('site'); my $pdhcp = $sitetab->getAttribs({key=>'pruneservices'},['value']); if ($pdhcp and $pdhcp->{value} and $pdhcp->{value} !~ /n(\z|o)/i) { $requestcommand->({command=>['makedhcp'],node=>$nodes,arg=>['-d']}); } # Build the argument list for using the -d option of nodech to do our work for us my @tablist = ("-d"); foreach (keys %{xCAT::Schema::tabspec}) { if (grep /^node$/, @{$xCAT::Schema::tabspec{$_}->{cols}}) { push @tablist, $_; } } if (scalar(@$nodes)) { for my $nn ( @$nodes ) { my $nt = xCAT::DBobjUtils->getnodetype($nn); if ( $nt and $nt =~ /^(cec|frame)$/ ) { my $cnodep = xCAT::DBobjUtils->getchildren($nn); if ($cnodep) { my $cnode = join ',', @$cnodep; if ($cnode) { my $rsp; $rsp->{data}->[0] = "Removed a $nt node, please remove these nodes belongs to it manually: $cnode \n"; xCAT::MsgUtils->message("I", $rsp, $cb); } } } } } nodech($nodes, \@tablist, $cb, 0); } sub tabrestore { # the usage for tabrestore is in the tabrestore client cmd #request->{data} is an array of CSV formatted lines my $request = shift; my $cb = shift; my $table = $request->{table}->[0]; # do not allow teal tables if ( $table =~ /^x_teal/ ) { $cb->({error => "$table is not supported in tabrestore. Use Teal maintenance commands. ",errorcode=>1}); return 1; } my $tab = xCAT::Table->new($table, -create => 1, -autocommit => 0); unless ($tab) { $cb->({error => "Unable to open $table",errorcode=>4}); return; } $tab->delEntries(); #Yes, delete *all* entries my $header = shift @{$request->{data}}; unless ($header =~ /^#/) { $cb->({error => "Data missing header line starting with #",errorcode=>1}); return; } $header =~ s/"//g; #Strip " from overzealous CSV apps $header =~ s/^#//; $header =~ s/\s+$//; my @colns = split(/,/, $header); my $tcol; foreach $tcol (@colns) { #validate the restore data has no invalid column names unless (grep /^$tcol\z/,@{$xCAT::Schema::tabspec{$table}->{cols}}) { $cb->({error => "The header line indicates that column '$tcol' should exist, which is not defined in the schema for '$table'",errorcode=>1}); return; } #print Dumper(grep /^$tcol\z/,@{$xCAT::Schema::tabspec{$table}->{cols}}); } #print "We passed it!\n"; my $line; my $rollback = 0; my @tmp=$tab->getAutoIncrementColumns(); #get the columns that are auto increment by DB. my %auto_cols=(); foreach (@tmp) { $auto_cols{$_}=1;} my $linenumber; my $linecount = scalar(@{$request->{data}}); LINE: for($linenumber = 0; $linenumber < $linecount; $linenumber++) { $line = @{$request->{data}}[$linenumber]; $line =~ s/\s+$//; my $origline = $line; #save for error reporting my %record; my $col; foreach $col (@colns) { if ($line =~ /^,/ or $line eq "") { #Match empty, or end of line that is empty #TODO: should we detect when there weren't enough CSV fields on a line to match colums? if (!exists($auto_cols{$col})) { $record{$col} = undef; } $line =~ s/^,//; } elsif ($line =~ /^[^,]*"/) { # We have stuff in quotes... pain... #I don't know what I'm doing, so I'll do it a hard way.... if ($line !~ /^"/) { $rollback = 1; $cb->( { error => "CSV missing opening \" for record with \" characters on line $linenumber, character " . index($origline, $line) . ": $origline", errorcode=>4 } ); next LINE; } my $offset = 1; my $nextchar; my $ent; while (not defined $ent) { $offset = index($line, '"', $offset); $offset++; if ($offset <= 0) { #the matching quote is not on this line of the file if($linenumber < $linecount) { #it's not the end of the world, we have more lines to check my $continuedline = @{$request->{data}}[++$linenumber]; $offset = length($line); $line .= "\n" . $continuedline; $line =~ s/\s+$//; } else { #the matching quote was not found before the end of the file #MALFORMED CSV, request rollback, report an error $rollback = 1; $cb->( { error => "CSV unmatched \" in record on line $linenumber, character " . index($origline, $line) . ": $origline", errorcode=>4 } ); next LINE; } } else { #the next quote was on the current line $nextchar = substr($line, $offset, 1); if ($nextchar eq '"') { #the case of 2 double quotes. ignore them and move on $offset++; } elsif ($offset eq length($line) or $nextchar eq ',') { #hit the end of the line or at least the end of the column $ent = substr($line, 0, $offset, ''); $line =~ s/^,//; chop $ent; $ent = substr($ent, 1); $ent =~ s/""/"/g; if (!exists($auto_cols{$col})) { $record{$col} = $ent; } } else { $cb->( { error => "CSV unescaped \" in record on line $linenumber, character " . index($origline, $line) . ": $origline", errorcode=>4 } ); $rollback = 1; next LINE; } } } } elsif ($line =~ /^([^,]+)/) { #easiest case, no Text::Balanced needed.. if (!exists($auto_cols{$col})) { $record{$col} = $1; } $line =~ s/^([^,]+)(,|$)//; } } if ($line) { $rollback = 1; $cb->({error => "Too many fields on line $linenumber: $origline | $line", errorcode=>4}); next LINE; } #TODO: check for error from DB and rollback my @rc = $tab->setAttribs(\%record, \%record); if (not defined($rc[0])) { $rollback = 1; $cb->({error => "DB error " . $rc[1] . " with line $linenumber: " . $origline, errorcode=>4}); } } if ($rollback) { $tab->rollback(); $tab->close; undef $tab; return; } else { $tab->commit; #Made it all the way here, commit } } # Display a list of tables, or a specific table in CSV format sub tabdump { my $args = shift; my $cb = shift; my $table = ""; my $HELP; my $DESC; my $OPTW; my $VERSION; my $FILENAME; my $tabdump_usage = sub { my $exitcode = shift @_; my %rsp; push @{$rsp{data}}, "Usage: tabdump [-d] [table]"; push @{$rsp{data}}, " tabdump [table]"; push @{$rsp{data}}, " tabdump [-f ] [table]"; push @{$rsp{data}}, " tabdump [-w attr==val [-w attr=~val] ...] [table]"; push @{$rsp{data}}, " tabdump [-w attr==val [-w attr=~val] ...] [-f ] [table]"; push @{$rsp{data}}, " tabdump [-?|-h|--help]"; push @{$rsp{data}}, " tabdump {-v|--version}"; push @{$rsp{data}}, " tabdump "; if ($exitcode) { $rsp{errorcode} = $exitcode; } $cb->(\%rsp); }; # Process arguments if ($args) { @ARGV = @{$args}; } if (!GetOptions( 'h|?|help' => \$HELP, 'v|version' => \$VERSION, 'd' => \$DESC, 'f=s' => \$FILENAME, 'w=s@' => \$OPTW, ) ) {$tabdump_usage->(1); return; } if ($VERSION) { my %rsp; my $version = xCAT::Utils->Version(); $rsp{data}->[0] = "$version"; $cb->(\%rsp); return; } if ($HELP) { $tabdump_usage->(0); return; } if (scalar(@ARGV)>1) { $tabdump_usage->(1); return; } my %rsp; # If no arguments given, we display a list of the tables if (!scalar(@ARGV)) { # if -f filename give but no table name, display error if ($FILENAME) { $cb->({error => "table name missing from the command input. ",errorcode=>1}); return 1; } if ($DESC) { # display the description of each table my $tab = xCAT::Table->getDescriptions(); foreach my $key (keys %$tab) { my $space = (length($key)<7 ? "\t\t" : "\t"); push @{$rsp{data}}, "$key:$space".$tab->{$key}."\n"; } } else { push @{$rsp{data}}, xCAT::Table->getTableList(); } # if no descriptions, just display the list of table names @{$rsp{data}} = sort @{$rsp{data}}; if ($DESC && scalar(@{$rsp{data}})) { chop($rsp{data}->[scalar(@{$rsp{data}})-1]); } # remove the final newline $cb->(\%rsp); return; } # get the table name $table = $ARGV[0]; # do not allow teal tables if ( $table =~ /^x_teal/ ) { $cb->({error => "$table is not supported in tabdump. Use Teal maintenance commands. ",errorcode=>1}); return 1; } if ($DESC) { # only show the attribute descriptions, not the values my $schema = xCAT::Table->getTableSchema($table); if (!$schema) { $cb->({error => "table $table does not exist.",errorcode=>1}); return; } my $desc = $schema->{descriptions}; foreach my $c (@{$schema->{cols}}) { my $space = (length($c)<7 ? "\t\t" : "\t"); push @{$rsp{data}}, "$c:$space".$desc->{$c}."\n"; } if (scalar(@{$rsp{data}})) { chop($rsp{data}->[scalar(@{$rsp{data}})-1]); } # remove the final newline $cb->(\%rsp); return; } my $tabh = xCAT::Table->new($table); my $tabdump_header = sub { my $header = "#" . join(",", @_); push @{$rsp{data}}, $header; }; # If the table does not exist yet (because its never been written to), # at least show the header (the column names) unless ($tabh) { if (defined($xCAT::Schema::tabspec{$table})) { $tabdump_header->(@{$xCAT::Schema::tabspec{$table}->{cols}}); $cb->(\%rsp); return; } $cb->({error => "No such table: $table",errorcode=>1}); return 1; } my $recs; my @ents; my @attrarray; if (!($FILENAME)) { # not dumping to a file if (!($OPTW)) { # if no -w flag to filter, then get all $recs = $tabh->getAllEntries("all"); } else { # filter entries foreach my $w (@{$OPTW}){ # get each attr=val push @attrarray, $w; } @ents = $tabh->getAllAttribsWhere(\@attrarray, 'ALL'); @$recs = (); foreach my $e (@ents) { push @$recs,$e; } } my $rec; unless (@$recs) # table exists, but is empty. Show header. { if (defined($xCAT::Schema::tabspec{$table})) { $tabdump_header->(@{$xCAT::Schema::tabspec{$table}->{cols}}); $cb->(\%rsp); return; } } #Display all the rows of the table the order of the columns in the schema output_table($table,$cb,$tabh,$recs); } else { # dump to file my $rc1; my $fh; # check to see if you can open the file unless (open($fh," > $FILENAME")) { $cb->({error => "Error on tabdump of $table to $FILENAME. Unable to open the file for write. ",errorcode=>1}); return 1; } close $fh; if (!($OPTW)) { # if no -w flag to filter, then get all $rc1=$tabh->writeAllEntries($FILENAME); } else { # filter entries foreach my $w (@{$OPTW}){ # get each attr=val push @attrarray, $w; } $rc1 = $tabh->writeAllAttribsWhere(\@attrarray, $FILENAME); } if ($rc1 != 0) { $cb->({error => "Error on tabdump of $table to $FILENAME ",errorcode=>1}); return 1; } } } # Display information from the daemon. # sub lsxcatd { my $args = shift; my $cb = shift; my $HELP; my $VERSION; my $DATABASE; my $ALL; my $rc=0; my $lsxcatd_usage = sub { my $exitcode = shift @_; my %rsp; push @{$rsp{data}}, " lsxcatd [-v|--version]"; push @{$rsp{data}}, " lsxcatd [-h|--help]"; push @{$rsp{data}}, " lsxcatd [-d|--database]"; push @{$rsp{data}}, " lsxcatd [-a|--all]"; if ($exitcode) { $rsp{errorcode} = $exitcode; } $cb->(\%rsp); }; # Process arguments if ($args) { @ARGV = @{$args}; } if (scalar(@ARGV)== 0) { $lsxcatd_usage->(1); return; } if (!GetOptions('h|?|help' => \$HELP, 'v|version' => \$VERSION, 'a|all' => \$ALL, 'd|database' => \$DATABASE)) { $lsxcatd_usage->(1); return; } if ($HELP) { $lsxcatd_usage->(0); return; } # Version if ($VERSION || $ALL) { my %rsp; my $version = xCAT::Utils->Version(); $rsp{data}->[0] = "$version"; $cb->(\%rsp); if (!$ALL) { return; } } # no arguments error my $xcatcfg; my %rsp; if ($DATABASE || $ALL) { $xcatcfg = xCAT::Table->get_xcatcfg(); if ($xcatcfg =~ /^SQLite:/) { # SQLite just return SQlite $rsp{data}->[0] = "dbengine=SQLite"; $cb->(\%rsp); } if ($xcatcfg =~ /^DB2:/) { # for DB2 , get schema name my @parts = split ( '\|', $xcatcfg); my $cfgloc=$parts[0] ."|" . $parts[1] ; my $instance; $instance = $parts[1]; my ($db2,$databasename)= split(':',$parts[0]); my $xcatdbhome = xCAT::Utils->getHomeDir("xcatdb"); $rsp{data}->[0] = "cfgloc=$cfgloc"; $rsp{data}->[1] = "dbengine=$db2"; $rsp{data}->[2] = "dbinstance=$instance"; $rsp{data}->[3] = "dbname=$databasename"; $rsp{data}->[4] = "dbloc=$xcatdbhome"; $cb->(\%rsp); } if (($xcatcfg =~ /^mysql:/) ||($xcatcfg =~ /^Pg:/)) { my @parts = split ( '\|', $xcatcfg); my $cfgloc=$parts[0] ."|". $parts[1] ; my ($host,$addr) = split('host=',$parts[0]); my ($engine,$databasenamestr) = split(':',$host); my ($db,$databasename) = split('=',$databasenamestr); chop $databasename; $rsp{data}->[0] = "cfgloc=$cfgloc"; $rsp{data}->[1] = "dbengine=$engine"; $rsp{data}->[2] = "dbname=$databasename"; $rsp{data}->[3] = "dbhost=$addr"; $rsp{data}->[4] = "dbadmin=$parts[1]"; $cb->(\%rsp); } } return $rc; } # Prune records from the eventlog or auditlog or all records. # Only supports eventlog and auditlog sub tabprune { my $args = shift; my $cb = shift; my $HELP; my $VERSION; my $ALL; my $NUMBERENTRIES; my $PERCENT; my $VERBOSE; my $RECID; my $rc=0; my $tabprune_usage = sub { my $exitcode = shift @_; my %rsp; push @{$rsp{data}}, "Usage: tabprune [-V] -a"; push @{$rsp{data}}, " tabprune [-V] -n <# of records>"; push @{$rsp{data}}, " tabprune [-V] -i "; push @{$rsp{data}}, " tabprune [-V] -p "; push @{$rsp{data}}, " tabprune [-h|--help]"; push @{$rsp{data}}, " tabprune [-v|--version]"; push @{$rsp{data}}, " tables supported:eventlog,auditlog,isnm_perf,isnm_perf_sum"; if ($exitcode) { $rsp{errorcode} = $exitcode; } $cb->(\%rsp); }; # Process arguments if ($args) { @ARGV = @{$args}; } if (!GetOptions('h|?|help' => \$HELP, 'v|version' => \$VERSION, 'V' => \$VERBOSE, 'p|percent=i' => \$PERCENT, 'i|recid=s' => \$RECID, 'a' => \$ALL, 'n|number=i' => \$NUMBERENTRIES)) { $tabprune_usage->(1); return; } if ($HELP) { $tabprune_usage->(0); return; } # Version if ($VERSION) { my %rsp; my $version = xCAT::Utils->Version(); $rsp{data}->[0] = "$version"; $cb->(\%rsp); return; } if (scalar(@ARGV)>1) { $tabprune_usage->(1); return; } my $table = $ARGV[0]; if (!(defined $table)) { my %rsp; $rsp{data}->[0] = "Table name required."; $rsp{errorcode} = 1; $cb->(\%rsp); return 1; } $table=~ s/\s*//g; # remove blanks if (($table ne "eventlog") && ($table ne "auditlog") && ($table ne "isnm_perf") && ($table ne "isnm_perf_sum") ) { my %rsp; $rsp{data}->[0] = "Table $table not supported, see tabprune -h for supported tables."; $rsp{errorcode} = 1; $cb->(\%rsp); return 1; } if (!(defined $PERCENT ) && (!(defined $RECID) && (!(defined $ALL)) && (!(defined $NUMBERENTRIES)))) { my %rsp; $rsp{data}->[0] = "One option -p or -i or -n or -a must be supplied."; $rsp{errorcode} = 1; $cb->(\%rsp); return 1; } if ((defined $PERCENT ) && ((defined $RECID) || (defined $ALL) || (defined $NUMBERENTRIES))) { my %rsp; $rsp{data}->[0] = "Only one option -p or -i or -n or -a maybe used at a time."; $rsp{errorcode} = 1; $cb->(\%rsp); return 1; } if ((defined $RECID ) && ((defined $PERCENT) || (defined $ALL) || (defined $NUMBERENTRIES))) { my %rsp; $rsp{data}->[0] = "Only one option -p or -i or -n or -a maybe used at a time."; $rsp{errorcode} = 1; $cb->(\%rsp); return 1; } if ((defined $ALL ) && ((defined $PERCENT) || (defined $RECID) || (defined $NUMBERENTRIES))) { my %rsp; $rsp{data}->[0] = "Only one option -p or -i or -n or -a maybe used at a time."; $rsp{errorcode} = 1; $cb->(\%rsp); return 1; } if ((defined $NUMBERENTRIES ) && ((defined $PERCENT) || (defined $RECID) || (defined $ALL))) { my %rsp; $rsp{data}->[0] = "Only one option -p or -i or -n or -a maybe used at a time."; $rsp{errorcode} = 1; $cb->(\%rsp); return 1; } # determine the attribute name of the recid my $attrrecid; if (($table eq "eventlog") || ($table eq "auditlog")) { $attrrecid="recid"; } else { if ($table eq "isnm_perf") { # if ISNM $attrrecid="perfid"; } else { $attrrecid="period"; # isnm_perf_sum table } } if (defined $ALL ) { $rc=tabprune_all($table,$cb, $attrrecid,$VERBOSE); } if (defined $NUMBERENTRIES ) { $rc=tabprune_numberentries($table,$cb,$NUMBERENTRIES,"n", $attrrecid,$VERBOSE); } if (defined $PERCENT) { $rc=tabprune_numberentries($table,$cb,$PERCENT,"p", $attrrecid,$VERBOSE); } if (defined $RECID ) { $rc=tabprune_recid($table,$cb,$RECID, $attrrecid,$VERBOSE); } if (!($VERBOSE)) { # not putting out changes my %rsp; push @{$rsp{data}}, "tabprune of $table complete."; $rsp{errorcode} = $rc; $cb->(\%rsp); } return $rc; } sub tabprune_all { my $table = shift; my $cb = shift; my $attrrecid = shift; my $VERBOSE = shift; my $rc=0; my $tab = xCAT::Table->new($table); unless ($tab) { $cb->({error => "Unable to open $table",errorcode=>4}); return 1; } if ($VERBOSE) { # will output change to std my $recs = $tab->getAllEntries("all"); output_table($table,$cb,$tab,$recs); } $tab->delEntries(); #Yes, delete *all* entries $tab->commit; # commit return $rc; } # prune input number of records for the table # if number of entries > number than in the table, then remove all # this handles the number of records or percentage to delete sub tabprune_numberentries { my $table = shift; my $cb = shift; my $numberentries = shift; # either number of entries or percent to # remove based on the flag my $flag = shift; # (n or p flag) my $attrrecid = shift; my $VERBOSE = shift; my $rc=0; my $tab = xCAT::Table->new($table); unless ($tab) { $cb->({error => "Unable to open $table",errorcode=>4}); return 1; } my $DBname = xCAT::Utils->get_DBName; my @attribs = ("$attrrecid"); my @ents=$tab->getAllAttribs(@attribs); if (@ents) { # anything to process # find smallest and largest recid, note table is not ordered by recid after # a while my $smallrid; my $largerid; foreach my $rid (@ents) { if (!(defined $smallrid)) { $smallrid=$rid; } if (!(defined $largerid)) { $largerid=$rid; } if ($rid->{$attrrecid} < $smallrid->{$attrrecid}) { $smallrid=$rid; } if ($rid->{$attrrecid} > $largerid->{$attrrecid}) { $largerid=$rid; } } my $RECID; if ($flag eq "n") { # deleting number of records #determine recid to delete all entries that come before like the -i flag $RECID= $smallrid->{$attrrecid} + $numberentries ; } else { # flag must be percentage #take largest and smallest recid and percentage and determine the recid # that will remove the requested percentage. If some are missing in the # middle due to tabedit, we are not worried about it. my $totalnumberrids = $largerid->{$attrrecid} - $smallrid->{$attrrecid} +1; my $percent = $numberentries / 100; my $percentage=$totalnumberrids * $percent ; my $cnt=sprintf( "%d", $percentage ); # round to whole number $RECID=$smallrid->{$attrrecid} + $cnt; # get recid to remove all before } $rc=tabprune_recid($table,$cb,$RECID, $attrrecid,$VERBOSE); } else { my %rsp; push @{$rsp{data}}, "Nothing to prune from $table."; $rsp{errorcode} = $rc; $cb->(\%rsp); } return $rc; } # prune all entries up to the record id input # if rec id does not exist error sub tabprune_recid { my $table = shift; my $cb = shift; my $recid = shift; my $attrrecid = shift; my $VERBOSE = shift; my $rc=0; # check which database so can build the correct Where clause my $tab = xCAT::Table->new($table); unless ($tab) { $cb->({error => "Unable to open $table",errorcode=>4}); return 1; } my $DBname = xCAT::Utils->get_DBName; # display the output my @recs; if ($VERBOSE) { # need to get all attributes if ($DBname =~ /^DB2/) { @recs=$tab->getAllAttribsWhere("\"$attrrecid\"<$recid", 'ALL'); } else { @recs=$tab->getAllAttribsWhere("$attrrecid<$recid", 'ALL'); } output_table($table,$cb,$tab,\@recs); } my @ents; if ($DBname =~ /^DB2/) { @ents=$tab->getAllAttribsWhere("\"$attrrecid\"<$recid", $attrrecid); } else { @ents=$tab->getAllAttribsWhere("$attrrecid<$recid", $attrrecid); } # delete them foreach my $rid (@ents) { $tab->delEntries($rid); } $tab->commit; return $rc; } # Dump table records to stdout. sub output_table { my $table = shift; my $cb = shift; my $tabh=shift; my $recs=shift; my %rsp; my $tabdump_header = sub { my $header = "#" . join(",", @_); push @{$rsp{data}}, $header; }; # Display all the rows of the table in order of the columns in the schema $tabdump_header->(@{$tabh->{colnames}}); foreach my $rec (@$recs) { my $line = ''; foreach (@{$tabh->{colnames}}) { if (defined $rec->{$_}) { $rec->{$_} =~ s/"/""/g; $line = $line . '"' . $rec->{$_} . '",'; } else { $line .= ','; } } $line =~ s/,$//; # remove the extra comma at the end push @{$rsp{data}}, $line; } $cb->(\%rsp); return; } sub getTableColumn { my $string = shift; if ($shortnames{$string}) { return @{$shortnames{$string}}; } unless ($string =~ /\./) { return undef; } return split /\./,$string,2; } # sub groupch # { # my $args = shift; # my $nodech_usage = sub # { # my $exitcode = shift @_; # my $cmdname = "groupch"; # my %rsp; # push @{$rsp{data}}, "Usage: $cmdname table.column=value [...]"; # push @{$rsp{data}}, " $cmdname {-v | --version}"; # push @{$rsp{data}}, " $cmdname [-? | -h | --help]"; # if ($exitcode) { $rsp{errorcode} = $exitcode; } # $callback->(\%rsp); # }; # my @args = @{$args}; # unless (scalar @args >= 2) { # $nodech_usage->(1); # return; # } # my @groups = split /,/,shift @args; # foreach (@args) # { # # if ($deletemode) # # { # # if (m/[=\.]/) # in delete mode they can only specify tables names # # { # # $callback->({error => [". and = not valid in delete mode."],errorcode=>1}); # # next; # # } # # $tables{$_} = 1; # # next; # # } # unless (m/=/ or m/!~/) # { # $callback->({error => ["Malformed argument $_ ignored."],errorcode=>1}); # next; # } # my $stable; # my $scolumn; # #Check for selection criteria # if (m/^[^=]*==/) { # ($temp,$value)=split /==/,$_,2; # ($stable,$scolumn)=getTableColumn($temp); # $criteria{$stable}->{$scolumn}=[$value,'match']; # next; #Is a selection criteria, not an assignment specification # } elsif (m/^[^=]*!=/) { # ($temp,$value)=split /!=/,$_,2; # ($stable,$scolumn)=getTableColumn($temp); # $criteria{$stable}->{$scolumn}=[$value,'natch']; # next; #Is a selection criteria, not an assignment specification # } elsif (m/^[^=]*=~/) { # ($temp,$value)=split /=~/,$_,2; # ($stable,$scolumn)=getTableColumn($temp); # $value =~ s/^\///; # $value =~ s/\/$//; # $criteria{$stable}->{$scolumn}=[$value,'regex']; # next; #Is a selection criteria, not an assignment specification # } elsif (m/^[^=]*!~/) { # ($temp,$value)=split /!~/,$_,2; # ($stable,$scolumn)=getTableColumn($temp); # $value =~ s/^\///; # $value =~ s/\/$//; # $criteria{$stable}->{$scolumn}=[$value,'negex']; # next; #Is a selection criteria, not an assignment specification # } # #Now definitely an assignment # # ($temp, $value) = split('=', $_, 2); # $value =~ s/^@//; #Allow the =@ operator to exist for an unambiguous assignmenet operator # #So before, table.column==value meant set to =value, now it would be matching value # #the new way would be table.column=@=value to be unambiguous # #now a value like '@hi' would be set with table.column=@@hi # if ($value eq '') { #If blank, force a null entry to override group settings # $value = '|^.*$||'; # } # my $op = '='; # if ($temp =~ /,$/) # { # $op = ',='; # chop($temp); # } # elsif ($temp =~ /\^$/) # { # $op = '^='; # chop($temp); # } # my $table; # if ($shortnames{$temp}) # { # ($table, $column) = @{$shortnames{$temp}}; # } # else # { # ($table, $column) = split('\.', $temp, 2); # } # unless (grep /$column/,@{$xCAT::Schema::tabspec{$table}->{cols}}) { # $callback->({error=>"$table.$column not a valid table.column description",errorcode=>[1]}); # return; # } # # Keep a list of the value/op pairs, in case there is more than 1 per table.column # #$tables{$table}->{$column} = [$value, $op]; # push @{$tables{$table}->{$column}}, ($value, $op); # } # } sub nodech { my $nodes = shift; my $args = shift; my $callback = shift; my $addmode = shift; my $groupmode; if ($addmode eq "groupch") { $addmode = 0; $groupmode=1; } my $VERSION; my $HELP; my $deletemode; my $grptab; my @grplist; my $nodech_usage = sub { my $exitcode = shift @_; my $addmode = shift @_; my $groupmode = shift @_; my $cmdname = $addmode ? 'nodeadd' : ($groupmode ? 'nodegrpch' : 'nodech'); my %rsp; if ($addmode) { push @{$rsp{data}}, "Usage: $cmdname groups= [table.column=value] [...]"; } elsif ($groupmode) { push @{$rsp{data}}, "Usage: $cmdname [table.column=value] [...]"; } else { push @{$rsp{data}}, "Usage: $cmdname table.column=value [...]"; push @{$rsp{data}}, " $cmdname {-d | --delete} [...]"; } push @{$rsp{data}}, " $cmdname {-v | --version}"; push @{$rsp{data}}, " $cmdname [-? | -h | --help]"; if ($exitcode) { $rsp{errorcode} = $exitcode; } $callback->(\%rsp); }; if ($args) { @ARGV = @{$args}; } else { @ARGV=(); } my %options = ('h|?|help' => \$HELP, 'v|version' => \$VERSION); if (!$addmode) { $options{'d|delete'} = \$deletemode; } if (!GetOptions(%options)) { $nodech_usage->(1, $addmode,$groupmode); return; } # Help if ($HELP) { $nodech_usage->(0, $addmode,$groupmode); return; } # Version if ($VERSION) { my %rsp; my $version = xCAT::Utils->Version(); $rsp{data}->[0] = "$version"; $callback->(\%rsp); return; } # Note: the noderange comes through in $arg (and therefore @ARGV) for nodeadd, # because it is linked to xcatclientnnr, since the nodes specified in the noderange # do not exist yet. The nodech cmd is linked to xcatclient, so its noderange is # put in $nodes instead of $args. if (scalar(@ARGV) < (1+$addmode)) { $nodech_usage->(1, $addmode); return; } my @groups; if ($addmode) { my $nr = shift @ARGV; $nodes = [noderange($nr, 0)]; unless ($nodes) { $callback->({error => "No noderange to add.\n",errorcode=>1}); return; } my $invalidnodename = (); foreach my $node (@$nodes) { if ($node =~ /[A-Z]/) { $invalidnodename .= ",$node"; } } if ($invalidnodename) { $invalidnodename =~ s/,//; $callback->( {warning => "The node name \'$invalidnodename\' contains capital letters which may not be resolved correctly by the dns server."} ); } } elsif ($groupmode) { @groups = split /,/, shift @ARGV; } my $column; my $value; my $temp; my %tables; my %criteria=(); my $tab; #print Dumper($deletemode); foreach (@ARGV) { if ($deletemode) { if (m/[=\.]/) # in delete mode they can only specify tables names { $callback->({error => [". and = not valid in delete mode."],errorcode=>1}); next; } $tables{$_} = 1; next; } unless (m/=/ or m/!~/) { $callback->({error => ["Malformed argument $_ ignored."],errorcode=>1}); next; } my $stable; my $scolumn; #Check for selection criteria if (m/^[^=]*==/) { ($temp,$value)=split /==/,$_,2; ($stable,$scolumn)=getTableColumn($temp); $criteria{$stable}->{$scolumn}=[$value,'match']; next; #Is a selection criteria, not an assignment specification } elsif (m/^[^=]*!=/) { ($temp,$value)=split /!=/,$_,2; ($stable,$scolumn)=getTableColumn($temp); $criteria{$stable}->{$scolumn}=[$value,'natch']; next; #Is a selection criteria, not an assignment specification } elsif (m/^[^=]*=~/) { ($temp,$value)=split /=~/,$_,2; ($stable,$scolumn)=getTableColumn($temp); $value =~ s/^\///; $value =~ s/\/$//; $criteria{$stable}->{$scolumn}=[$value,'regex']; next; #Is a selection criteria, not an assignment specification } elsif (m/^[^=]*!~/) { ($temp,$value)=split /!~/,$_,2; ($stable,$scolumn)=getTableColumn($temp); $value =~ s/^\///; $value =~ s/\/$//; $criteria{$stable}->{$scolumn}=[$value,'negex']; next; #Is a selection criteria, not an assignment specification } #Now definitely an assignment ($temp, $value) = split('=', $_, 2); $value =~ s/^@//; #Allow the =@ operator to exist for an unambiguous assignmenet operator #So before, table.column==value meant set to =value, now it would be matching value #the new way would be table.column=@=value to be unambiguous #now a value like '@hi' would be set with table.column=@@hi if ($value eq '') { #If blank, force a null entry to override group settings $value = '|^.*$||'; } my $op = '='; if ($temp =~ /,$/) { $op = ',='; chop($temp); } elsif ($temp =~ /\^$/) { $op = '^='; chop($temp); } my $table; if ($shortnames{$temp}) { ($table, $column) = @{$shortnames{$temp}}; } else { ($table, $column) = split('\.', $temp, 2); } unless (grep /$column/,@{$xCAT::Schema::tabspec{$table}->{cols}}) { $callback->({error=>"$table.$column not a valid table.column description",errorcode=>[1]}); return; } # Keep a list of the value/op pairs, in case there is more than 1 per table.column #$tables{$table}->{$column} = [$value, $op]; push @{$tables{$table}->{$column}}, ($value, $op); } my %nodehash; if (keys %criteria) { foreach (@$nodes) { $nodehash{$_}=1; } } foreach $tab (keys %criteria) { my $tabhdl = xCAT::Table->new($tab, -create => 1, -autocommit => 0); my @columns=keys %{$criteria{$tab}}; my $tabhash = $tabhdl->getNodesAttribs($nodes,\@columns); my $node; my $col; my $rec; foreach $node (@$nodes) { foreach $rec (@{$tabhash->{$node}}) { foreach $col (@columns) { my $value=$criteria{$tab}->{$col}->[0]; unless (defined $value) { $value = ""; } my $matchtype=$criteria{$tab}->{$col}->[1]; if ($matchtype eq 'match' and not ($rec->{$col} eq $value) or $matchtype eq 'natch' and ($rec->{$col} eq $value) or $matchtype eq 'regex' and ($rec->{$col} !~ /$value/) or $matchtype eq 'negex' and ($rec->{$col} =~ /$value/)) { delete $nodehash{$node}; } } } } $nodes = [keys %nodehash]; } foreach $tab (keys %tables) { my $tabhdl = xCAT::Table->new($tab, -create => 1, -autocommit => 0); if ($tabhdl) { my $changed=0; my @entities; if ($groupmode) { @entities = @groups; } else { @entities = @$nodes; } my $entity; foreach $entity (@entities) { if ($deletemode) { $tabhdl->delEntries({'node' => $entity}); $changed=1; } else { #$tabhdl->setNodeAttribs($_,$tables{$tab}); my %uhsh; foreach (keys %{$tables{$tab}}) # for each column specified for this table { #my $op = $tables{$tab}->{$_}->[1]; #my $val = $tables{$tab}->{$_}->[0]; my @valoppairs = @{$tables{$tab}->{$_}}; #Deep copy while (scalar(@valoppairs)) { # alternating list of value and op for this table.column my $val = shift @valoppairs; my $op = shift @valoppairs; my $key = $_; # When changing the groups of the node, check whether the new group # is a dynamic group. if (($key eq 'groups') && ($op eq '=')) { if ($groupmode) { $callback->({error => "Group membership is not changeable via nodegrpch",errorcode=>1}); return; } if (scalar(@grplist) == 0) { # Do not call $grptab->getAllEntries for each node, performance issue. $grptab = xCAT::Table->new('nodegroup'); if ($grptab) { @grplist = @{$grptab->getAllEntries()}; } } my @grps = split(/,/, $val); foreach my $grp (@grps) { foreach my $grpdef_ref (@grplist) { my %grpdef = %$grpdef_ref; if (($grpdef{'groupname'} eq $grp) && ($grpdef{'grouptype'} eq 'dynamic')) { my %rsp; $rsp{data}->[0] = "nodegroup $grp is a dynamic node group, should not add a node into a dynamic node group statically.\n"; $callback->(\%rsp); } } } } if ($op eq '=') { $uhsh{$key} = $val; } elsif ($op eq ',=') { #splice assignment if ($groupmode) { $callback->({error => ",= and ^= are not supported by nodegrpch",errorcode=>1}); return; } my $curval = $uhsh{$key}; # in case it was already set if (!defined($curval)) { my $cent = $tabhdl->getNodeAttribs($entity, [$key]); if ($cent) { $curval = $cent->{$key}; } } if ($curval) { my @vals = split(/,/, $curval); unless (grep /^$val$/, @vals) { unshift @vals,$val; my $newval = join(',', @vals); $uhsh{$key} = $newval; } } else { $uhsh{$key} = $val; } } elsif ($op eq '^=') { if ($groupmode) { $callback->({error => ",= and ^= are not supported by nodegrpch",errorcode=>1}); return; } my $curval = $uhsh{$key}; # in case it was already set if (!defined($curval)) { my $cent = $tabhdl->getNodeAttribs($entity, [$key]); if ($cent) { $curval = $cent->{$key}; } } if ($curval) { my @vals = split(/,/, $curval); if (grep /^$val$/, @vals) { #only bother if there @vals = grep(!/^$val$/, @vals); my $newval = join(',', @vals); $uhsh{$key} = $newval; } } #else, what they asked for is the case alredy } } # end of while @valoppairs } # end of foreach column specified for this table if (keys %uhsh) { if ($groupmode) { my $nodekey = "node"; if (defined $xCAT::Schema::tabspec{$tab}->{nodecol}) { $nodekey = $xCAT::Schema::tabspec{$tab}->{nodecol} } my %clrhash; #First, we prepare to clear all nodes of their overrides on these columns foreach (keys %uhsh) { if ($_ eq $nodekey) { next; } #skip attempts to manipulate 'node' type columns in a groupch $clrhash{$_}=""; } $tabhdl->setAttribs({node=>$entity},\%uhsh); $changed=1; $nodes = [noderange($entity)]; unless (scalar @$nodes) { next; } $tabhdl->setNodesAttribs($nodes,\%clrhash); $changed=1; } else { my @rc = $tabhdl->setNodeAttribs($entity, \%uhsh); $changed=1; if (not defined($rc[0])) { $callback->({error => "DB error " . $rc[1],errorcode=>1}); } } } } } if ($changed) { $tabhdl->commit; } } else { $callback->( {error => ["ERROR: Unable to open table $tab in configuration"],errorcode=>1} ); } } } # gennr linked to xcatclientnnr and is used to generate a list of nodes # external to the database. sub gennr { my $nodes = shift; my $args = shift; my $callback = shift; @ARGV = @{$args}; my $nr = shift @ARGV; $nodes = [noderange($nr, 0)]; my %rsp; # for output. foreach (@$nodes){ #print $_ . "\n"; push @{$rsp{data}}, $_; } $callback->(\%rsp); } sub tabgrep { my $node = shift; my @tablist; my $callback = shift; if (!defined($node) || !scalar(@$node)) { my %rsp; push @{$rsp{data}}, "Usage: tabgrep nodename"; push @{$rsp{data}}, " tabgrep [-?|-h|--help]"; $rsp{errorcode} = 1; $callback->(\%rsp); return; } foreach (keys %{xCAT::Schema::tabspec}) { if (grep /^node$/, @{$xCAT::Schema::tabspec{$_}->{cols}}) { push @tablist, $_; } } foreach (@tablist) { my $tab = xCAT::Table->new($_); unless ($tab) { next; } if ($tab and $tab->getNodeAttribs($node->[0], ["node"])) { $callback->({data => [$_]}); } $tab->close; } } sub rnoderange { my $nodes = shift; my $args = shift; my $callback = shift; my $data = abbreviate_noderange($nodes); if ($data) { $callback->({data=>[$data]}); } } ##################################################### # nodels command ##################################################### sub nodels { my $nodes = shift; my $args = shift; my $callback = shift; my $noderange = shift; unless ($nodes) { $nodes=[]; } my $VERSION; my $HELP; my $nodels_usage = sub { my $exitcode = shift @_; my %rsp; push @{$rsp{data}}, "Usage:"; push @{$rsp{data}}, " nodels [noderange] [-b|--blame] [-H|--with-fieldname] [table.attribute | shortname] [-S][...]"; push @{$rsp{data}}, " nodels {-v|--version}"; push @{$rsp{data}}, " nodels [-?|-h|--help]"; if ($exitcode) { $rsp{errorcode} = $exitcode; } $callback->(\%rsp); }; if ($args) { @ARGV = @{$args}; } else { @ARGV=(); } my $NOTERSE; my $ATTRIBUTION; my $HIDDEN; if (!GetOptions('h|?|help' => \$HELP, 'H|with-fieldname' => \$NOTERSE, 'b|blame' => \$ATTRIBUTION, 'v|version' => \$VERSION, 'S' => \$HIDDEN) ) { $nodels_usage->(1); return; } # Help if ($HELP) { $nodels_usage->(0); return; } # Version if ($VERSION) { my %rsp; my $version = xCAT::Utils->Version(); $rsp{data}->[0] = "$version"; $callback->(\%rsp); return; } # TODO -- Parse command arguments # my $opt; # my %attrs; # foreach $opt (@ARGV) { # if ($opt =~ /^group/) { # } # } my $argc = @ARGV; my $terse = 2; if ($NOTERSE) { $terse = 0; } if (@$nodes > 0 or $noderange) { #Make sure that there are zero nodes *and* that a noderange wasn't requested # TODO - gather data for each node # for now just return the flattened list of nodes) my $rsp; #build up fewer requests, be less chatty #-S will make nodels not show FSPs and BPAs my @newnodes = (); if (!defined($HIDDEN)) { my $listtab = xCAT::Table->new( 'nodelist' ); if ($listtab) { my $listHash = $listtab->getNodesAttribs(\@$nodes, ['hidden']); foreach my $rnode(@$nodes) { unless (defined($listHash->{$rnode}->[0]->{hidden})){ push (@newnodes, $rnode); } elsif ($listHash->{$rnode}->[0]->{hidden} ne 1) { push (@newnodes, $rnode); } } } $nodes = \@newnodes; } if ($argc) { my %tables; foreach (@ARGV) { my $table; my $column; my $value; my $matchtype; my $temp = $_; if ($temp =~ /^[^=]*\!=/) { ($temp,$value) = split /!=/,$temp,2; $matchtype='natch'; } elsif ($temp =~ /^[^=]*=~/) { ($temp,$value) = split /=~/,$temp,2; $value =~ s/^\///; $value =~ s/\/$//; $matchtype='regex'; } elsif ($temp =~ /[^=]*==/) { ($temp,$value) = split /==/,$temp,2; $matchtype='match'; } elsif ($temp =~ /[^=]*!~/) { ($temp,$value) = split /!~/,$temp,2; $value =~ s/^\///; $value =~ s/\/$//; $matchtype='negex'; } if ($shortnames{$temp}) { ($table, $column) = @{$shortnames{$temp}}; $terse--; } elsif ($temp =~ /\./) { ($table, $column) = split('\.', $temp, 2); $terse--; } elsif ($xCAT::Schema::tabspec{$temp}) { $terse=0; $table = $temp; foreach my $column (@{$xCAT::Schema::tabspec{$table}->{cols}}) { unless (grep /^$column$/, @{$tables{$table}}) { push @{$tables{$table}},[$column,"$temp.$column"]; } } next; } else { $callback->({error=>"$temp not a valid table.column description",errorcode=>[1]}); next; } unless (grep /$column/,@{$xCAT::Schema::tabspec{$table}->{cols}}) { $callback->({error=>"$table.$column not a valid table.column description",errorcode=>[1]}); next; } unless (grep /^$column$/, @{$tables{$table}}) { push @{$tables{$table}}, [$column, $temp,$value,$matchtype]; #Mark this as something to get } } my $tab; my %noderecs; my %filterednodes=(); my %mustdisplaynodes=(); my %forcedisplaykeys=(); foreach $tab (keys %tables) { my $tabh = xCAT::Table->new($tab); unless ($tabh) { next; } #print Dumper($tables{$tab}); my $node; my %labels; my %values; my %matchtypes; my @cols=(); foreach (@{$tables{$tab}}) { push @cols, $_->[0]; $labels{$_->[0]} = $_->[1]; #Remember user supplied discreptions and use them if (not defined $values{$_->[0]}) { #If selection criteria not previously specified $values{$_->[0]} = $_->[2]; #assign selection criteria } elsif (not defined $_->[2]) { #we already have selection criteria, but this field isn't that $forcedisplaykeys{$_->[0]}=1; #allow switch.switch=~switch switch.switch, for example } else { #User attempted multiple selection criteria on the same field, bail $callback->({error=>["Multiple selection critera for ".$labels{$_->[0]}]}); return; } if (not defined $matchtypes{$_->[0]}) { $matchtypes{$_->[0]} = $_->[3]; } } my $nodekey = "node"; if (defined $xCAT::Schema::tabspec{$tab}->{nodecol}) { $nodekey = $xCAT::Schema::tabspec{$tab}->{nodecol} }; my $removenodecol=1; if (grep /^$nodekey$/,@cols) { $removenodecol=0; } my $rechash=$tabh->getNodesAttribs($nodes,\@cols,withattribution=>$ATTRIBUTION); foreach $node (@$nodes) { my @cols; my $recs = $rechash->{$node}; #$tabh->getNodeAttribs($node, \@cols); my %satisfiedreqs=(); foreach my $rec (@$recs) { foreach (keys %$rec) { if ($_ eq '!!xcatgroupattribution!!') { next; } if ($_ eq $nodekey and $removenodecol) { next; } $satisfiedreqs{$_}=1; my %datseg=(); if (defined $values{$_}) { my $criteria=$values{$_}; #At least vim highlighting makes me worry about syntax in regex if ($matchtypes{$_} eq 'match' and not ($rec->{$_} eq $criteria) or $matchtypes{$_} eq 'natch' and ($rec->{$_} eq $criteria) or $matchtypes{$_} eq 'regex' and ($rec->{$_} !~ /$criteria/) or $matchtypes{$_} eq 'negex' and ($rec->{$_} =~ /$criteria/)) { #unless ($rec->{$_} eq $values{$_}) { $filterednodes{$node}=1; next; } $mustdisplaynodes{$node}=1; unless ($forcedisplaykeys{$_}) { next; } #skip if only specified once on command line } unless ($terse > 0) { $datseg{data}->[0]->{desc} = [$labels{$_}]; } if ($rec->{'!!xcatgroupattribution!!'} and $rec->{'!!xcatgroupattribution!!'}->{$_}) { $datseg{data}->[0]->{contents} = [$rec->{$_}." (inherited from group ".$rec->{'!!xcatgroupattribution!!'}->{$_}.")"]; } else { $datseg{data}->[0]->{contents} = [$rec->{$_}]; } $datseg{name} = [$node]; #{}->{contents} = [$rec->{$_}]; push @{$noderecs{$node}}, \%datseg; } } foreach (keys %labels) { unless (defined $satisfiedreqs{$_}) { my %dataseg; if (defined $values{$_}) { my $criteria = $values{$_}; if ($matchtypes{$_} eq 'match' and not ("" eq $criteria) or $matchtypes{$_} eq 'natch' and ("" eq $criteria) or $matchtypes{$_} eq 'regex' and ("" !~ /$criteria/) or $matchtypes{$_} eq 'negex' and ("" =~ /$criteria/)) { #unless ("" eq $values{$_}) { $filterednodes{$node}=1; next; } $mustdisplaynodes{$node}=1; unless ($forcedisplaykeys{$_}) { next; } } $dataseg{name} = [ $node ]; unless ($terse > 0) { $dataseg{data}->[0]->{desc} = [$labels{$_}]; } $dataseg{data}->[0]->{contents} = [""]; push @{$noderecs{$node}}, \%dataseg; } } } #$rsp->{node}->[0]->{data}->[0]->{desc}->[0] = $_; #$rsp->{node}->[0]->{data}->[0]->{contents}->[0] = $_; $tabh->close(); undef $tabh; } foreach (keys %mustdisplaynodes) { if ($filterednodes{$_} or defined $noderecs{$_}) { next; } $noderecs{$_}=[{name=>[$_]}]; } foreach (keys %filterednodes) { delete $noderecs{$_}; } foreach (sort (keys %noderecs)) { push @{$rsp->{"node"}}, @{$noderecs{$_}}; } } else { foreach (sort @$nodes) { my $noderec; $noderec->{name}->[0] = ($_); push @{$rsp->{node}}, $noderec; } } $callback->($rsp); } else { # no noderange specified on command line, return list of all nodes my $nodelisttab; if ($nodelisttab = xCAT::Table->new("nodelist")) { my @attribs = ("node"); my @ents = $nodelisttab->getAllAttribs(@attribs); my @nodes; foreach (@ents) { if ($_->{node}) { push @nodes, $_->{node}; } } #-S will make nodels not show FSPs and BPAs my @newnodes = (); if (!defined($HIDDEN)) { my $listtab = xCAT::Table->new( 'nodelist' ); if ($listtab) { my $listHash = $listtab->getNodesAttribs(\@nodes, ['hidden']); foreach my $rnode(@nodes) { unless (defined($listHash->{$rnode}->[0]->{hidden})){ push (@newnodes, $rnode); } elsif ($listHash->{$rnode}->[0]->{hidden} ne 1) { push (@newnodes, $rnode); } } } @nodes = (); foreach (@newnodes) { push (@nodes, $_); } } @nodes = sort {$a cmp $b} @nodes; foreach (@nodes) { my $rsp; #if ($_) #{ $rsp->{node}->[0]->{name}->[0] = ($_); # $rsp->{node}->[0]->{data}->[0]->{contents}->[0]="$_->{node} node contents"; # $rsp->{node}->[0]->{data}->[0]->{desc}->[0]="$_->{node} node desc"; $callback->($rsp); #} } } } return 0; } ######### # tabch ######### sub tabch { my $req = shift; my $callback = shift; # tabch usages message my $tabch_usage = sub { my $exitcode = shift @_; my %rsp; push @{$rsp{data}}, "Usage: tabch"; push @{$rsp{data}}, " To add or update rows for tables:"; push @{$rsp{data}}, " chtab [keycolname=keyvalue[,keycolname=keyvalue...]] [tablename.colname=newvalue] [tablename.colname=newvalue]..."; push @{$rsp{data}}, " To delete rows from tables:"; push @{$rsp{data}}, " chtab -d|--delete keycolname=keyvalue[,keycolname=keyvalue...] tablename [tablename]..."; push @{$rsp{data}}, " keycolname=keyvalue a column name-and-value pair that identifies the rows in a table to be changed. tablename.colname=newvalue the new value for the specified row and column of the table."; push @{$rsp{data}}, " tabprune [-h|--help]"; push @{$rsp{data}}, " tabprune [-v|--version]"; if ($exitcode) { $rsp{errorcode} = $exitcode; } $callback->(\%rsp); }; # check for parameters if (!defined($req->{arg})) { $tabch_usage->(1); return; } @ARGV = @{$req->{arg}}; # options can be bundled up like -vV Getopt::Long::Configure("bundling"); $Getopt::Long::ignorecase = 0; # parse the options if ( !GetOptions( 'd|delete' => \$::DELETE, 'h|help' => \$::HELP, 'v|version' => \$::VERSION, ) ) { $tabch_usage->(1); return; } if ($::HELP) { $tabch_usage->(0); return; } # display the version statement if -v or --verison is specified if ($::VERSION) { my %rsp; my $version = xCAT::Utils->Version(); $rsp{data}->[0] = "tabch :$version"; $callback->(\%rsp); exit(0); } # now start processing the input my $target = shift @ARGV; unless ($target) { $tabch_usage->(1); return; } my %tables; my %keyhash = (); my @keypairs = split(/,/, $target); if ($keypairs[0] !~ /([^\.\=]+)\.([^\.\=]+)\=(.+)/) { foreach (@keypairs) { m/(.*)=(.*)/; my $key = $1; my $val = $2; if (!defined($key) || !defined($val)) { my %rsp; $rsp{data}->[0] = "Incorrect argument \"$_\".\n"; $rsp{data}->[1] = "Check man tabch or tabch -h\n"; $callback->(\%rsp); return 1; } $keyhash{$key} = $val; } } else { unshift(@ARGV, $target); } if ($::DELETE) { #delete option is specified my @tables_to_del = @ARGV; if (@tables_to_del == 0) { my %rsp; $rsp{data}->[0] = "Missing table name.\n"; $rsp{data}->[1] = "Check man tabch or tabch -h\n"; $callback->(\%rsp); return 1; } for (@tables_to_del) { $tables{$_} = xCAT::Table->new($_, -create => 1, -autocommit => 0); $tables{$_}->delEntries(\%keyhash); $tables{$_}->commit; } } else { #update or create option my %tableupdates; for (@ARGV) { my $temp; my $table; my $column; my $value; ($table,$temp) = split('\.',$_,2); #try to create the entry if it doesn't exist unless ($tables{$table}) { my $tab = xCAT::Table->new($table,-create => 1,-autocommit => 0); if ($tab) { $tables{$table}=$tab; } else { my %rsp; $rsp{data}->[0] = "Table $table does not exist.\n"; $callback->(\%rsp); return 1; } } #splice assignment if(grep /\+=/, $temp) { ($column,$value) = split('\+=',$temp,2); #grab the current values to check against my ($attrHash) = $tables{$table}->getAttribs(\%keyhash, $column); my @existing = split(",",$attrHash->{$column}); #if it has values, merge the new and old ones together so no dupes if (@existing) { my @values = split(",",$value); my %seen = (); my @uniq = (); my $item; foreach $item (@existing,@values) { unless ($seen{$item}) { # if we get here, we have not seen it before $seen{$item} = 1; push(@uniq, $item); } } $value = join(",",@uniq); } } #normal non-splicing assignment else { ($column,$value) = split("=",$temp,2); } $tableupdates{$table}{$column}=$value; } #commit all the changes foreach (keys %tables) { if (exists($tableupdates{$_})) { $tables{$_}->setAttribs(\%keyhash,\%{$tableupdates{$_}}); } $tables{$_}->commit; } } }