package Fry::Lib::Default; use strict; sub _default_data { return { cmds=>{ objectAct=>{a=>'o',u=>'$obj $libcmd @args', d=>'Executes given object\'s method with its arguments', cmpl=>\&cmpl_objact, }, classAct=>{a=>'c',u=>'$lib $method @args',cmpl=>\&cmpl_classact, d=>'Executes class method with its arguments'}, printVarObj=>{a=>'\pv',arg=>'@var', d=>'Dumps variable objects'}, printCmdObj=>{a=>'\pc',arg=>'@cmd', d=>'Dumps command objects'}, printOptObj=>{a=>'\po',arg=>'@opt', d=>'Dumps option objects' }, printLibObj=>{a=>'\pl',arg=>'@lib', d=>'Dumps library objects'}, printSubObj=>{a=>'\ps',arg=>'@sub', d=>'Dumps sub objects'}, printObjObj=>{a=>'\pO',arg=>'@obj', d=>'Dumps obj objects'}, printGeneralAttr=>{a=>'\pg',u=>'$sh_comp$attr@ids', d=>'Dumps an attribute of specified shell component'}, #printErrObj=>{a=>'\pe',arg=>'@obj', d=>'Dumps error objects'}, #listErrs=> #{d=>'List errors',u=>'',a=>'\le'}, listVars=> {d=>'List variables',u=>'',a=>'\lv'}, listOptions=> {d=>'List loaded options', u=>'',a=>'\lo'}, listSubs=>{d=>'List subs',u=>'',a=>'\ls'}, listObjs=>{d=>'List objs',u=>'',a=>'\lO'}, #listErrors=>{d=>'List errors',u=>'',a=>'\le'}, listCmds=> {d=>'List loaded commands', u=>'',a=>'\lc',} , listLibs=>{a=>'\ll',d=>'List loaded libraries'}, varValue=>{a=>'\vv',d=>'Prints variable values',arg=>'@var'}, helpUsage=>{d=>'Prints usage of function(s)', a=>'h',arg=>'@cmd'}, helpDescription=> {d=>'Prints brief description of function(s)', ,a=>'\h',arg=>'@cmd'}, quit=>{d=>'Quits shell', u=>'',a=>'q'}, findVar=>{a=>'\fv',d=>'Finds variables by attribute'}, findOpt=>{a=>'\fo',d=>'Finds options by attribute'}, findCmd=>{a=>'\fc',d=>'Finds commands by attribute'}, findSub=>{a=>'\fs',d=>'Finds subs by attribute'}, findLib=>{a=>'\fl',d=>'Finds libraries by attribute'}, findObj=>{a=>'\fO',d=>'Finds objects by attribute'}, unloadLib=>{a=>'\ul',arg=>'@lib',d=>'Unloads libraries'}, unloadSub=>{a=>'\us',arg=>'@lib',d=>'Unloads subs'}, unloadCmd=>{a=>'\uc',arg=>'@cmd',d=>'Unloads commands'}, unloadOpt=>{a=>'\uo',arg=>'@opt',d=>'Unloads options'}, unloadVar=>{a=>'\uv',arg=>'@var',d=>'Unloads variables'}, unloadObj=>{a=>'\uO',arg=>'@obj',d=>'Unloads objects'}, perlExe=> {d=>'Executes arguments as perl code with eval', u=>'$perl_code',a=>'\p'}, initLibs=>{a=>'\lL',d=>'Loads and initializes libraries',u=>'@lib'}, sysExe=>{a=>'!',d=>'Executes system calls via system()',u=>'$sysCmd'}, reloadLibs=>{a=>'\rl',d=>'reload libraries',u=>'@libs'}, #setVar=>{a=>'\sV',arg=>'%var',d=>'sets}, }, vars=>{ }, subs=>{} #special=>{setMany=>[qw/objectAct/]} } } #h: multiple aliases for help *help = \&helpDescription; #core actions ##list sub listErrs ($) { shift->listGen('err') } sub listObjs ($) { shift->listGen('obj') } sub listSubs ($) { shift->listGen('sub') } sub listLibs ($) { shift->listGen('lib') } sub listVars ($) { shift->listGen('var') } sub listOptions ($) { shift->listGen('opt') } sub listCmds ($) { shift->listGen('cmd') } sub listGen ($$) { my ($cls,$core) = @_; my @list = sort $cls->List($core); $cls->saveArray(@list) if ($cls->Flag('menu')); #$cls->View->list(@list); return @list; } sub findVar ($$$$) { shift->findIdGen('var',@_) } sub findOpt ($$$$) { shift->findIdGen('opt',@_) } sub findCmd ($$$$) { shift->findIdGen('cmd',@_) } sub findSub ($$$$) { shift->findIdGen('sub',@_) } sub findLib ($$$$) { shift->findIdGen('lib',@_) } sub findObj ($$$$) { shift->findIdGen('obj',@_) } sub findIdGen ($$$$$) { my ($cls,$core,$attr,$searchtype,$value) = @_; do{ warn('Not enough arguments');return ()} if (@_ < 5); my @found_ids = $cls->$core->findIds($attr,$searchtype,$value); $cls->printGeneralObj($core,@found_ids); } ##print Obj sub printErrObj ($@) { shift->printGeneralObj('err',@_) } sub printObjObj ($@) { shift->printGeneralObj('obj',@_) } sub printSubObj ($@) { shift->printGeneralObj('sub',@_) } sub printLibObj ($@) { shift->printGeneralObj('lib',@_) } sub printVarObj ($@) { shift->printGeneralObj('var',@_) } sub printOptObj ($@) { shift->printGeneralObj('opt',@_) } sub printCmdObj ($@) { shift->printGeneralObj('cmd',@_) } sub printGeneralObj ($$@) { my ($cls,$core,@ids) = @_; my $output; #local $Data::Dumper::Deparse=1; local $Data::Dumper::Terse = 1; @ids = sort $cls->List($core) if (scalar(@ids) == 0); #my $sub = $core."Obj"; for my $id (@ids) { $output->{$id} = $cls->dumper($cls->$core->Obj($id)); } #$cls->View->hash($output,{quote=>1,sort=>1}); $cls->setVar(view_options=>{quote=>1,sort=>1}); return $output; } ##print attribute sub printGeneralAttr ($$$@) { my ($cls,$core,$attr,@ids) = @_; if (@_ < 3) { warn('Not enough arguments'); return 0} my ($output,$quote); local $Data::Dumper::Terse = 1; no strict 'refs'; @ids = sort $cls->List($core) if (scalar(@ids) == 0); for my $id (@ids) { if ($core eq "var") { $output->{$id} = $cls->dumper($cls->$core->get($id,$attr)); } else { $output->{$id} = $cls->$core->get($id,$attr); $quote =1; } } $cls->setVar(view_options=>{quote=>$quote,sort=>1}); return $output; #$cls->View->hash($output,{quote=>$quote,sort=>1}); } sub helpDescription($@) { shift->printGeneralAttr('cmd','d',@_) } sub varValue($@) { shift->printGeneralAttr('var','value',@_) } sub helpUsage ($@) { my ($cls,@cmds) = @_; #$cls->view("Note: wrap <> around optional chunks\n\n"); $cls->printGeneralAttr('cmd','u',@cmds); } ##unload sub unloadLib ($@) { shift->lib->unloadLib(@_) } sub unloadCmd ($@) { shift->call('cmd','unloadObj',@_) } sub unloadSub ($@) { shift->call('sub','unloadObj',@_) } sub unloadOpt ($@) { shift->call('opt','unloadObj',@_) } sub unloadVar ($@) { shift->call('var','unloadObj',@_) } sub unloadObj ($@) { shift->call('obj','unloadObj',@_) } #other #sub listErrors ($) { #my $cls = shift; #$cls->view($cls->Error->stringify_stack); #} sub reloadLibs ($@) { shift->lib->reloadLibs(@_) } sub initLibs ($@) { shift->lib->initLibs(@_) } sub sysExe ($@) { shift; system(@_); } sub perlExe ($@) { #?: how does it set Data::Dumper:: my $cls = shift; my $code = "@_"; eval "$code"; #eval "@_"; } sub quit ($) { $_[0]->setFlag(quit=>1) } sub objectAct ($$@) { my ($cls,$obj,$sub,@args) = @_; my @output = $cls->obj->get($obj,'obj')->$sub(@args); return @output; } sub classAct ($$$@) { #?:don't even need lib my ($o,$lib,$sub,@args) = @_; $lib = ($o->lib->fullName($lib))[0]; my @output = $o->lib->get($lib,'class')->$sub(@args); #$o->view($o->dumper(\@output)); return @output; } #maybe sub setCmdOpts($$) { my ($o,$cmd) = @_; if ($o->cmdObj($cmd)) { $o->view("Available options are:\n"); $o->View->list(@{$o->cmdObj($cmd)->{opts}}); } } #internals #test subs sub t_gen { my ($cls,$core,@ids) = @_; for (@ids) { #w: will break if obj accessors change return 0 if (not $cls->$core->objExists($_)) } return 1 } sub t_sub { shift->t_gen('cmd',@_); } sub t_cmd { shift->t_gen('cmd',@_); } sub t_opt { shift->t_gen('opt',@_); } sub t_var { shift->t_gen('var',@_); } sub t_lib { my $cls = shift; $cls->t_gen('lib',$cls->lib->fullName(@_)); } #sub t_libcmd { return 1 } #cmpl subs #was used with objectAct #sub cmpl_libcmd { my $cls = shift; return @{$cls->call(lib=>'Obj',$cls->Var('autolib'))->{cmds}} } sub cmpl_cmd { shift->List('cmd') } sub cmpl_opt { shift->List('opt') } sub cmpl_lib { shift->List('lib') } sub cmpl_var { shift->List('var') } sub cmpl_sub { shift->List('sub') } sub cmpl_objact { my $cls = shift; my ($obj) = $_[0] =~ /(\w+)/; #print "\n$obj\n"; if ($cls->obj->objExists($obj) && $cls->obj->attrExists($obj,'methods')) { return @{$cls->obj->get($obj,'methods') } } else { return ''} } sub cmpl_classact { my ($cls,$lib) = @_; $lib =~ s/\s*$//g; $lib = $cls->lib->fullName($lib); if ($cls->lib->objExists($lib) && $cls->lib->attrExists($lib,'methods')) { return @{$cls->lib->get($lib,'methods') } } else { return ''} } 1; __END__ =head1 NAME Fry::Lib::Default - Default library loaded by Fry::Shell =head1 DESCRIPTION This library contains the basic commands to manipulate shell components: listing them, dumping (printing) their objects,unloading them, loading them via a library and a few general-purpose functions. Currently the commands are documented by their above definitions in &_default_data ie their 'u' attribute describes what input they take and their 'd' attribute describes them. =head1 Autoloaded Libraries There are currently two ways of using an autoloaded library via a library's class methods or a library's object methods. These two ways use the commands classAct and objectAct respectively. Before using either command you must load an autoload library via &initLibs. =head2 &classAct The only current autoload library for &classAct is Fry::Lib::Inspector. After installing Class::Inspector, start a shell session and load this library (ie 'initLibs :Inspector'). You can now execute the class methods of Class::Inspector! Looking at the 'u' (usage) attribute of classAct above you see that the first argument is a library followed by a method and then its arguments. For example you could run the &resolved_filename method of Class::Inspector ie 'classAct :Inspector resolved_filename Class::Inspector'. Note that I don't have to change the parsing of this line as the arguments neatly split on whitespaces (the default parser). Also, the :$basename is a shorthand for libraries under Fry::Lib space. =head2 &objectAct We'll use Fry::Lib::DBI as our sample library. Installing DBI and load the library as before ie 'initLibs :DBI'. To establish your own database connection you need to define your own variables for user, password (pwd),dbms (db) and database (dbname) in a separate config file (or just change them in the module in &_initLib for a quick hack ;)). The former requires using &loadFile $filename at the commandline. You can now act on methods of a basic database handle. The usage for &objectAct indicates to pass the object name followed by its method and its arguments ie 'objectAct dbh tables' which will print out all the database's tables. A more advanced command could be "-p=e objectAct dbh selectall_arrayref,,'select * from perlfn' ". This commandline changes the parse subroutine to &parseEval and executes an sql query on the perlfn table. You should have gotten a list of records. You now have a simple DBI shell without having hardwritten any perl code! =head1 AUTHOR Me. Gabriel that is. I welcome feedback and bug reports to cldwalker AT chwhat DOT com . If you like using perl,linux,vim and databases to make your life easier (not lazier ;) check out my website at www.chwhat.com. =head1 COPYRIGHT & LICENSE Copyright (c) 2004, Gabriel Horner. All rights reserved. This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself.