Server IP : 103.119.228.120 / Your IP : 3.133.146.94 Web Server : Apache System : Linux v8.techscape8.com 3.10.0-1160.119.1.el7.tuxcare.els2.x86_64 #1 SMP Mon Jul 15 12:09:18 UTC 2024 x86_64 User : nobody ( 99) PHP Version : 5.6.40 Disable Function : shell_exec,symlink,system,exec,proc_get_status,proc_nice,proc_terminate,define_syslog_variables,syslog,openlog,closelog,escapeshellcmd,passthru,ocinum cols,ini_alter,leak,listen,chgrp,apache_note,apache_setenv,debugger_on,debugger_off,ftp_exec,dl,dll,myshellexec,proc_open,socket_bind,proc_close,escapeshellarg,parse_ini_filepopen,fpassthru,exec,passthru,escapeshellarg,escapeshellcmd,proc_close,proc_open,ini_alter,popen,show_source,proc_nice,proc_terminate,proc_get_status,proc_close,pfsockopen,leak,apache_child_terminate,posix_kill,posix_mkfifo,posix_setpgid,posix_setsid,posix_setuid,dl,symlink,shell_exec,system,dl,passthru,escapeshellarg,escapeshellcmd,myshellexec,c99_buff_prepare,c99_sess_put,fpassthru,getdisfunc,fx29exec,fx29exec2,is_windows,disp_freespace,fx29sh_getupdate,fx29_buff_prepare,fx29_sess_put,fx29shexit,fx29fsearch,fx29ftpbrutecheck,fx29sh_tools,fx29sh_about,milw0rm,imagez,sh_name,myshellexec,checkproxyhost,dosyayicek,c99_buff_prepare,c99_sess_put,c99getsource,c99sh_getupdate,c99fsearch,c99shexit,view_perms,posix_getpwuid,posix_getgrgid,posix_kill,parse_perms,parsesort,view_perms_color,set_encoder_input,ls_setcheckboxall,ls_reverse_all,rsg_read,rsg_glob,selfURL,dispsecinfo,unix2DosTime,addFile,system,get_users,view_size,DirFiles,DirFilesWide,DirPrintHTMLHeaders,GetFilesTotal,GetTitles,GetTimeTotal,GetMatchesCount,GetFileMatchesCount,GetResultFiles,fs_copy_dir,fs_copy_obj,fs_move_dir,fs_move_obj,fs_rmdir,SearchText,getmicrotime MySQL : ON | cURL : ON | WGET : ON | Perl : ON | Python : ON | Sudo : ON | Pkexec : ON Directory : /usr/local/ssl/local/ssl/local/ssl/local/ssl/local/share/perl5/List/ |
Upload File : |
package List::Cycle; use warnings; use strict; use Carp (); =head1 NAME List::Cycle - Objects for cycling through a list of values =head1 VERSION Version 1.02 =cut our $VERSION = '1.02'; =head1 SYNOPSIS List::Cycle gives you an iterator object for cycling through a series of values. The canonical use is for cycling through a list of colors for alternating bands of color on a report. use List::Cycle; my $colors = List::Cycle->new( {values => ['#000000', '#FAFAFA', '#BADDAD']} ); print $colors->next; # #000000 print $colors->next; # #FAFAFA print $colors->next; # #BADDAD print $colors->next; # #000000 print $colors->next; # #FAFAFA ... etc ... You'd call it at the top of a loop: while ( ... ) { my $color = $colors->next; print qq{<tr bgcolor="$color">; ... } Note that a List::Cycle object is not a standard Perl blessed hash. It's an inside-out object, as suggested in I<Perl Best Practices>. In the seven years since I<PBP> has come out, inside-out objects have been almost universally ignored, but I keep List::Cycle as an example. If you don't care about the internals of the object, then List::Cycle is a fine module for you to use. =head1 FUNCTIONS =head2 new( {values => \@values} ) Creates a new cycle object, using I<@values>. The C<values> keyword can be C<vals>, if you like. =cut my %storage = ( values => \my %values_of, pointer => \my %pointer_of, ); sub new { my $class = shift; my $args = shift; my $self = \do { my $scalar }; bless $self, $class; $self->_init( %{$args} ); return $self; } sub _init { my $self = shift; my @args = @_; $self->_store_pointer( 0 ); while ( @args ) { my $key = shift @args; my $value = shift @args; if ( $key =~ /^val(?:ue)?s$/ ) { $self->set_values($value); } else { Carp::croak( "$key is not a valid constructor value" ); } } return $self; } =head2 C<< $cycle->set_values(\@values) >> Sets the cycle values and resets the internal pointer. =cut sub set_values { my ($self, $values) = @_; $values_of{ $self } = $values; $self->reset; return; } sub DESTROY { my $self = shift; for my $attr_ref ( values %storage ) { delete $attr_ref->{$self}; } return; } sub _pointer { my $self = shift; return $pointer_of{ $self }; } sub _store_pointer { my $self = shift; $pointer_of{ $self } = shift; return; } sub _inc_pointer { my $self = shift; my $ptr = $self->_pointer; $self->_store_pointer(($ptr+1) % @{$values_of{$self}}); return; } =head2 $cycle->reset Sets the internal pointer back to the beginning of the cycle. my $color = List::Cycle->new( {values => [qw(red white blue)]} ); print $color->next; # red print $color->next; # white $color->reset; print $color->next; # red, not blue =cut sub reset { my $self = shift; $self->_store_pointer(0); return; } =head2 $cycle->dump Returns a handy string representation of internals. =cut sub dump { my $self = shift; my $str = ''; while ( my($key,$value) = each %storage ) { my $realval = $value->{$self}; $realval = join( ',', @{$realval} ) if UNIVERSAL::isa( $realval, 'ARRAY' ); $str .= "$key => $realval\n"; } return $str; } =head2 $cycle->next Gives the next value in the sequence. =cut sub next { my $self = shift; Carp::croak( 'no cycle values provided!' ) unless $values_of{ $self }; my $ptr = $self->_pointer; $self->_inc_pointer; return $values_of{ $self }[$ptr]; } =head1 AUTHOR Andy Lester, C<< <andy at petdance.com> >> =head1 SUPPORT You can find documentation for this module with the perldoc command. perldoc List::Cycle You can also look for information at: =over 4 =item * AnnoCPAN: Annotated CPAN documentation L<http://annocpan.org/dist/List-Cycle> =item * CPAN Ratings L<http://cpanratings.perl.org/d/List-Cycle> =item * RT: CPAN's request tracker L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=List-Cycle> =item * Search CPAN L<http://search.cpan.org/dist/List-Cycle> =item * Source code repository L<http://github.com/petdance/list-cycle> =back =head1 BUGS Please report any bugs or feature requests to C<bug-list-cycle @ rt.cpan.org>, or through the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=List-Cycle>. I will be notified, and then you'll automatically be notified of progress on your bug as I make changes. =head1 ACKNOWLEDGEMENTS List::Cycle is a playground that uses some of the ideas in Damian Conway's marvelous I<Perl Best Practices>. L<http://www.oreilly.com/catalog/perlbp/> One of the chapters mentions a mythical List::Cycle module, so I made it real. Thanks also to Ricardo SIGNES and Todd Rinaldo for patches. =head1 COPYRIGHT & LICENSE Copyright 2005-2012 Andy Lester. This program is free software; you can redistribute it and/or modify it under the terms of the Artistic License v2.0. =cut 1; # End of List::Cycle