| Fry-Shell documentation | Contained in the Fry-Shell distribution. |
Fry::Sub - Class for shell subroutines
This class mainly provides a means to pick and choose among a group of subroutines that have the same functionality via &subHook. It is also serving as a storage class for practical subroutines to be reused by any library.
Subroutine Methods call($a_sub,@args): Calls given subroutine id or alias with its arguments. subHook(%args): Creates a subroutine hook. Has the following keys: var: Variable containing current id of a subroutine object. default: Default subroutine id to call if var is set to an invalid subroutine object. args: Optional,argument passed to subroutine. Practical Subroutines chooseItems(@choices): Presents the given choices in a menu format, waits for input to choose items and returns chosen items. The input is parsed by parseNum, see it for input format. spliceArray($arrayref,$value): Deletes value from given arrayref. useThere($package,$useclass): The $useclass is used in the given $package. Parse Subroutines parseChunks($input): Splits input line with pipes into separate commands. parseMultiline(\$input): Parses multiline input. parseOptions(\$input): Parses options from input. parseNormal($input): Default parser for command section of input, splitting commands and arguments by whitespace. parseEval($input): Parser that parses part of the line with &parseNormal and evals the rest. The variable eval_splitter determines the splitting point. This parser is used often with the &objectAct command: -p=e objectAct selectall_arrayref,,'select * from pmodule' parseMenu($input): Parser used by menu option. Substitutes a number format with values. The number format is a comma separated list of values. A range of values can be specified with a '-' between numbers. Valid number formats are 1-5,8,12 and 1,8,4 . parseNum($entry,@args): Used by parseMenu to substitute numbers. Same format as parseMenu but only accepting one entry. CmdList Subroutines cmd_normal(): lists all object ids from command class cmd_alias(): lists all object ids and aliases from command class Other empty(): empty subroutine, usually serves as a default subroutine for subroutine hooks
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.
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.
| Fry-Shell documentation | Contained in the Fry-Shell distribution. |
package Fry::Sub; use strict; use base 'Fry::List'; use base 'Fry::Base'; use base 'Fry::ShellI'; our @ISA; our $LibClass = "Fry::Sub::_Methods"; package Fry::Sub::_Methods; package Fry::Sub; push(@ISA,'Fry::Sub::_Methods'); my $list = {}; sub list { return $list } sub _default_data { { subs=>{ normal=>{qw/a n sub parseNormal/}, menu=>{qw/a m sub parseMenu/}, eval=>{qw/a e sub parseEval/},defaultTest=>{}, empty=>{}, cmd_normal=>{qw/a cn/}, cmd_alias=>{qw/a ca/}, cmd_extra=>{qw/a ce/}, #cmdList=>{qw/a cl/}, } } } #Class Methods sub defaultNew { my %opt = (ref $_[-1] eq "ARRAY") ? @{pop(@_)} : (); my ($cls,%arg) = @_; $cls->manyNew(%arg); for my $cmd (keys %arg) { $cls->set($cmd,'sub',$cmd) if (! $cls->attrExists($cmd,'sub')); } #not used for now push(@Fry::Sub::_Methods::ISA,$opt{module}) if (exists $opt{module} && $opt{module} !~ /^(Fry::Sub|Fry::Shell)$/); } sub call { my ($cls,$a_sub,@args) = @_; my $sub = $cls->anyAlias($a_sub); $cls->callSubAttr(id=>$sub,attr=>'sub',args=>\@args); } sub subHook { my ($cls,%arg) = @_; my $chosensub = $cls->Var($arg{var}); my @args = (ref $arg{args} eq "ARRAY") ? @{$arg{args}} : $arg{args} ; if ($cls->findAlias($chosensub)) { $cls->call($chosensub,@args) } else { $cls->call($arg{default},@args) } } #utility methods- currently aren't defined as objects but may #soon be for organization purposes sub chooseItems { my ($o,@choices) = @_; $o->View->list(@choices); my $input = $o->Rline->stdin("Choose items: "); return ($o->parseNum($input,@choices) ); } sub _require ($$$) { my %opt = (ref $_[-1] eq "HASH") ? %{pop @_} : (); my $cls = ref $_[0] || $_[0]; shift; my $class = shift; my $message = shift || ""; eval "require $class"; if ($@) { $message .= ": $@"; ($opt{warn}) ? warn($message) : die($message); } } sub useThere ($$$) { my ($o,$useclass,$thereclass) = @_; #my $original_package = caller(); eval "package $thereclass; use $useclass" } sub spliceArray ($$$) { my ($o,$array,$goner) =@_; @$array = grep (!/^$goner$/,@$array); } ##The rest are sub objects or could be #parse subs sub parseNormal ($$) { return split(/\s+/,$_[1]) } sub parseEval ($$) { my ($o,$input) = @_; my $splitter = $o->Var('eval_splitter'); my (@noneval,@eval,$cmd); if ($input =~ $splitter) { my ($noneval,$eval) = split(/$splitter/,$input,2); @noneval = $o->parseNormal($noneval); @eval = "$eval"; } else { ($cmd,@eval) = split(/\s+/,$input,2); @noneval = $cmd; } my $text = '@eval'; eval "$text = (@eval)"; #eval { @eval = ("@eval") }; die("invalid evaled statement: $@") if ($@); return (@noneval,@eval); } sub parseMenu ($$) { #d: creates @cmd_beg,@entry and @save from @args #my ($o,@args) = @_; my $o = shift; my @args = split(/ /,shift()); my @cmd_beg = shift (@args); my $i = 0; #td: fix uninitialized warning no warnings; if ($args[0] ne "") { #push anything that isn't a num choice to @cmd_beg while (($args[$i] !~ /\b\d+\b/) && ($args[$i] !~ /\b\d+-\d+,?/) && @args > 0) { push (@cmd_beg, shift(@args)); } } my @save = $o->_parseMultiNum(\@args); if (@args > 0) { return (@cmd_beg,@save,@args); } else {return (@cmd_beg,@save,@args); } } sub _parseMultiNum ($@) { my ($o,$args) = @_; my (@save,@entry,$i); #td: fix uninitialized warning no warnings; #@entry-contains num choices while (($args->[$i] =~ /\b\d+\b/) || ($args->[$i] =~ /\d-\d,?/)) { push(@entry,$args->[$i]); shift(@$args); $i++; } #save chosen lines of @lines into @save foreach (@entry) { @save = $o->parseNum($_,@{$o->Var('lines')})}; return @save; } sub parseNum ($@){ my $class = shift; my @save;my $e;my $count; my ($entry,@choose) = (@_); #td: fix unitialized warning no warnings; die("Invalid argument, $entry , passed to &parse_num. Doesn't contain any numbers.") if ($entry !~ /\d/); my @entries = split(/,/,$entry); foreach $e (@entries) { if ($e =~ /-/) { my ($min,$max) = split("-",$e); for( $a = $min;$a <= $max;$a++) { $save[$count]=$choose[$a-1]; #note that -1 is there for the offset b/n the arrays $count++; } } else { $save[$count]=$choose[$e-1]; $count++;} #note that -1 is there for the offset b/n the arrays } return @save; } sub parseChunks($$) { my ($o,$input) = @_; my $pipe_char = $o->Var('pipe_char'); return split(/$pipe_char/,$input); } sub parseMultiline($\$) { my ($o,$input) = @_; $$input =~ s/\n//g; } sub parseOptions ($\$) { my ($o,$input) = @_; my %opt; #split just in case input is scalar my @args = split(/ /,$$input); #to avoid uninit pattern match of args no warnings; #could've solved w/: push(@args,'') while ($args[0] =~ /^-\w/) { #shift off '-' my $option = substr($args[0],1) || ""; #variables and subs + flag = 0 if ($option =~ /=/) { my ($key,$value); ($key,$value) = split(/=/,$option); $opt{$key} = $value; } #flags else { $opt{$option} =1 } shift @args; } $$input = "@args"; return %opt; } #cmd autocompletion sub cmd_alias {$_[0]->cmd->listAliasAndIds } sub cmd_normal { $_[0]->cmd->listIds } #sub cmd_extra { $_[0]->lib->allAttr('cmds') } #sub cmdList ($) { ($_[0]->Flag('extra_cmds') ) ? $_[0]->lib->allAttr('cmds') : $_[0]->cmd->listIds } #other sub empty {} sub defaultTest ($) { return 1} 1; __END__ Serves as a handler for various subs shared by modules Allows aliasing of sub,verification of type,maybe tests to verify its a type sub autoViewHandler { for $sub (@stack) { if(my $condsub = $cls->get($sub,'cond')) { if($cls->call($condsub,@args)){ $cls->get($sub,'view') && $cls->call($cls->get($sub,'view'),@args); return } next; } #warning } } sub call2 { my ($cls,$a_sub,@args) = @_; my $sub = $cls->anyAlias($a_sub); if (my $method = $cls->get($sub,'sub')) { #sub called as fn return $cls->$method(@args); } #undefined sub else { return $cls->$sub(@args) } } sub AUTOLOAD { #can use for prettier call of sub ie $o->Sub->_require('blah') instead of $o->Sub('require','blah'); our $AUTOLOAD; $AUTOLOAD =~ s/^.*::(\w+)$/\1/; #__PACKAGE__->$AUTOLOAD(@_); print "here with $AUTOLOAD, @_\n"; } sub createSubs { my ($cls,@subs) = @_; no strict 'refs'; my $caller = "Fry::Shell"; for (@subs) { *{"${cls}::$_"} = *{"${caller}::$_"} } } __END__