package App::Sequence; use Simo; our $VERSION = '0.03_03'; use Carp; use Encode; ### accessors( by Simo ) # config file list sub conf_files{ ac default => [], filter => \&_to_array_ref, trigger => \&_update_confs } # trigger method when conf_file is set sub _update_confs{ $_->confs( $_->_rearrange_conf( $_->conf_files ) ) } # config list sub confs{ ac default => [], filter => \&_to_array_ref }; # sequence file list sub sequence_files{ ac default => [], filter => \&_to_array_ref, trigger => \&_update_sequences } # trigger method when sequence_files is set sub _update_sequences{ $_->sequences( $_->_rearrange_sequence( $_->sequence_files ) ) } # sequence list sub sequences{ ac default => [], filter => \&_to_array_ref } # module file list sub module_files{ ac default => [], filter => \&_to_array_ref, trigger => sub{ $_->_import_module( $_->module_files ) } } # retrun value sub r{ ac default => {} } # @ARGV sub argv{ ac default => [], filter => \&_to_array_ref } # convert to array ref sub _to_array_ref{ ref eq 'ARRAY' ? $_ : [ $_ ] } ### method # new is automaticaly created by Simo # create object from @ARGV sub create_from_argv{ my $self = shift->SUPER::new; my $argv = $self->_rearrange_argv( @ARGV ); $self->conf_files( $argv->{ conf_files } ); $self->sequence_files( $argv->{ sequence_files } ); $self->module_files( $argv->{ module_files } ); return $self; } # .pm files import sub _import_module{ my ( $self, $module_files ) = @_; use lib '.'; foreach my $module_file ( @{ $module_files } ){ package main; require Carp; require $module_file; Carp::croak "$module_file is not exist" if $@; } } # run all sequences sub run{ my $self = shift; foreach my $conf ( @{ $self->confs } ){ foreach my $sequence ( @{ $self->sequences } ){ my $ret = {}; $self->_run_sequence( $sequence, $conf, $ret ); } } } # run each sequence sub _run_sequence{ my ( $self, $sequence, $conf, $ret ) = @_; foreach my $func_info ( @{ $sequence } ){ $self->_run_function( $func_info, $conf, $ret ); } } # run each function sub _run_function{ my ( $self, $func_info, $conf, $ret ) = @_; my $func_name = $func_info->{ package } . '::' . $func_info->{ name }; my @args; foreach my $arg ( @{ $func_info->{ args } } ){ my $val = $self->_parse_string_data( $arg, $conf, $ret ); push @args, $val; carp "$arg is undef value" if !defined( $val ); } my $ret_key = $func_info->{ ret }; if( $ret_key && $ret_key =~ /^r\.(.+)/ ){ $ret_key = $1; } { no strict 'refs'; my $ret_val = $func_name->( @args ); if( $ret_key && $ret_key =~ /^stdout$/ ){ print "$ret_val"; } elsif( $ret_key ){ $ret->{ $ret_key } = $ret_val; } } } # parse string data structure( c.name, c.age, etc ) sub _parse_string_data{ my ( $self, $arg, $conf, $ret ) = @_; my $val; if( $arg =~ s/^c\.// ){ my @keys = split /\./, $arg; my $current = $conf; foreach my $key ( @keys ){ $current = $current->{ $key }; } $val = $current; } elsif( $arg =~ /r\.(.+)/ ){ $val = $ret->{ $1 }; } return $val; } # rearrange @ARGV sub _rearrange_argv{ my ( $self, @argv ) = @_; my $rearranged_argv = { sequence_files => [], module_files => [], conf_files => [] }; if( my $meta_file = $self->_meta_file_contain( @argv ) ){ @argv = $self->_parse_meta_file( $meta_file ); } foreach my $arg ( @argv ){ if( $arg =~ /\.as/ ){ push @{ $rearranged_argv->{ sequence_files } }, $arg; } elsif( $arg =~ /\.pm/ ){ push @{ $rearranged_argv->{ module_files } }, $arg; } elsif( $arg =~ /\.csv$/ || $arg =~ /\.ya?ml$/ || $arg =~ /\.xml$/ || $arg =~ /\.ini$/ || $arg =~ /\.json$/ ) { push @{ $rearranged_argv->{ conf_files } }, $arg; } else{ croak "'$arg' is invalid param. param must be in ( .as .pm .csv .yaml .yml .xml .ini .json )"; } } croak ".as file must be passed" unless @{ $rearranged_argv->{ sequence_files } }; croak "config file( .csv .yaml .yml .xml .ini .json ) must be passed" unless @{ $rearranged_argv->{ conf_files } }; return $rearranged_argv; } # whether array contain meta file( .meta ) sub _meta_file_contain{ my ( $self, @argv ) = @_; my $meta_file = ( grep { /\.meta$/ } @argv )[0]; carp "Only first meta file $meta_file is received. Other arguments is ignored." if $meta_file && @argv != 1; return $meta_file; } # parse meta file, and convert @argv sub _parse_meta_file{ my ( $self, $file ) = @_; open my $fh, "<", $file or croak "Cannot open $file: $!"; my $content; { local $/ = undef; defined( $content = <$fh> ) or croak "Cannot read $file: $!"; } $content =~ s/\x0D\x0A|\x0D|\x0A/\n/g; $content =~ s/#.*\n//g; my @argv = split /\s+/, $content; require File::Basename; my $dir = File::Basename::dirname( $file ); foreach my $arg ( @argv ){ if( $arg =~ /\.\w+$/ ){ $arg = $dir . '/' . $arg; } } return @argv; } # parse .as file line sub _parse_func_expression{ my ( $self, $exp ) = @_; my $original_exp = $exp; my $func_info = { package => 'main', name => undef, args => [], ret => undef }; # delete first space; $exp =~ s/^\s*//; $exp =~ s/\s*$//; # function name if( $exp =~ s/^((?:\w+::)*)(\w+\b)// ){ if( $1 ){ my $package = $1; $package =~ s/::$//; $func_info->{ package } = $package; } $func_info->{ name } = $2; } else{ croak "function name is invalid. '$original_exp'"; } # args if( $exp =~ s/^\s*\((.*)\)\s*// ){ my $args_exp = $1; $args_exp =~ s/^\s*//; $args_exp =~ s/\s*$//; my @args = split /\s*,\s*/, $args_exp; foreach my $i ( 0 .. @args - 1 ){ unless( $args[$i] =~ /^[c|r]\.\w+$/ ){ croak "arg '$args[$i]' is invalid. arg must be like c.name or r.age, etc"; } } $func_info->{ args } = [@args]; } # retrun value if( $exp =~ s/^\s*:\s*(.+)\s*$// ){ my $ret = $1; if( $ret =~ /^(r\..+)$/ || $ret =~ /^(stdout)$/ ){ $func_info->{ ret } = $1; } else{ croak "ret '$ret' is invalid. arg must be like r.age, etc"; } } # unknown error if( $exp ){ croak "parse error '$original_exp'. expression must be like 'func_name( c.name, r.age, .. ) : r.content'"; } return $func_info; } # parse sequence file and convert to sequence data. sub _rearrange_sequence{ my ( $self, $files ) = @_; my $sequences = []; foreach my $file ( @{ $files } ){ open my $fh, "<", $file or croak "Cannot open $file : $!"; my $sequence = []; while( my $line = <$fh> ){ $line =~ s/\x0D\x0A|\x0D|\x0A/\n/g; chomp $line; my $func_info = eval{ $self->_parse_func_expression( $line ) }; croak "$file line $. : $@" if( $@ ); push @{ $sequence }, $func_info; } push @{ $sequences }, $sequence; } return $sequences; } # parse many type config file, and convert hash ref. sub _rearrange_conf{ my ( $self, $conf ) = @_; # convert array ref my $confs = ref $conf eq 'ARRAY' ? $conf : [ $conf ]; #various conf rearrange my $rearranged_confs = []; my $rearranged_conf; foreach my $conf ( @{ $confs } ){ # todo test if( ref $conf eq 'HASH' ){ $rearranged_conf = [ $conf ]; } elsif( $conf =~ /\.xml$/ ){ $rearranged_conf = $self->_parse_xml( $conf ); } elsif( $conf =~ /\.ya?ml$/ ){ require YAML; eval{ $rearranged_conf = YAML::LoadFile( $conf ); }; croak $@ if $@; } elsif( $conf =~ /\.ini$/ ){ require Config::Tiny; my $ct = Config::Tiny->new; my $tiny_obj = $ct->read( $conf ); croak $ct->errstr unless $tiny_obj; $rearranged_conf = {}; %{ $rearranged_conf } = %{ $tiny_obj }; } elsif( $conf =~ /\.csv$/ ){ $rearranged_conf = $self->_parse_csv( $conf ); } elsif( $conf =~ /\.json$/ ){ $rearranged_conf = $self->_parse_json( $conf ); } else{ croak "$conf is unacceptable as conf setting"; } $rearranged_conf = ref $rearranged_conf eq 'ARRAY' ? $rearranged_conf : [ $rearranged_conf ]; push @{ $rearranged_confs }, @{ $rearranged_conf }; } return $rearranged_confs; } # csv file arrange sub _parse_csv{ my ( $self, $conf, $charset ) = @_; $charset ||= 'utf8'; open my $fh, "<", $conf or croak "Cannot open $conf: $!"; require Text::CSV; # my $parser = Text::CSV->new({ binary => 1 }); my $parser = Text::CSV->new; my $is_first_line = 1; my @header; my $rearranged_confs = []; while( my $line = <$fh> ){ $line = decode( 'utf8', $line ); $line =~ s/\x0D\x0A|\x0D|\x0A/\n/g; chomp $line; next if $line =~ /^$/; $parser->parse( $line ); if( !$parser->status ){ croak $parser->error_diag . ': ' . $parser->error_input; } my @items = $parser->fields; if( $is_first_line ){ @header = @items; $is_first_line = 0; } else{ my $header_count = @header; croak "field count must be same as header count $header_count : $conf Line $." if @header != @items; my $rearranged_conf = {}; @{ $rearranged_conf }{ @header } = @items; push @{ $rearranged_confs }, $rearranged_conf; } } close $fh; return $rearranged_confs; } sub _parse_xml{ my ( $self, $conf ) = @_; require XML::Simple; my $parser = XML::Simple->new; my $rearranged_conf; croak "File '$conf' not exists" unless -f $conf; eval{ $rearranged_conf = $parser->XMLin( $conf ) }; croak "File '$conf': $@" if $@; return $rearranged_conf; } sub _parse_json{ my ( $self, $conf, $charset ) = @_; $charset ||= 'utf8'; open my $fh, "<", $conf or croak "Cannot open $conf: $!"; my $content = do{ local $/; <$fh> } or croak "Cannot read $conf: $!"; $content = decode( $charset, $content ); require JSON; my $rearranged_conf = JSON::from_json( $content ); close $fh; return $rearranged_conf; } =head1 NAME App::Sequence - pluggable subroutine engine. =head1 VERSION Version 0.03_03 This version is alpha version. It is experimental stage. I have many works yet( charctor set, error handling, log outputting, some bugs ) =cut =head1 SYNOPSIS apseq sequence.as module.pm config.csv or apseq argument.meta =head1 FEATURES =over 4 =item 1. Your subroutines can be execute in any combination. =item 2. Usage is very simple and flexible. =item 3. Config file is load automatically. =back =head1 Using apseq script When you install App::Sequence, apseq script is install at the same time. you can use apseq script on command line as the following way. apseq sequence.as module.pm config.csv apseq script receive three type of files. =over 4 =item 1. Sequence file( .as ), which contain subroutine names you want to execute. =item 2. Module file( .pm ), which contain subroutine definitions called by Sequence file. =item 3. Config file( .csv, .yml, .xml, .ini ), which contain data or setting. =back apseq script receive three type of file, and execute subroutines. File must be written by utf8. =head1 Three type of file =head2 Sequence file =over 4 Sequence file must be end with .as Sequence file format is get_html( c.id, c.passwd ) : r.html edit( r.html, c.encoding ) : stdout I assume that you want to get html file on the web and edit the html file by using an encoding and print STDOUT. you pass argumet to subroutine and save return value. and saved return value is used in next subroutine. =back =head2 Module file =over 4 Module file must be end with .pm Module file is perl script that subroutine is defined. sub get_html{ my ( $id, $passwd ) = @_; my $html; # ... return $html; } sub edit{ my ( $html, $encoding ) = @_; my $output; # ... return $output; } 1; # must be true value. Do not forget that last line must be true value. =back =head2 Config file Config file must be end with .csv, .yml, .xml, or .ini =over 4 =item 1. CSV file( .csv ) CSV file first line is header. CSV file format is name,age kimoto,29 ken,13 This is converted to [ { name => 'kimoto', age => '29' }, { name => 'ken', age => '13' } ] This is used in Sequence file. c.name, c.age, etc. CSV file is useful to run same sequence repeatedly.This sample repeat sequence two times. =item 2. YAML file( .yml ) YAML file is loaded by L<YAML>::LoadFile. YAML format is name: kimoto age: 29 # last line is needed! Do not forget that space is needed after colon( : ) and last line is need; This is converted to { name => 'kimoto', age => '29' } This is used in Sequence file. c.name, c.age, etc. See also L<YAML> =item 3. XML file( .xml ) XML file is loaded by L<XML::Simple>::XML <?xml version="1.0" encoding="UTF-8" ?> <config> <name>kimoto</name> <age>29</age> </config> /This is converted to { name => 'kimoto', age => '29' } This is used in Sequence file. c.name, c.age, etc. =item 4. Windows ini file( .ini ) Windows ini file is loaded by L<Config::Tiny> Windows ini format is [person] name=kimoto age=29 This is used in Sequence file. c.person.name, c.person.age, etc. See also L<Config::Tiny> =back =head1 Meta file( .meta ) You can write argument of apseq in Meta file. Meta file must be end with .meta Meta file format is sequence.as module.pm config.csv You can apseq script by passing Meta file. apseq argumets.meta =head1 FUNCTIONS App::Sequence is used through apseq script. so I do not explain each method. =head2 argv no explaination =cut =head2 conf_files no explaination =cut =head2 confs no explaination =cut =head2 create_from_argv no explaination =cut =head2 module_files no explaination =cut =head2 new no explaination =cut =head2 r no explaination =cut =head2 run no explaination =cut =head2 sequence_files no explaination =cut =head2 sequences no explaination =cut =head1 AUTHOR Yuki Kimoto C<< <kimoto.yuki at gmail.com> >> =head1 BUGS Please report any bugs or feature requests to C<bug-app-sequence at rt.cpan.org>, or through the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=App-Sequence>. I will be notified, and then you'll automatically be notified of progress on your bug as I make changes. =head1 SUPPORT You can find documentation for this module with the perldoc command. perldoc App::Sequence You can also look for information at: =over 4 =item * RT: CPAN's request tracker L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=App-Sequence> =item * AnnoCPAN: Annotated CPAN documentation L<http://annocpan.org/dist/App-Sequence> =item * CPAN Ratings L<http://cpanratings.perl.org/d/App-Sequence> =item * Search CPAN L<http://search.cpan.org/dist/App-Sequence/> =back =head1 SEE ALSO L<Plugger>, L<YAML>, L<XML::Simple>, L<Config::Tiny> =head1 COPYRIGHT & LICENSE Copyright 2008 Yuki, all rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut 1; # End of App::Sequence