2007-10-26 22:44:33 +00:00
# IBM(c) 2007 EPL license http://www.eclipse.org/legal/epl-v10.html
#####################################################
#
2008-02-06 15:21:54 +00:00
# xCAT plugin package to handle various commands that work with the
2007-10-26 22:44:33 +00:00
# xCAT tables
#
#####################################################
package xCAT_plugin::tabutils ;
2008-07-18 19:37:43 +00:00
use strict ;
2008-07-18 22:36:32 +00:00
use warnings ;
2007-10-26 22:44:33 +00:00
use xCAT::Table ;
use xCAT::Schema ;
use Data::Dumper ;
2009-04-15 16:45:48 +00:00
use xCAT::NodeRange qw/noderange abbreviate_noderange/ ;
2008-02-14 14:25:49 +00:00
use xCAT::Schema ;
2008-07-07 18:29:55 +00:00
use xCAT::Utils ;
2008-03-08 14:14:00 +00:00
use Getopt::Long ;
2009-09-15 18:37:18 +00:00
my $ requestcommand ;
2007-10-26 22:44:33 +00:00
1 ;
#some quick aliases to table/value
my % shortnames = (
2008-02-06 15:21:54 +00:00
groups = > [ qw( nodelist groups ) ] ,
tags = > [ qw( nodelist groups ) ] ,
mgt = > [ qw( nodehm mgt ) ] ,
2008-05-19 18:04:04 +00:00
#switch => [qw(switch switch)],
2008-02-06 15:21:54 +00:00
) ;
2007-10-26 22:44:33 +00:00
#####################################################
# Return list of commands handled by this plugin
#####################################################
2008-02-06 15:21:54 +00:00
sub handled_commands
{
return {
gettab = > "tabutils" ,
tabdump = > "tabutils" ,
tabrestore = > "tabutils" ,
2008-02-14 14:25:49 +00:00
tabch = > "tabutils" , # not implemented yet
2009-09-29 20:41:13 +00:00
nodegrpch = > "tabutils" ,
2008-02-06 15:21:54 +00:00
nodech = > "tabutils" ,
nodeadd = > "tabutils" ,
noderm = > "tabutils" ,
2008-02-14 14:25:49 +00:00
tabls = > "tabutils" , # not implemented yet
2008-02-06 15:21:54 +00:00
nodels = > "tabutils" ,
2008-02-14 14:25:49 +00:00
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
2009-04-14 18:27:43 +00:00
rnoderange = > "tabutils" , # not implemented yet
2010-01-05 05:12:38 +00:00
tabgrep = > "tabutils" ,
gennr = > "tabutils"
2008-02-06 15:21:54 +00:00
} ;
2007-10-26 22:44:33 +00:00
}
2008-03-08 14:14:00 +00:00
# Each cmd now returns its own usage inside its function
#my %usage = (
#nodech => "Usage: nodech <noderange> [table.column=value] [table.column=value] ...",
#nodeadd => "Usage: nodeadd <noderange> [table.column=value] [table.column=value] ...",
#noderm => "Usage: noderm <noderange>",
2008-02-14 14:25:49 +00:00
# the usage for tabdump is in the tabdump function
#tabdump => "Usage: tabdump <tablename>\n where <tablename> is one of the following:\n " . join("\n ", keys %xCAT::Schema::tabspec),
# the usage for tabrestore is in the tabrestore client cmd
#tabrestore => "Usage: tabrestore <tablename>.csv",
2008-03-08 14:14:00 +00:00
#);
2007-10-26 22:44:33 +00:00
#####################################################
# Process the command
#####################################################
2008-02-06 15:21:54 +00:00
sub process_request
{
2008-03-08 14:14:00 +00:00
#use Getopt::Long;
2008-02-06 15:21:54 +00:00
Getopt::Long:: Configure ( "bundling" ) ;
2008-03-08 14:14:00 +00:00
#Getopt::Long::Configure("pass_through");
Getopt::Long:: Configure ( "no_pass_through" ) ;
2008-02-06 15:21:54 +00:00
my $ request = shift ;
my $ callback = shift ;
2009-09-15 18:37:18 +00:00
$ requestcommand = shift ;
2008-02-06 15:21:54 +00:00
my $ nodes = $ request - > { node } ;
my $ command = $ request - > { command } - > [ 0 ] ;
my $ args = $ request - > { arg } ;
2008-03-08 14:14:00 +00:00
#unless ($args or $nodes or $request->{data})
#{
#if ($usage{$command})
#{
#$callback->({data => [$usage{$command}]});
#return;
#}
#}
2008-02-06 15:21:54 +00:00
if ( $ command eq "nodels" )
{
2008-03-05 16:31:35 +00:00
return nodels ( $ nodes , $ args , $ callback , $ request - > { emptynoderange } - > [ 0 ] ) ;
2008-02-06 15:21:54 +00:00
}
2009-04-14 18:27:43 +00:00
elsif ( $ command eq "rnoderange" )
{
return rnoderange ( $ nodes , $ args , $ callback ) ;
}
2008-02-06 15:21:54 +00:00
elsif ( $ command eq "noderm" or $ command eq "rmnode" )
{
return noderm ( $ nodes , $ args , $ callback ) ;
}
elsif ( $ command eq "nodeadd" or $ command eq "addnode" )
{
2008-02-14 14:25:49 +00:00
return nodech ( $ nodes , $ args , $ callback , 1 ) ;
2008-02-06 15:21:54 +00:00
}
2009-09-29 20:41:13 +00:00
elsif ( $ command eq "nodegrpch" or $ command eq "chnodegrp" )
{
return nodech ( $ nodes , $ args , $ callback , "groupch" ) ;
}
2010-01-05 05:12:38 +00:00
elsif ( $ command eq "gennr" )
{
return gennr ( $ nodes , $ args , $ callback ) ;
}
2009-09-29 20:41:13 +00:00
elsif ( $ command eq "nodech" or $ command eq "chnode" )
2008-02-06 15:21:54 +00:00
{
2008-02-14 14:25:49 +00:00
return nodech ( $ nodes , $ args , $ callback , 0 ) ;
2008-02-06 15:21:54 +00:00
}
elsif ( $ command eq "tabrestore" )
{
return tabrestore ( $ request , $ callback ) ;
}
elsif ( $ command eq "tabdump" )
{
return tabdump ( $ args , $ callback ) ;
}
elsif ( $ command eq "gettab" )
{
return gettab ( $ request , $ callback ) ;
}
elsif ( $ command eq "tabgrep" )
{
return tabgrep ( $ nodes , $ callback ) ;
}
2010-02-03 22:06:43 +00:00
elsif ( $ command eq "tabch" ) {
2010-02-04 04:03:46 +00:00
return tabch ( $ args , $ callback ) ;
2010-02-03 22:06:43 +00:00
}
2008-02-06 15:21:54 +00:00
else
{
print "$command not implemented yet\n" ;
return ( 1 , "$command not written yet" ) ;
}
2007-10-26 22:44:33 +00:00
}
2008-03-05 16:49:19 +00:00
# Display particular attributes, using query strings.
2008-02-14 14:25:49 +00:00
sub gettab
{
my $ req = shift ;
my $ callback = shift ;
2008-03-05 16:49:19 +00:00
my $ HELP ;
2008-05-19 17:59:56 +00:00
my $ NOTERSE ;
2008-03-05 16:49:19 +00:00
2008-07-18 22:36:32 +00:00
my $ gettab_usage = sub {
2008-03-05 16:49:19 +00:00
my $ exitcode = shift @ _ ;
my % rsp ;
2008-05-19 17:59:56 +00:00
push @ { $ rsp { data } } , "Usage: gettab [-H|--with-fieldname] key=value,... table.attribute ..." ;
2008-03-05 16:49:19 +00:00
push @ { $ rsp { data } } , " gettab [-?|-h|--help]" ;
if ( $ exitcode ) { $ rsp { errorcode } = $ exitcode ; }
$ callback - > ( \ % rsp ) ;
2008-07-18 22:36:32 +00:00
} ;
2008-03-05 16:49:19 +00:00
# Process arguments
2009-08-26 19:41:30 +00:00
if ( ! defined ( $ req - > { arg } ) ) { $ gettab_usage - > ( 1 ) ; return ; }
2008-03-05 16:49:19 +00:00
@ ARGV = @ { $ req - > { arg } } ;
2008-07-18 22:36:32 +00:00
if ( ! GetOptions ( 'h|?|help' = > \ $ HELP , 'H|with-fieldname' = > \ $ NOTERSE ) ) { $ gettab_usage - > ( 1 ) ; return ; }
2008-03-05 16:49:19 +00:00
2008-07-18 22:36:32 +00:00
if ( $ HELP ) { $ gettab_usage - > ( 0 ) ; return ; }
if ( scalar ( @ ARGV ) < 2 ) { $ gettab_usage - > ( 1 ) ; return ; }
2008-03-05 16:49:19 +00:00
# Get all the key/value pairs into a hash
my $ keyspec = shift @ ARGV ;
2008-02-14 14:25:49 +00:00
my @ keypairs = split /,/ , $ keyspec ;
my % keyhash ;
foreach ( @ keypairs )
{
( my $ key , my $ value ) = split /=/ , $ _ ;
2008-05-16 18:47:32 +00:00
unless ( defined $ key ) {
2008-07-18 22:36:32 +00:00
$ gettab_usage - > ( 1 ) ;
2008-05-16 18:47:32 +00:00
return ;
}
2008-02-14 14:25:49 +00:00
$ keyhash { $ key } = $ value ;
}
2008-03-05 16:49:19 +00:00
# Group the columns asked for by table (so we can do 1 query per table)
2008-02-14 14:25:49 +00:00
my % tabhash ;
2008-05-16 21:14:09 +00:00
my $ terse = 2 ;
2008-05-19 17:59:56 +00:00
if ( $ NOTERSE ) {
$ terse = 0 ;
}
2008-03-05 16:49:19 +00:00
foreach my $ tabvalue ( @ ARGV )
2008-02-14 14:25:49 +00:00
{
2008-05-16 21:14:09 +00:00
$ terse - - ;
2008-02-14 14:25:49 +00:00
( my $ table , my $ column ) = split /\./ , $ tabvalue ;
$ tabhash { $ table } - > { $ column } = 1 ;
}
2008-03-05 16:49:19 +00:00
2008-05-16 18:47:32 +00:00
#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 ;
}
}
}
2008-03-05 16:49:19 +00:00
# Get the requested columns from each table
2008-02-14 14:25:49 +00:00
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 } } )
{
2008-05-19 17:59:56 +00:00
if ( $ terse > 0 ) {
2008-05-16 21:14:09 +00:00
$ callback - > ( { data = > [ "" . $ ent - > { $ coln } ] } ) ;
} else {
$ callback - > ( { data = > [ "$tabn.$coln: " . $ ent - > { $ coln } ] } ) ;
}
2008-02-14 14:25:49 +00:00
}
$ tab - > close ;
}
}
2008-02-06 15:21:54 +00:00
sub noderm
{
my $ nodes = shift ;
my $ args = shift ;
my $ cb = shift ;
my $ VERSION ;
my $ HELP ;
2008-07-18 22:36:32 +00:00
my $ noderm_usage = sub {
2008-03-08 14:14:00 +00:00
my $ exitcode = shift @ _ ;
2008-02-06 15:21:54 +00:00
my % rsp ;
2008-03-08 14:14:00 +00:00
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 ) ;
2008-07-18 22:36:32 +00:00
} ;
2008-02-06 15:21:54 +00:00
2008-08-08 17:20:32 +00:00
if ( $ args ) {
@ ARGV = @ { $ args } ;
2009-10-30 11:36:23 +00:00
} else {
@ ARGV = ( ) ;
2008-08-08 17:20:32 +00:00
}
2008-07-18 22:36:32 +00:00
if ( ! GetOptions ( 'h|?|help' = > \ $ HELP , 'v|version' = > \ $ VERSION ) ) { $ noderm_usage - > ( 1 ) ; return ; }
2007-10-26 22:44:33 +00:00
2008-07-18 22:36:32 +00:00
if ( $ HELP ) { $ noderm_usage - > ( 0 ) ; return ; }
2008-02-06 15:21:54 +00:00
2008-03-08 14:14:00 +00:00
if ( $ VERSION ) {
2008-02-06 15:21:54 +00:00
my % rsp ;
2008-07-07 18:29:55 +00:00
my $ version = xCAT::Utils - > Version ( ) ;
2008-07-18 19:37:43 +00:00
$ rsp { data } - > [ 0 ] = "$version" ;
$ cb - > ( \ % rsp ) ;
2008-02-06 15:21:54 +00:00
return ;
}
2008-03-08 14:14:00 +00:00
2008-07-18 22:36:32 +00:00
if ( ! $ nodes ) { $ noderm_usage - > ( 1 ) ; return ; }
2009-09-15 18:37:18 +00:00
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 ) {
2009-09-15 19:11:39 +00:00
$ requestcommand - > ( { command = > [ 'makedhcp' ] , node = > $ nodes , arg = > [ '-d' ] } ) ;
2009-09-15 18:37:18 +00:00
}
2008-03-08 14:14:00 +00:00
# Build the argument list for using the -d option of nodech to do our work for us
2008-02-06 15:21:54 +00:00
my @ tablist = ( "-d" ) ;
foreach ( keys % { xCAT::Schema:: tabspec } )
{
if ( grep /^node$/ , @ { $ xCAT:: Schema:: tabspec { $ _ } - > { cols } } )
{
push @ tablist , $ _ ;
}
}
2008-02-14 14:25:49 +00:00
nodech ( $ nodes , \ @ tablist , $ cb , 0 ) ;
2007-10-26 22:44:33 +00:00
}
2008-02-06 15:21:54 +00:00
sub tabrestore
{
2008-02-14 14:25:49 +00:00
# the usage for tabrestore is in the tabrestore client cmd
2008-02-06 15:21:54 +00:00
#request->{data} is an array of CSV formatted lines
my $ request = shift ;
my $ cb = shift ;
my $ table = $ request - > { table } - > [ 0 ] ;
my $ tab = xCAT::Table - > new ( $ table , - create = > 1 , - autocommit = > 0 ) ;
2008-02-14 14:25:49 +00:00
unless ( $ tab ) {
$ cb - > ( { error = > "Unable to open $table" , errorcode = > 4 } ) ;
2008-02-06 15:21:54 +00:00
return ;
}
$ tab - > delEntries ( ) ; #Yes, delete *all* entries
my $ header = shift @ { $ request - > { data } } ;
2009-01-14 14:41:38 +00:00
unless ( $ header =~ /^#/ ) {
$ cb - > ( { error = > "Data missing header line starting with #" , errorcode = > 1 } ) ;
return ;
}
2008-02-06 15:21:54 +00:00
$ header =~ s/"//g ; #Strip " from overzealous CSV apps
$ header =~ s/^#// ;
$ header =~ s/\s+$// ;
my @ colns = split ( /,/ , $ header ) ;
2009-09-16 15:38:40 +00:00
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 ;
}
2009-09-28 17:14:07 +00:00
#print Dumper(grep /^$tcol\z/,@{$xCAT::Schema::tabspec{$table}->{cols}});
2009-09-16 15:38:40 +00:00
}
2009-09-28 17:14:07 +00:00
#print "We passed it!\n";
2008-02-06 15:21:54 +00:00
my $ line ;
my $ rollback = 0 ;
2009-02-04 01:53:34 +00:00
my @ tmp = $ tab - > getAutoIncrementColumns ( ) ; #get the columns that are auto increment by DB.
my % auto_cols = ( ) ;
foreach ( @ tmp ) { $ auto_cols { $ _ } = 1 ; }
Changed the parsing in tabedit to allow newlines in the column fields within double quotes
Tested with:
#node,rack,u,chassis,slot,room,comments,disable
"
rr
a004a",,"42",,,,"te
st",
"rra
004b",,,,,,"test2",
"rra004c",,,,,,"test3",
"bca01","1","2",,,,,"ssdf
sdfsd
sdfs
sdf
d
dfdf""
sdf
"
git-svn-id: https://svn.code.sf.net/p/xcat/code/xcat-core/trunk@5237 8638fb3e-16cb-4fca-ae20-7b5d299a9bcd
2010-02-19 16:06:06 +00:00
my $ linenumber ;
my $ linecount = scalar ( @ { $ request - > { data } } ) ;
LINE: for ( $ linenumber = 0 ; $ linenumber < $ linecount ; $ linenumber + + )
2008-02-06 15:21:54 +00:00
{
Changed the parsing in tabedit to allow newlines in the column fields within double quotes
Tested with:
#node,rack,u,chassis,slot,room,comments,disable
"
rr
a004a",,"42",,,,"te
st",
"rra
004b",,,,,,"test2",
"rra004c",,,,,,"test3",
"bca01","1","2",,,,,"ssdf
sdfsd
sdfs
sdf
d
dfdf""
sdf
"
git-svn-id: https://svn.code.sf.net/p/xcat/code/xcat-core/trunk@5237 8638fb3e-16cb-4fca-ae20-7b5d299a9bcd
2010-02-19 16:06:06 +00:00
$ line = @ { $ request - > { data } } [ $ linenumber ] ;
2008-02-06 15:21:54 +00:00
$ 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?
2009-02-04 01:53:34 +00:00
if ( ! exists ( $ auto_cols { $ col } ) ) {
$ record { $ col } = undef ;
}
2008-02-06 15:21:54 +00:00
$ 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 "
2008-02-14 14:25:49 +00:00
. index ( $ origline , $ line ) . ": $origline" , errorcode = > 4
2008-02-06 15:21:54 +00:00
}
) ;
next LINE ;
}
my $ offset = 1 ;
my $ nextchar ;
my $ ent ;
while ( not defined $ ent )
{
$ offset = index ( $ line , '"' , $ offset ) ;
$ offset + + ;
Changed the parsing in tabedit to allow newlines in the column fields within double quotes
Tested with:
#node,rack,u,chassis,slot,room,comments,disable
"
rr
a004a",,"42",,,,"te
st",
"rra
004b",,,,,,"test2",
"rra004c",,,,,,"test3",
"bca01","1","2",,,,,"ssdf
sdfsd
sdfs
sdf
d
dfdf""
sdf
"
git-svn-id: https://svn.code.sf.net/p/xcat/code/xcat-core/trunk@5237 8638fb3e-16cb-4fca-ae20-7b5d299a9bcd
2010-02-19 16:06:06 +00:00
2008-02-06 15:21:54 +00:00
if ( $ offset <= 0 )
Changed the parsing in tabedit to allow newlines in the column fields within double quotes
Tested with:
#node,rack,u,chassis,slot,room,comments,disable
"
rr
a004a",,"42",,,,"te
st",
"rra
004b",,,,,,"test2",
"rra004c",,,,,,"test3",
"bca01","1","2",,,,,"ssdf
sdfsd
sdfs
sdf
d
dfdf""
sdf
"
git-svn-id: https://svn.code.sf.net/p/xcat/code/xcat-core/trunk@5237 8638fb3e-16cb-4fca-ae20-7b5d299a9bcd
2010-02-19 16:06:06 +00:00
{ #the matching quote is not on this line of the file
2008-02-06 15:21:54 +00:00
Changed the parsing in tabedit to allow newlines in the column fields within double quotes
Tested with:
#node,rack,u,chassis,slot,room,comments,disable
"
rr
a004a",,"42",,,,"te
st",
"rra
004b",,,,,,"test2",
"rra004c",,,,,,"test3",
"bca01","1","2",,,,,"ssdf
sdfsd
sdfs
sdf
d
dfdf""
sdf
"
git-svn-id: https://svn.code.sf.net/p/xcat/code/xcat-core/trunk@5237 8638fb3e-16cb-4fca-ae20-7b5d299a9bcd
2010-02-19 16:06:06 +00:00
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 ;
}
2008-02-06 15:21:54 +00:00
}
else
Changed the parsing in tabedit to allow newlines in the column fields within double quotes
Tested with:
#node,rack,u,chassis,slot,room,comments,disable
"
rr
a004a",,"42",,,,"te
st",
"rra
004b",,,,,,"test2",
"rra004c",,,,,,"test3",
"bca01","1","2",,,,,"ssdf
sdfsd
sdfs
sdf
d
dfdf""
sdf
"
git-svn-id: https://svn.code.sf.net/p/xcat/code/xcat-core/trunk@5237 8638fb3e-16cb-4fca-ae20-7b5d299a9bcd
2010-02-19 16:06:06 +00:00
{ #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 } ) )
2008-02-06 15:21:54 +00:00
{
Changed the parsing in tabedit to allow newlines in the column fields within double quotes
Tested with:
#node,rack,u,chassis,slot,room,comments,disable
"
rr
a004a",,"42",,,,"te
st",
"rra
004b",,,,,,"test2",
"rra004c",,,,,,"test3",
"bca01","1","2",,,,,"ssdf
sdfsd
sdfs
sdf
d
dfdf""
sdf
"
git-svn-id: https://svn.code.sf.net/p/xcat/code/xcat-core/trunk@5237 8638fb3e-16cb-4fca-ae20-7b5d299a9bcd
2010-02-19 16:06:06 +00:00
$ record { $ col } = $ ent ;
}
}
else
{
$ cb - > (
{
error = >
"CSV unescaped \" in record on line $linenumber, character "
. index ( $ origline , $ line ) . ": $origline" , errorcode = > 4
}
) ;
$ rollback = 1 ;
next LINE ;
}
2008-02-06 15:21:54 +00:00
}
}
}
elsif ( $ line =~ /^([^,]+)/ )
{ #easiest case, no Text::Balanced needed..
Changed the parsing in tabedit to allow newlines in the column fields within double quotes
Tested with:
#node,rack,u,chassis,slot,room,comments,disable
"
rr
a004a",,"42",,,,"te
st",
"rra
004b",,,,,,"test2",
"rra004c",,,,,,"test3",
"bca01","1","2",,,,,"ssdf
sdfsd
sdfs
sdf
d
dfdf""
sdf
"
git-svn-id: https://svn.code.sf.net/p/xcat/code/xcat-core/trunk@5237 8638fb3e-16cb-4fca-ae20-7b5d299a9bcd
2010-02-19 16:06:06 +00:00
if ( ! exists ( $ auto_cols { $ col } ) )
{
2009-02-04 01:53:34 +00:00
$ record { $ col } = $ 1 ;
}
2008-02-06 15:21:54 +00:00
$ line =~ s/^([^,]+)(,|$)// ;
}
2007-10-26 22:44:33 +00:00
}
2008-02-06 15:21:54 +00:00
if ( $ line )
{
$ rollback = 1 ;
2008-02-14 14:25:49 +00:00
$ cb - > ( { error = > "Too many fields on line $linenumber: $origline | $line" , errorcode = > 4 } ) ;
2007-10-26 22:44:33 +00:00
next LINE ;
}
2008-02-06 15:21:54 +00:00
#TODO: check for error from DB and rollback
my @ rc = $ tab - > setAttribs ( \ % record , \ % record ) ;
if ( not defined ( $ rc [ 0 ] ) )
{
$ rollback = 1 ;
2008-02-14 14:25:49 +00:00
$ cb - > ( { error = > "DB error " . $ rc [ 1 ] . " with line $linenumber: " . $ origline , errorcode = > 4 } ) ;
2008-02-06 15:21:54 +00:00
}
}
if ( $ rollback )
{
$ tab - > rollback ( ) ;
$ tab - > close ;
undef $ tab ;
return ;
}
else
{
$ tab - > commit ; #Made it all the way here, commit
}
2007-10-26 22:44:33 +00:00
}
2008-02-06 15:21:54 +00:00
2008-03-05 16:49:19 +00:00
# Display a list of tables, or a specific table in CSV format
2008-02-06 15:21:54 +00:00
sub tabdump
{
my $ args = shift ;
my $ cb = shift ;
my $ table = "" ;
2008-02-14 14:25:49 +00:00
my $ HELP ;
2008-02-21 21:10:35 +00:00
my $ DESC ;
2008-02-14 14:25:49 +00:00
2008-07-18 22:36:32 +00:00
my $ tabdump_usage = sub {
2008-02-14 14:25:49 +00:00
my $ exitcode = shift @ _ ;
my % rsp ;
2008-02-21 21:10:35 +00:00
push @ { $ rsp { data } } , "Usage: tabdump [-d] [table]" ;
2008-02-14 14:25:49 +00:00
push @ { $ rsp { data } } , " tabdump [-?|-h|--help]" ;
if ( $ exitcode ) { $ rsp { errorcode } = $ exitcode ; }
$ cb - > ( \ % rsp ) ;
2008-07-18 22:36:32 +00:00
} ;
2008-02-14 14:25:49 +00:00
# Process arguments
2008-07-31 18:19:11 +00:00
if ( $ args ) {
@ ARGV = @ { $ args } ;
}
2008-07-18 22:36:32 +00:00
if ( ! GetOptions ( 'h|?|help' = > \ $ HELP , 'd' = > \ $ DESC ) ) { $ tabdump_usage - > ( 1 ) ; return ; }
2008-02-14 14:25:49 +00:00
2008-07-18 22:36:32 +00:00
if ( $ HELP ) { $ tabdump_usage - > ( 0 ) ; return ; }
if ( scalar ( @ ARGV ) > 1 ) { $ tabdump_usage - > ( 1 ) ; return ; }
2008-02-14 14:25:49 +00:00
2008-02-06 15:21:54 +00:00
my % rsp ;
2008-02-14 14:25:49 +00:00
# If no arguments given, we display a list of the tables
if ( ! scalar ( @ ARGV ) ) {
2008-02-21 21:10:35 +00:00
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
2008-02-14 14:25:49 +00:00
$ cb - > ( \ % rsp ) ;
return ;
}
$ table = $ ARGV [ 0 ] ;
2008-02-21 21:10:35 +00:00
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 ;
}
2008-02-14 14:25:49 +00:00
my $ tabh = xCAT::Table - > new ( $ table ) ;
2008-07-18 22:36:32 +00:00
my $ tabdump_header = sub {
2008-02-14 14:25:49 +00:00
my $ header = "#" . join ( "," , @ _ ) ;
push @ { $ rsp { data } } , $ header ;
2008-07-18 22:36:32 +00:00
} ;
2008-02-14 14:25:49 +00:00
# If the table does not exist yet (because its never been written to),
# at least show the header (the column names)
2008-02-06 15:21:54 +00:00
unless ( $ tabh )
{
if ( defined ( $ xCAT:: Schema:: tabspec { $ table } ) )
{
2008-07-18 22:36:32 +00:00
$ tabdump_header - > ( @ { $ xCAT:: Schema:: tabspec { $ table } - > { cols } } ) ;
2008-02-14 14:25:49 +00:00
$ cb - > ( \ % rsp ) ;
2008-02-06 15:21:54 +00:00
return ;
}
2008-02-14 14:25:49 +00:00
$ cb - > ( { error = > "No such table: $table" , errorcode = > 1 } ) ;
2008-02-06 15:21:54 +00:00
return 1 ;
}
2008-02-14 14:25:49 +00:00
2009-01-14 19:46:13 +00:00
my $ recs = $ tabh - > getAllEntries ( "all" ) ;
2008-02-06 15:21:54 +00:00
my $ rec ;
2008-02-14 14:25:49 +00:00
unless ( @$ recs ) # table exists, but is empty. Show header.
2008-02-06 15:21:54 +00:00
{
if ( defined ( $ xCAT:: Schema:: tabspec { $ table } ) )
{
2008-07-18 22:36:32 +00:00
$ tabdump_header - > ( @ { $ xCAT:: Schema:: tabspec { $ table } - > { cols } } ) ;
2008-02-14 14:25:49 +00:00
$ cb - > ( \ % rsp ) ;
2008-02-06 15:21:54 +00:00
return ;
}
}
2008-02-14 14:25:49 +00:00
# Display all the rows of the table in the order of the columns in the schema
2008-07-18 22:36:32 +00:00
$ tabdump_header - > ( @ { $ tabh - > { colnames } } ) ;
2008-02-06 15:21:54 +00:00
foreach $ rec ( @$ recs )
{
my $ line = '' ;
foreach ( @ { $ tabh - > { colnames } } )
{
if ( defined $ rec - > { $ _ } )
{
2008-02-14 14:25:49 +00:00
$ rec - > { $ _ } =~ s/"/""/g ;
2008-02-06 15:21:54 +00:00
$ line = $ line . '"' . $ rec - > { $ _ } . '",' ;
}
else
{
$ line . = ',' ;
}
}
2008-02-14 14:25:49 +00:00
$ line =~ s/,$// ; # remove the extra comma at the end
2008-02-06 15:21:54 +00:00
push @ { $ rsp { data } } , $ line ;
}
$ cb - > ( \ % rsp ) ;
2007-10-26 22:44:33 +00:00
}
2008-09-07 20:43:03 +00:00
sub getTableColumn {
my $ string = shift ;
if ( $ shortnames { $ string } ) {
return @ { $ shortnames { $ string } } ;
}
unless ( $ string =~ /\./ ) {
return undef ;
}
return split /\./ , $ string , 2 ;
}
2009-09-29 20:41:13 +00:00
# sub groupch
# {
# my $args = shift;
# my $nodech_usage = sub
# {
# my $exitcode = shift @_;
# my $cmdname = "groupch";
# my %rsp;
# push @{$rsp{data}}, "Usage: $cmdname <group1,group2,...> 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);
# }
# }
2008-02-14 14:25:49 +00:00
sub nodech
2008-02-06 15:21:54 +00:00
{
my $ nodes = shift ;
my $ args = shift ;
my $ callback = shift ;
my $ addmode = shift ;
2009-09-29 20:41:13 +00:00
my $ groupmode ;
if ( $ addmode eq "groupch" ) {
$ addmode = 0 ;
$ groupmode = 1 ;
}
2008-02-06 15:21:54 +00:00
my $ VERSION ;
my $ HELP ;
2008-03-08 14:14:00 +00:00
my $ deletemode ;
2009-06-02 05:29:55 +00:00
my $ grptab ;
my @ grplist ;
2008-02-06 15:21:54 +00:00
2008-07-18 22:36:32 +00:00
my $ nodech_usage = sub
2008-02-06 15:21:54 +00:00
{
2008-03-08 14:14:00 +00:00
my $ exitcode = shift @ _ ;
my $ addmode = shift @ _ ;
2009-09-29 20:41:13 +00:00
my $ groupmode = shift @ _ ;
my $ cmdname = $ addmode ? 'nodeadd' : ( $ groupmode ? 'nodegrpch' : 'nodech' ) ;
2008-02-06 15:21:54 +00:00
my % rsp ;
2008-03-08 14:14:00 +00:00
if ( $ addmode ) {
push @ { $ rsp { data } } , "Usage: $cmdname <noderange> groups=<groupnames> [table.column=value] [...]" ;
2009-09-29 20:41:13 +00:00
} elsif ( $ groupmode ) {
push @ { $ rsp { data } } , "Usage: $cmdname <group1,group2,...> [table.column=value] [...]" ;
2008-03-08 14:14:00 +00:00
} else {
push @ { $ rsp { data } } , "Usage: $cmdname <noderange> table.column=value [...]" ;
push @ { $ rsp { data } } , " $cmdname {-d | --delete} <noderange> <table> [...]" ;
}
push @ { $ rsp { data } } , " $cmdname {-v | --version}" ;
push @ { $ rsp { data } } , " $cmdname [-? | -h | --help]" ;
if ( $ exitcode ) { $ rsp { errorcode } = $ exitcode ; }
$ callback - > ( \ % rsp ) ;
2008-07-18 22:36:32 +00:00
} ;
2007-10-26 22:44:33 +00:00
2008-10-31 13:38:57 +00:00
if ( $ args ) {
@ ARGV = @ { $ args } ;
} else {
@ ARGV = ( ) ;
}
2008-03-08 14:14:00 +00:00
my % options = ( 'h|?|help' = > \ $ HELP , 'v|version' = > \ $ VERSION ) ;
if ( ! $ addmode ) { $ options { 'd|delete' } = \ $ deletemode ; }
if ( ! GetOptions ( % options ) ) {
2009-09-29 20:41:13 +00:00
$ nodech_usage - > ( 1 , $ addmode , $ groupmode ) ;
2008-03-08 14:14:00 +00:00
return ;
2008-02-06 15:21:54 +00:00
}
# Help
2008-03-08 14:14:00 +00:00
if ( $ HELP ) {
2009-09-29 20:41:13 +00:00
$ nodech_usage - > ( 0 , $ addmode , $ groupmode ) ;
2008-02-06 15:21:54 +00:00
return ;
}
2007-10-26 22:44:33 +00:00
2008-02-06 15:21:54 +00:00
# Version
2008-03-08 14:14:00 +00:00
if ( $ VERSION ) {
2008-02-06 15:21:54 +00:00
my % rsp ;
2008-07-07 18:29:55 +00:00
my $ version = xCAT::Utils - > Version ( ) ;
2008-07-18 19:37:43 +00:00
$ rsp { data } - > [ 0 ] = "$version" ;
$ callback - > ( \ % rsp ) ;
2008-02-06 15:21:54 +00:00
return ;
}
2008-03-08 14:14:00 +00:00
# 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.
2008-07-18 22:36:32 +00:00
if ( scalar ( @ ARGV ) < ( 1 + $ addmode ) ) { $ nodech_usage - > ( 1 , $ addmode ) ; return ; }
2009-09-29 20:41:13 +00:00
my @ groups ;
2008-03-08 14:14:00 +00:00
2008-02-06 15:21:54 +00:00
if ( $ addmode )
{
2008-03-08 14:14:00 +00:00
my $ nr = shift @ ARGV ;
$ nodes = [ noderange ( $ nr , 0 ) ] ;
unless ( $ nodes ) {
$ callback - > ( { error = > "No noderange to add.\n" , errorcode = > 1 } ) ;
2008-02-06 15:21:54 +00:00
return ;
2007-10-26 22:44:33 +00:00
}
2010-03-24 14:51:26 +00:00
my $ invalidnodename = ( ) ;
foreach my $ node ( @$ nodes ) {
if ( $ node =~ /[A-Z]/ ) {
$ invalidnodename . = ",$node" ;
}
}
if ( $ invalidnodename ) {
$ invalidnodename =~ s/,// ;
$ callback - > ( { warning = > "The node name \'$invalidnodename\' has capital which can not be resolved correctly by dns server. Please don't use the capital in the node name which need to be installed Operating System.\n" } ) ;
}
2009-09-29 20:41:13 +00:00
} elsif ( $ groupmode ) {
@ groups = split /,/ , shift @ ARGV ;
2008-02-06 15:21:54 +00:00
}
my $ column ;
my $ value ;
my $ temp ;
my % tables ;
2008-09-07 20:43:03 +00:00
my % criteria = ( ) ;
2008-02-06 15:21:54 +00:00
my $ tab ;
#print Dumper($deletemode);
2008-03-08 14:14:00 +00:00
foreach ( @ ARGV )
2008-02-06 15:21:54 +00:00
{
if ( $ deletemode )
{
2008-03-08 14:14:00 +00:00
if ( m/[=\.]/ ) # in delete mode they can only specify tables names
2008-02-06 15:21:54 +00:00
{
2008-03-08 14:14:00 +00:00
$ callback - > ( { error = > [ ". and = not valid in delete mode." ] , errorcode = > 1 } ) ;
2008-02-06 15:21:54 +00:00
next ;
2007-10-26 22:44:33 +00:00
}
2008-02-06 15:21:54 +00:00
$ tables { $ _ } = 1 ;
next ;
}
2008-09-07 20:43:03 +00:00
unless ( m/=/ or m/!~/ )
2008-02-06 15:21:54 +00:00
{
2008-03-08 14:14:00 +00:00
$ callback - > ( { error = > [ "Malformed argument $_ ignored." ] , errorcode = > 1 } ) ;
2008-02-06 15:21:54 +00:00
next ;
}
2008-09-07 20:43:03 +00:00
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
2008-02-06 15:21:54 +00:00
( $ temp , $ value ) = split ( '=' , $ _ , 2 ) ;
2008-09-07 20:43:03 +00:00
$ 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
2008-12-09 15:23:12 +00:00
if ( $ value eq '' ) { #If blank, force a null entry to override group settings
$ value = '|^.*$||' ;
}
2008-02-06 15:21:54 +00:00
my $ op = '=' ;
if ( $ temp =~ /,$/ )
{
$ op = ',=' ;
chop ( $ temp ) ;
}
elsif ( $ temp =~ /\^$/ )
{
$ op = '^=' ;
chop ( $ temp ) ;
}
2008-07-18 19:37:43 +00:00
my $ table ;
2008-02-06 15:21:54 +00:00
if ( $ shortnames { $ temp } )
{
( $ table , $ column ) = @ { $ shortnames { $ temp } } ;
}
else
{
( $ table , $ column ) = split ( '\.' , $ temp , 2 ) ;
}
2008-03-03 21:00:13 +00:00
unless ( grep /$column/ , @ { $ xCAT:: Schema:: tabspec { $ table } - > { cols } } ) {
$ callback - > ( { error = > "$table.$column not a valid table.column description" , errorcode = > [ 1 ] } ) ;
return ;
}
2008-03-08 14:14:00 +00:00
# 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 ) ;
2008-02-06 15:21:54 +00:00
}
2008-09-07 20:43:03 +00:00
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 ] ;
}
2008-02-06 15:21:54 +00:00
foreach $ tab ( keys % tables )
{
my $ tabhdl = xCAT::Table - > new ( $ tab , - create = > 1 , - autocommit = > 0 ) ;
if ( $ tabhdl )
{
2009-10-28 19:28:00 +00:00
my $ changed = 0 ;
2009-10-08 22:23:10 +00:00
my @ entities ;
if ( $ groupmode ) {
@ entities = @ groups ;
} else {
@ entities = @$ nodes ;
2009-09-29 20:41:13 +00:00
}
2009-10-08 22:23:10 +00:00
my $ entity ;
foreach $ entity ( @ entities ) {
if ( $ deletemode ) {
$ tabhdl - > delEntries ( { 'node' = > $ entity } ) ;
2009-10-28 19:28:00 +00:00
$ changed = 1 ;
2009-10-08 22:23:10 +00:00
} 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 = $ _ ;
2009-09-29 20:41:13 +00:00
# When changing the groups of the node, check whether the new group
# is a dynamic group.
if ( ( $ key eq 'groups' ) && ( $ op eq '=' ) ) {
2009-10-08 22:23:10 +00:00
if ( $ groupmode ) {
$ callback - > ( { error = > "Group membership is not changeable via nodegrpch" , errorcode = > 1 } ) ;
return ;
}
2009-09-29 20:41:13 +00:00
if ( scalar ( @ grplist ) == 0 ) { # Do not call $grptab->getAllEntries for each node, performance issue.
$ grptab = xCAT::Table - > new ( 'nodegroup' ) ;
if ( $ grptab ) {
@ grplist = @ { $ grptab - > getAllEntries ( ) } ;
2009-06-02 05:29:55 +00:00
}
2009-09-29 20:41:13 +00:00
}
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 ) ;
2009-06-02 05:29:55 +00:00
}
}
}
2009-09-29 20:41:13 +00:00
}
2009-10-08 22:23:10 +00:00
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 ) ;
2009-10-28 19:28:00 +00:00
$ changed = 1 ;
2009-10-08 22:23:10 +00:00
$ nodes = [ noderange ( $ entity ) ] ;
2009-09-29 20:41:13 +00:00
unless ( scalar @$ nodes ) { next ; }
$ tabhdl - > setNodesAttribs ( $ nodes , \ % clrhash ) ;
2009-10-28 19:28:00 +00:00
$ changed = 1 ;
2009-10-08 22:23:10 +00:00
} else {
my @ rc = $ tabhdl - > setNodeAttribs ( $ entity , \ % uhsh ) ;
2009-10-28 19:28:00 +00:00
$ changed = 1 ;
2009-10-08 22:23:10 +00:00
if ( not defined ( $ rc [ 0 ] ) ) {
$ callback - > ( { error = > "DB error " . $ rc [ 1 ] , errorcode = > 1 } ) ;
}
2008-02-06 15:21:54 +00:00
}
}
}
2008-01-20 19:20:46 +00:00
}
2009-10-28 19:28:00 +00:00
if ( $ changed ) {
$ tabhdl - > commit ;
}
2008-02-06 15:21:54 +00:00
}
else
{
$ callback - > (
2008-03-08 14:14:00 +00:00
{ error = > [ "ERROR: Unable to open table $tab in configuration" ] , errorcode = > 1 }
2008-02-06 15:21:54 +00:00
) ;
2007-10-26 22:44:33 +00:00
}
}
}
2010-01-05 05:12:38 +00:00
# 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 ) ;
}
2008-02-06 15:21:54 +00:00
sub tabgrep
{
my $ node = shift ;
my @ tablist ;
my $ callback = shift ;
2008-01-18 16:47:26 +00:00
2009-08-26 19:41:30 +00:00
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 ;
}
2008-02-06 15:21:54 +00:00
foreach ( keys % { xCAT::Schema:: tabspec } )
{
if ( grep /^node$/ , @ { $ xCAT:: Schema:: tabspec { $ _ } - > { cols } } )
{
push @ tablist , $ _ ;
}
}
foreach ( @ tablist )
{
my $ tab = xCAT::Table - > new ( $ _ ) ;
2008-03-05 19:04:11 +00:00
unless ( $ tab ) { next ; }
2008-03-05 19:02:27 +00:00
if ( $ tab and $ tab - > getNodeAttribs ( $ node - > [ 0 ] , [ "node" ] ) )
2008-02-06 15:21:54 +00:00
{
$ callback - > ( { data = > [ $ _ ] } ) ;
}
$ tab - > close ;
2008-01-18 16:47:26 +00:00
}
2008-01-21 19:39:09 +00:00
2008-01-18 16:47:26 +00:00
}
2007-10-26 22:44:33 +00:00
2009-04-14 18:27:43 +00:00
sub rnoderange
{
my $ nodes = shift ;
my $ args = shift ;
my $ callback = shift ;
my $ data = abbreviate_noderange ( $ nodes ) ;
if ( $ data ) {
$ callback - > ( { data = > [ $ data ] } ) ;
}
}
2007-10-26 22:44:33 +00:00
#####################################################
# nodels command
#####################################################
2008-02-06 15:21:54 +00:00
sub nodels
{
my $ nodes = shift ;
my $ args = shift ;
my $ callback = shift ;
my $ noderange = shift ;
2008-07-18 19:37:43 +00:00
unless ( $ nodes ) {
$ nodes = [] ;
}
2008-02-06 15:21:54 +00:00
my $ VERSION ;
my $ HELP ;
2008-07-18 22:36:32 +00:00
my $ nodels_usage = sub
2008-02-06 15:21:54 +00:00
{
2008-03-08 14:14:00 +00:00
my $ exitcode = shift @ _ ;
2008-02-06 15:21:54 +00:00
my % rsp ;
2008-03-08 14:14:00 +00:00
push @ { $ rsp { data } } , "Usage:" ;
2010-03-05 22:28:36 +00:00
push @ { $ rsp { data } } , " nodels [noderange] [-b|--blame] [-H|--with-fieldname] [table.attribute | shortname] [...]" ;
2008-03-08 14:14:00 +00:00
push @ { $ rsp { data } } , " nodels {-v|--version}" ;
push @ { $ rsp { data } } , " nodels [-?|-h|--help]" ;
if ( $ exitcode ) { $ rsp { errorcode } = $ exitcode ; }
$ callback - > ( \ % rsp ) ;
2008-07-18 22:36:32 +00:00
} ;
2008-02-06 15:21:54 +00:00
2008-07-18 19:37:43 +00:00
if ( $ args ) {
@ ARGV = @ { $ args } ;
} else {
@ ARGV = ( ) ;
}
2008-05-19 17:59:56 +00:00
my $ NOTERSE ;
2010-03-05 22:28:36 +00:00
my $ ATTRIBUTION ;
2008-10-31 12:16:28 +00:00
2010-03-05 22:28:36 +00:00
if ( ! GetOptions ( 'h|?|help' = > \ $ HELP , 'H|with-fieldname' = > \ $ NOTERSE , 'b|blame' = > \ $ ATTRIBUTION , 'v|version' = > \ $ VERSION , ) ) { $ nodels_usage - > ( 1 ) ; return ; }
2007-10-26 22:44:33 +00:00
2008-02-06 15:21:54 +00:00
# Help
2008-10-31 12:16:28 +00:00
if ( $ HELP ) { $ nodels_usage - > ( 0 ) ; return ; }
2007-10-26 22:44:33 +00:00
2008-02-06 15:21:54 +00:00
# Version
if ( $ VERSION )
{
my % rsp ;
2008-07-07 18:29:55 +00:00
my $ version = xCAT::Utils - > Version ( ) ;
2008-07-18 19:37:43 +00:00
$ rsp { data } - > [ 0 ] = "$version" ;
$ callback - > ( \ % rsp ) ;
2008-02-06 15:21:54 +00:00
return ;
}
# TODO -- Parse command arguments
# my $opt;
# my %attrs;
# foreach $opt (@ARGV) {
# if ($opt =~ /^group/) {
# }
# }
my $ argc = @ ARGV ;
2008-05-16 21:14:09 +00:00
my $ terse = 2 ;
2008-05-19 17:59:56 +00:00
if ( $ NOTERSE ) {
$ terse = 0 ;
}
2008-02-06 15:21:54 +00:00
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)
2008-07-18 19:37:43 +00:00
my $ rsp ; #build up fewer requests, be less chatty
2008-02-06 15:21:54 +00:00
if ( $ argc )
{
my % tables ;
foreach ( @ ARGV )
{
my $ table ;
my $ column ;
2008-09-07 16:31:56 +00:00
my $ value ;
my $ matchtype ;
2008-02-06 15:21:54 +00:00
my $ temp = $ _ ;
2008-09-07 16:31:56 +00:00
if ( $ temp =~ /^[^=]*\!=/ ) {
( $ temp , $ value ) = split /!=/ , $ temp , 2 ;
$ matchtype = 'natch' ;
}
elsif ( $ temp =~ /^[^=]*=~/ ) {
( $ temp , $ value ) = split /=~/ , $ temp , 2 ;
2008-09-07 16:33:47 +00:00
$ value =~ s/^\/// ;
$ value =~ s/\/$// ;
2008-09-07 16:31:56 +00:00
$ matchtype = 'regex' ;
}
elsif ( $ temp =~ /[^=]*==/ ) {
( $ temp , $ value ) = split /==/ , $ temp , 2 ;
$ matchtype = 'match' ;
}
elsif ( $ temp =~ /[^=]*!~/ ) {
( $ temp , $ value ) = split /!~/ , $ temp , 2 ;
2008-09-07 16:33:47 +00:00
$ value =~ s/^\/// ;
$ value =~ s/\/$// ;
2008-09-07 16:31:56 +00:00
$ matchtype = 'negex' ;
}
2008-02-06 15:21:54 +00:00
if ( $ shortnames { $ temp } )
{
( $ table , $ column ) = @ { $ shortnames { $ temp } } ;
2008-05-16 21:14:09 +00:00
$ terse - - ;
2008-04-22 14:29:14 +00:00
} elsif ( $ temp =~ /\./ ) {
2008-02-06 15:21:54 +00:00
( $ table , $ column ) = split ( '\.' , $ temp , 2 ) ;
2008-05-16 21:14:09 +00:00
$ terse - - ;
2008-04-22 14:29:14 +00:00
} elsif ( $ xCAT:: Schema:: tabspec { $ temp } ) {
2008-05-16 21:14:09 +00:00
$ terse = 0 ;
2008-04-22 14:29:14 +00:00
$ 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 ;
2008-02-06 15:21:54 +00:00
}
2008-04-22 14:29:14 +00:00
2008-03-03 21:00:13 +00:00
unless ( grep /$column/ , @ { $ xCAT:: Schema:: tabspec { $ table } - > { cols } } ) {
$ callback - > ( { error = > "$table.$column not a valid table.column description" , errorcode = > [ 1 ] } ) ;
next ;
}
2008-02-06 15:21:54 +00:00
unless ( grep /^$column$/ , @ { $ tables { $ table } } )
{
push @ { $ tables { $ table } } ,
2008-09-07 16:31:56 +00:00
[ $ column , $ temp , $ value , $ matchtype ] ; #Mark this as something to get
2008-02-06 15:21:54 +00:00
}
}
my $ tab ;
my % noderecs ;
2008-09-07 16:31:56 +00:00
my % filterednodes = ( ) ;
my % mustdisplaynodes = ( ) ;
my % forcedisplaykeys = ( ) ;
2008-02-06 15:21:54 +00:00
foreach $ tab ( keys % tables )
{
my $ tabh = xCAT::Table - > new ( $ tab ) ;
unless ( $ tabh ) { next ; }
#print Dumper($tables{$tab});
my $ node ;
2008-07-18 19:25:15 +00:00
my % labels ;
2008-09-07 16:31:56 +00:00
my % values ;
my % matchtypes ;
2008-07-18 19:37:43 +00:00
my @ cols = ( ) ;
2008-09-07 16:31:56 +00:00
foreach ( @ { $ tables { $ tab } } )
2008-07-18 19:25:15 +00:00
{
push @ cols , $ _ - > [ 0 ] ;
2008-09-07 16:31:56 +00:00
$ 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 ] ;
}
2008-07-18 19:25:15 +00:00
}
2009-09-17 18:27:07 +00:00
my $ nodekey = "node" ;
if ( defined $ xCAT:: Schema:: tabspec { $ tab } - > { nodecol } ) {
$ nodekey = $ xCAT:: Schema:: tabspec { $ tab } - > { nodecol }
} ;
2008-07-18 19:25:15 +00:00
my $ removenodecol = 1 ;
2009-09-17 18:27:07 +00:00
if ( grep /^$nodekey$/ , @ cols ) {
2008-07-18 19:25:15 +00:00
$ removenodecol = 0 ;
}
2010-03-05 22:28:36 +00:00
my $ rechash = $ tabh - > getNodesAttribs ( $ nodes , \ @ cols , withattribution = > $ ATTRIBUTION ) ;
2008-02-06 15:21:54 +00:00
foreach $ node ( @$ nodes )
{
my @ cols ;
2008-07-18 19:25:15 +00:00
my $ recs = $ rechash - > { $ node } ; #$tabh->getNodeAttribs($node, \@cols);
2008-09-07 16:31:56 +00:00
my % satisfiedreqs = ( ) ;
2008-07-18 19:25:15 +00:00
foreach my $ rec ( @$ recs ) {
foreach ( keys %$ rec )
{
2010-03-05 22:28:36 +00:00
if ( $ _ eq '!!xcatgroupattribution!!' ) { next ; }
2009-09-17 18:27:07 +00:00
if ( $ _ eq $ nodekey and $ removenodecol ) { next ; }
2008-09-07 16:31:56 +00:00
$ 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 { $ _ } ] ;
}
2010-03-05 22:28:36 +00:00
if ( $ rec - > { '!!xcatgroupattribution!!' } and $ rec - > { '!!xcatgroupattribution!!' } - > { $ _ } ) {
$ datseg { data } - > [ 0 ] - > { contents } = [ $ rec - > { $ _ } . " (inherited from group " . $ rec - > { '!!xcatgroupattribution!!' } - > { $ _ } . ")" ] ;
} else {
$ datseg { data } - > [ 0 ] - > { contents } = [ $ rec - > { $ _ } ] ;
}
2008-09-07 16:31:56 +00:00
$ 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 ;
2008-05-16 21:14:09 +00:00
}
2008-02-06 15:21:54 +00:00
}
}
#$rsp->{node}->[0]->{data}->[0]->{desc}->[0] = $_;
#$rsp->{node}->[0]->{data}->[0]->{contents}->[0] = $_;
$ tabh - > close ( ) ;
undef $ tabh ;
}
2008-09-07 16:31:56 +00:00
foreach ( keys % mustdisplaynodes ) {
if ( $ filterednodes { $ _ } or defined $ noderecs { $ _ } ) {
next ;
}
$ noderecs { $ _ } = [ { name = > [ $ _ ] } ] ;
}
foreach ( keys % filterednodes ) {
delete $ noderecs { $ _ } ;
}
2008-02-06 15:21:54 +00:00
foreach ( sort ( keys % noderecs ) )
{
push @ { $ rsp - > { "node" } } , @ { $ noderecs { $ _ } } ;
}
2007-10-26 22:44:33 +00:00
}
2008-02-06 15:21:54 +00:00
else
{
2010-02-08 04:30:01 +00:00
foreach ( sort @$ nodes )
2008-02-06 15:21:54 +00:00
{
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 ) ;
2010-01-29 08:23:22 +00:00
my @ nodes ;
foreach ( @ ents ) {
if ( $ _ - > { node } ) {
push @ nodes , $ _ - > { node } ;
}
}
@ nodes = sort { $ a cmp $ b } @ nodes ;
foreach ( @ nodes ) {
2008-07-18 19:37:43 +00:00
my $ rsp ;
2010-01-29 08:23:22 +00:00
#if ($_)
#{
$ rsp - > { node } - > [ 0 ] - > { name } - > [ 0 ] = ( $ _ ) ;
2008-02-06 15:21:54 +00:00
# $rsp->{node}->[0]->{data}->[0]->{contents}->[0]="$_->{node} node contents";
# $rsp->{node}->[0]->{data}->[0]->{desc}->[0]="$_->{node} node desc";
$ callback - > ( $ rsp ) ;
2010-01-29 08:23:22 +00:00
#}
2008-02-06 15:21:54 +00:00
}
}
}
2007-10-26 22:44:33 +00:00
2008-02-06 15:21:54 +00:00
return 0 ;
2007-10-26 22:44:33 +00:00
}
2010-02-03 22:06:43 +00:00
#########
# tabch
#########
2010-02-04 06:03:24 +00:00
2010-02-03 22:06:43 +00:00
sub tabch {
my $ args = shift ;
my $ callback = shift ;
my @ ARGV = @ { $ args } ;
2010-02-04 04:03:46 +00:00
my $ delete = 0 ;
2010-02-04 06:03:24 +00:00
if ( $ ARGV [ 0 ] =~ /^-d$/ ) {
2010-02-04 04:03:46 +00:00
shift @ ARGV ;
$ delete = 1 ;
}
2010-02-04 06:03:24 +00:00
2010-02-03 22:06:43 +00:00
my $ target = shift @ ARGV ;
my % tables ;
my % keyhash = ( ) ;
my @ keypairs = split ( /,/ , $ target ) ;
if ( $ keypairs [ 0 ] !~ /([^\.\=]+)\.([^\.\=]+)\=(.+)/ ) {
foreach ( @ keypairs ) {
m/(.*)=(.*)/ ;
my $ key = $ 1 ;
my $ val = $ 2 ;
$ keyhash { $ key } = $ val ;
}
} else {
unshift ( @ ARGV , $ target ) ;
}
2010-02-04 04:03:46 +00:00
if ( $ delete ) {
my @ tables_to_del = @ ARGV ;
if ( @ tables_to_del == 0 ) {
$ callback - > ( { error = > [ "Missing table name." ] , errorcode = > [ 1 ] } ) ;
return ;
}
for ( @ tables_to_del ) {
$ tables { $ _ } = xCAT::Table - > new ( $ _ , - create = > 1 , - autocommit = > 0 ) ;
$ tables { $ _ } - > delEntries ( \ % keyhash ) ;
$ tables { $ _ } - > commit ;
}
} else {
my % tableupdates ;
for ( @ ARGV ) {
my $ temp ;
my $ table ;
my $ column ;
my $ value ;
( $ table , $ temp ) = split ( '\.' , $ _ , 2 ) ;
( $ column , $ value ) = split ( "=" , $ temp , 2 ) ;
unless ( $ tables { $ table } ) {
my $ tab = xCAT::Table - > new ( $ table , - create = > 1 , - autocommit = > 0 ) ;
if ( $ tab ) {
$ tables { $ table } = $ tab ;
} else {
$ callback - > ( { error = > [ "Table $table does not exist." ] , errorcode = > [ 1 ] } ) ;
}
2010-02-03 22:06:43 +00:00
}
2010-02-04 06:03:24 +00:00
$ tableupdates { $ table } { $ column } = $ value ;
2010-02-04 04:03:46 +00:00
$ tableupdates { $ table } { $ column } = $ value ;
2010-02-03 22:06:43 +00:00
}
2010-02-04 06:03:24 +00:00
#commit all the changes
foreach ( keys % tables ) {
if ( exists ( $ tableupdates { $ _ } ) ) {
$ tables { $ _ } - > setAttribs ( \ % keyhash , \ % { $ tableupdates { $ _ } } ) ;
}
$ tables { $ _ } - > commit ;
}
2010-02-03 22:06:43 +00:00
2010-02-04 04:03:46 +00:00
#commit all the changes
foreach ( keys % tables ) {
if ( exists ( $ tableupdates { $ _ } ) ) {
$ tables { $ _ } - > setAttribs ( \ % keyhash , \ % { $ tableupdates { $ _ } } ) ;
}
$ tables { $ _ } - > commit ;
}
}
2010-02-03 22:06:43 +00:00
}