view release on metacpan or search on metacpan
inc/Module/Install.pm view on Meta::CPAN
}
sub _write {
local *FH;
open FH, "> $_[0]" or die "open($_[0]): $!";
foreach ( 1 .. $#_ ) { print FH $_[$_] or die "print($_[0]): $!" }
close FH or die "close($_[0]): $!";
}
# _version is for processing module versions (eg, 1.03_05) not
# Perl versions (eg, 5.8.1).
view all matches for this distribution
view release on metacpan or search on metacpan
else {
return $Tag_SecLVL{url}{text};
}
}
sub js_print {
my $self = shift;
print <<JS;
Content-type: text/javascript
/*
AUBBC v$VERSION
JS
print <<'JS';
Fully supports dynamic view in XHTML.
*/
function MyEmCode (type, content) {
var returner = false;
if (type == 4) {
http://aubbc.googlecode.com/
Development Notes: Highlighting functions list and tags/commands for more
language highlighters. Ideas make some new tags like [perl] or have a command in the code
tag like [code]perl:print 'perl';[/code] with a default highlighting method if
a command was not used. Then highlighting of many types of code could be allowed
even markup like HTML.
Notes: This code has a lot of settings and works good
with most default settings see the POD and example files
use AUBBC;
my $aubbc = AUBBC->new();
my $message = 'Lets [b]Bold in HTML[/b]';
print $aubbc->do_all_ubbc($message);
=head1 ABSTRACT
Advanced Universal Bulletin Board Code a Perl BBcode API
view all matches for this distribution
view release on metacpan or search on metacpan
lib/AVLTree.pm view on Meta::CPAN
# Add some numbers to the tree
map { $tree->insert($_) } qw/10 20 30 40 50 25/;
# Now invoke some useful methods
# Size of the tree
printf "Size of the tree: %d\n", $tree->size();
# Query the tree
my $query = 30;
print "Query: %d, Found: %d\n", $query, $tree->find($query)?1:0;
# Remove an item
my $item = 1
if($tree->remove($item)) {
print "Item $item has been removed\n";
} else {
print "Item $item was not in the tree so it's not been removed\n";
}
printf "Size of tree is now: %d\n", $tree->size();
...
# Suppose you want the tree to hold generic data items, e.g. hashrefs
# which hold some data. We can deal with these by definying a custom
lib/AVLTree.pm view on Meta::CPAN
...
my $id = 10;
my $result = $tree->find({ id => $id });
if($result) {
printf "Item with id %d found\nData: %s\n", $id, $result->{data};
} else {
print "Item with id $id not found\n";
}
# forward tree traversal
my $item = $tree->first();
print "First item: ", $item, "\n";
while($item = $tree->next()) {
print $item, "\n";
}
# and similarly for reverse iteratio, using last/prev methods
...
lib/AVLTree.pm view on Meta::CPAN
Arg [1] : Item to search, can be defined just in terms of the attribute
with which the items in the tree are compared.
Example : $tree->find({ id => 10 }); # objects in the tree can hold data as well
if($result) {
printf "Item with id %d found\nData: %s\n", $id, $result->{data};
} else { print "Item with id $id not found\n"; }
Description : Query if an item exists in the tree.
Returntype : The item, if found, as stored in the tree or undef
if the item was not found or the query was not provided
lib/AVLTree.pm view on Meta::CPAN
=head2 C<size>
Arg[...] : None
Example : print "Size of the tree is: %d\n", $tree->size();
Description : Returns the size of the tree (number of nodes)
Returntype : Int, the size of the tree
lib/AVLTree.pm view on Meta::CPAN
=head2 C<next>
Arg [...] : None
Example : my $item = $tree->first;
print $item, "\n";
while($item = $tree->next) { print $item, "\n"; }
Description : Returns the next element as specified by the order defined by the tree.
Returntype : The item, if found, as stored in the tree or undef
if the tree is empty.
lib/AVLTree.pm view on Meta::CPAN
=head2 C<prev>
Arg [...] : None
Example : my $item = $tree->last;
print $item, "\n";
while($item = $tree->prev) { print $item, "\n"; }
Description : Returns the previous element as specified by the order defined by the tree.
Returntype : The item, if found, as stored in the tree or undef
if the tree is empty.
view all matches for this distribution
view release on metacpan or search on metacpan
that you may choose to grant warranty protection to some or all
third parties, at your option).
c) If the modified program normally reads commands interactively when
run, you must cause it, when started running for such interactive use
in the simplest and most usual way, to print or display an
announcement including an appropriate copyright notice and a notice
that there is no warranty (or else, saying that you provide a
warranty) and that users may redistribute the program under these
conditions, and telling the user how to view a copy of this General
Public License.
view all matches for this distribution
view release on metacpan or search on metacpan
that you may choose to grant warranty protection to some or all
third parties, at your option).
c) If the modified program normally reads commands interactively when
run, you must cause it, when started running for such interactive use
in the simplest and most usual way, to print or display an
announcement including an appropriate copyright notice and a notice
that there is no warranty (or else, saying that you provide a
warranty) and that users may redistribute the program under these
conditions, and telling the user how to view a copy of this General
Public License.
view all matches for this distribution
view release on metacpan or search on metacpan
lib/AWS/CLIWrapper.pm view on Meta::CPAN
$ret->{timeout} = 0;
} else {
$ret->{exit_code} = 2;
$ret->{timeout} = 1 if defined $err && $err =~ /^IPC::Cmd::TimeOut:/;
}
print "";
} else {
$ret = IPC::Cmd::run_forked(join(' ', @$cmd), {
timeout => $opt->{timeout} || $self->{timeout},
});
}
lib/AWS/CLIWrapper.pm view on Meta::CPAN
sub _handle {
my ($self, $service, $operation, $ret) = @_;
if ($ret->{exit_code} == 0 && $ret->{timeout} == 0) {
my $json = $ret->{stdout};
warn sprintf("%s.%s[%s]: %s\n",
$service, $operation, 'OK', $json,
) if $ENV{AWSCLI_DEBUG};
local $@;
my($ret) = eval {
# aws s3 returns null HTTP body, so failed to parse as JSON
lib/AWS/CLIWrapper.pm view on Meta::CPAN
return $ret;
} else {
my $stdout_str = $ret->{stdout};
if ($stdout_str && $stdout_str =~ /^{/) {
my $json = $stdout_str;
warn sprintf("%s.%s[%s]: %s\n",
$service, $operation, 'NG', $json,
) if $ENV{AWSCLI_DEBUG};
my($ret) = $self->json->decode_prefix($json);
if (exists $ret->{Errors} && ref($ret->{Errors}) eq 'ARRAY') {
$Error = $ret->{Errors}[0];
lib/AWS/CLIWrapper.pm view on Meta::CPAN
} else {
$Error = { Message => 'Unknown', Code => 'Unknown' };
}
} else {
my $msg = $ret->{err_msg};
warn sprintf("%s.%s[%s]: %s\n",
$service, $operation, 'NG', $msg,
) if $ENV{AWSCLI_DEBUG};
$Error = { Message => $msg, Code => 'Unknown' };
}
return;
}
}
# aws help | col -b | perl -ne 'if (/^AVAILABLE/.../^[A-Z]/) { s/^\s+o\s+// or next; chomp; next if $_ eq 'help'; my $sn = $_; $sn =~ s/-/_/g; printf "sub %-18s { shift->_execute('"'"'%s'"'"', \@_) }\n", $sn, $_ }'
# aws help | col -b | perl -ne 'if (/^AVAILABLE/.../^[A-Z]/) { s/^\s+o\s+// or next; chomp; next if $_ eq 'help'; my $sn = $_; $sn =~ s/-/_/g; printf "=item B<%s>(\$operation:Str, \$param:HashRef, %%opt:Hash)\n\n", $sn}'
# =item B<s3>($operation:Str, $path:ArrayRef, $param:HashRef, %opt:Hash)
sub accessanalyzer { shift->_execute('accessanalyzer', @_) }
sub account { shift->_execute('account', @_) }
sub acm { shift->_execute('acm', @_) }
sub acm_pca { shift->_execute('acm-pca', @_) }
lib/AWS/CLIWrapper.pm view on Meta::CPAN
);
if ($res) {
for my $rs ( @{ $res->{Reservations} }) {
for my $is (@{ $rs->{Instances} }) {
print $is->{InstanceId},"\n";
}
}
} else {
warn $AWS::CLIWrapper::Error->{Code};
warn $AWS::CLIWrapper::Error->{Message};
view all matches for this distribution
view release on metacpan or search on metacpan
inc/Module/Install.pm view on Meta::CPAN
}
sub _write {
local *FH;
open FH, "> $_[0]" or die "open($_[0]): $!";
foreach ( 1 .. $#_ ) { print FH $_[$_] or die "print($_[0]): $!" }
close FH or die "close($_[0]): $!";
}
# _version is for processing module versions (eg, 1.03_05) not
# Perl versions (eg, 5.8.1).
view all matches for this distribution
view release on metacpan or search on metacpan
that you may choose to grant warranty protection to some or all
third parties, at your option).
c) If the modified program normally reads commands interactively when
run, you must cause it, when started running for such interactive use
in the simplest and most usual way, to print or display an
announcement including an appropriate copyright notice and a notice
that there is no warranty (or else, saying that you provide a
warranty) and that users may redistribute the program under these
conditions, and telling the user how to view a copy of this General
Public License.
view all matches for this distribution
view release on metacpan or search on metacpan
lib/AWS/Lambda/Quick.pm view on Meta::CPAN
my $proc = AWS::Lambda::Quick::Processor->new(
src_filename => $file,
@_,
);
my $url = $proc->process;
print "$url\n" or die "problem with fh: $!";
# and exit before we run the remainder of the script
# (since that's meant to be run on AWS Lambda, and we're just
# uploading at this time!)
exit;
lib/AWS/Lambda/Quick.pm view on Meta::CPAN
enviroment variable:
shell$ AWS_LAMBDA_QUICK_UPDATE_CODE_ONLY=1 perl lambda-function.pl
In the interest of being as quick as possible, when this is environment
variable is enabled the URL for the upload is not computed and printed
out.
=head2 Enabling debugging output
To gain a little more insight into what is going on you can set
view all matches for this distribution
view release on metacpan or search on metacpan
author/pod-stripper/scripts/pod_stripper.pl view on Meta::CPAN
# Traverse desired filesystems
File::Find::find({wanted => \&wanted}, @dirs);
say "Original module size: $original_bytes";
say "Stripped to: $final_bytes";
say sprintf "Won %0.02f%%", (1- ($final_bytes / $original_bytes)) * 100;
exit;
sub wanted {
my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size);
view all matches for this distribution
view release on metacpan or search on metacpan
that you may choose to grant warranty protection to some or all
third parties, at your option).
c) If the modified program normally reads commands interactively when
run, you must cause it, when started running for such interactive use
in the simplest and most usual way, to print or display an
announcement including an appropriate copyright notice and a notice
that there is no warranty (or else, saying that you provide a
warranty) and that users may redistribute the program under these
conditions, and telling the user how to view a copy of this General
Public License.
view all matches for this distribution
view release on metacpan or search on metacpan
lib/AWS/S3.pm view on Meta::CPAN
# Get the file:
my $same_file = $bucket->file( 'foo/bar.txt' );
# Get the contents:
my $scalar_ref = $same_file->contents;
print $$scalar_ref;
# Update the contents with a scalar ref:
$same_file->contents( \"New file contents" );
# Update the contents with a code ref:
view all matches for this distribution
view release on metacpan or search on metacpan
that you may choose to grant warranty protection to some or all
third parties, at your option).
c) If the modified program normally reads commands interactively when
run, you must cause it, when started running for such interactive use
in the simplest and most usual way, to print or display an
announcement including an appropriate copyright notice and a notice
that there is no warranty (or else, saying that you provide a
warranty) and that users may redistribute the program under these
conditions, and telling the user how to view a copy of this General
Public License.
view all matches for this distribution
view release on metacpan or search on metacpan
that you may choose to grant warranty protection to some or all
third parties, at your option).
c) If the modified program normally reads commands interactively when
run, you must cause it, when started running for such interactive use
in the simplest and most usual way, to print or display an
announcement including an appropriate copyright notice and a notice
that there is no warranty (or else, saying that you provide a
warranty) and that users may redistribute the program under these
conditions, and telling the user how to view a copy of this General
Public License.
view all matches for this distribution
view release on metacpan or search on metacpan
lib/AWS/SQS/Simple.pm view on Meta::CPAN
my $params = shift ;
my $message_body = $params->{ MessageBody } ;
unless( defined $message_body ){
print STDERR "Error : Message Body not defined" ;
return 0 ;
}
my $params_to_pass = {
'Action' => 'SendMessage' ,
lib/AWS/SQS/Simple.pm view on Meta::CPAN
my $params = shift ;
my $receipt_handle = $params->{ ReceiptHandle } ;
unless( defined $receipt_handle ){
print STDERR "Error : Receipt Handle not defined" ;
return 0 ;
}
my $params_to_pass = {
'Action' => 'DeleteMessage' ,
lib/AWS/SQS/Simple.pm view on Meta::CPAN
=cut
sub _generate_timestamp {
return sprintf("%04d-%02d-%02dT%02d:%02d:%02d.000Z",
sub { ($_[5]+1900,
$_[4]+1,
$_[3],
$_[2],
$_[1],
lib/AWS/SQS/Simple.pm view on Meta::CPAN
} else {
$contents = $response->content ;
print STDERR "ERROR : $contents" ;
$attempts++ ;
sleep( $attempts * 10 ) ;
}
view all matches for this distribution
view release on metacpan or search on metacpan
lib/AWS/Signature/V2.pm view on Meta::CPAN
$q{Keywords} =~ s/\+/ /g if $q{Keywords};
$q{AWSAccessKeyId} = $self->aws_access_key;
$q{Timestamp} ||= do {
my ( $ss, $mm, $hh, $dd, $mo, $yy ) = gmtime();
join '',
sprintf( '%04d-%02d-%02d', $yy + 1900, $mo + 1, $dd ), 'T',
sprintf( '%02d:%02d:%02d', $hh, $mm, $ss ), 'Z';
};
$q{Version} ||= '2010-09-01';
my $sq = join '&',
map { $_ . '=' . uri_escape_utf8( $q{$_}, "^A-Za-z0-9\-_.~" ) }
sort keys %q;
view all matches for this distribution
view release on metacpan or search on metacpan
lib/AWS/XRay.pm view on Meta::CPAN
$AUTO_FLUSH,
);
}
sub new_trace_id {
sprintf(
"1-%x-%s",
CORE::time(),
unpack("H*", Crypt::URandom::urandom(12)),
);
}
view all matches for this distribution
view release on metacpan or search on metacpan
inc/Module/Install.pm view on Meta::CPAN
sub _write {
local *FH;
open( FH, '>', $_[0] ) or die "open($_[0]): $!";
binmode FH;
foreach ( 1 .. $#_ ) {
print FH $_[$_] or die "print($_[0]): $!";
}
close FH or die "close($_[0]): $!";
}
END_NEW
sub _write {
local *FH;
open( FH, "> $_[0]" ) or die "open($_[0]): $!";
binmode FH;
foreach ( 1 .. $#_ ) {
print FH $_[$_] or die "print($_[0]): $!";
}
close FH or die "close($_[0]): $!";
}
END_OLD
inc/Module/Install.pm view on Meta::CPAN
sub _version {
my $s = shift || 0;
my $d =()= $s =~ /(\.)/g;
if ( $d >= 2 ) {
# Normalise multipart versions
$s =~ s/(\.)(\d{1,3})/sprintf("$1%03d",$2)/eg;
}
$s =~ s/^(\d+)\.?//;
my $l = $1 || 0;
my @v = map {
$_ . '0' x (3 - length $_)
view all matches for this distribution
view release on metacpan or search on metacpan
lib/Aard.pm view on Meta::CPAN
=head1 SYNOPSIS
use Aard;
my $dict = Aard->new('something.aar');
printf "This dictionary (volume %d of %d) has %d entries\n", $dict->volume, $dict->total_volumes, $dict->count;
printf "The tenth entry's key: %s\n", $dict->key(9);
printf "The tenth entry's value: %s\n", $dict->article(9);
=head1 DESCRIPTION
Aard is a module for reading files in the Aard Dictionary format (.aar). A dictionary is an array of I<(key, article)> pairs, with some associated metadata.
view all matches for this distribution
view release on metacpan or search on metacpan
that you may choose to grant warranty protection to some or all
third parties, at your option).
c) If the modified program normally reads commands interactively when
run, you must cause it, when started running for such interactive use
in the simplest and most usual way, to print or display an
announcement including an appropriate copyright notice and a notice
that there is no warranty (or else, saying that you provide a
warranty) and that users may redistribute the program under these
conditions, and telling the user how to view a copy of this General
Public License.
view all matches for this distribution
view release on metacpan or search on metacpan
lib/Abstract/Meta/Class.pm view on Meta::CPAN
Detail->new(id => 2),
Detail->new(id => 3),
);
my $master = Master->new(name => 'foo', details => [@details]);
print $details[0]->master->name;
- while using an array/hash association storage remove_<attribute_name> | add_<attribute_name> are added.
$master->add_details(Detail->new(id => 4),);
$master->remove_details($details[0]);
#cleanup method is added to class, that deassociates all bidirectional associations
lib/Abstract/Meta/Class.pm view on Meta::CPAN
use Transistent;
my $obj = Transistent->new(attr1 => 1, x => 2, t => 3, th => {a =>1}, ta => [1,2,3]);
use Data::Dumper;
print Dumper $obj;
Cleanup and DESTORY methods are added to class, that delete externally stored attributes.
=head2 METHODS
view all matches for this distribution
view release on metacpan or search on metacpan
t/00-load.t view on Meta::CPAN
use Test::More;
plan tests => 1;
BEGIN {
use_ok( 'Ac_me::Local' ) || print "Bail out!\n";
}
diag( "Testing Ac_me::Local $Ac_me::Local::VERSION, Perl $], $^X" );
view all matches for this distribution
view release on metacpan or search on metacpan
$sequence = $db->fetch(Sequence => 'D12345');
$count = $db->count(Sequence => 'D*');
@sequences = $db->fetch(Sequence => 'D*');
$i = $db->fetch_many(Sequence=>'*'); # fetch a cursor
while ($obj = $i->next) {
print $obj->asTable;
}
# complex queries
$query = <<END;
find Annotation Ready_for_submission ; follow gene ;
$local_db->put($sequence);
@sequences = $db->fetch(Sequence => 'D*');
$local_db->put(@sequences);
# Get errors
print Ace->error;
print $db->error;
=head1 DESCRIPTION
AcePerl provides an interface to the ACEDB object-oriented database.
Both read and write access is provided, and ACE objects are returned
This method creates a new object in the database of type $class and
name $name. If successful, it returns the newly-created object.
Otherwise it returns undef and sets $db->error().
$name may contain sprintf()-style patterns. If one of the patterns is
%d (or a variant), Acedb uses a class-specific unique numbering to return
a unique name. For example:
$paper = $db->new(Paper => 'wgb%06d');
across the data set. This is friendly both in terms of network
bandwidth and memory consumption. It is simple to use:
$i = $db->fetch_many(Sequence,'*'); # all sequences!!!!
while ($obj = $i->next) {
print $obj->asTable;
}
The iterator will return undef when it has finished iterating, and
cannot be used again. You can have multiple iterators open at once
and they will operate independently of each other.
is not reset between calls, so its contents are only valid after a
method call has returned a result value indicating a failure.
For your convenience, you can call error() in any of several ways:
print Ace->error();
print $db->error(); # $db is an Ace database handle
print $obj->error(); # $object is an Ace::Object
There's also a global named $Ace::Error that you are free to use.
=head2 datetime() and date()
sub datetime {
my $self = shift;
my $time = shift || time;
my ($sec,$min,$hour,$day,$mon,$year) = localtime($time);
$year += 1900; # avoid Y3K bug
sprintf("%4d-%02d-%02d %02d:%02d:%02d",$year,$mon+1,$day,$hour,$min,$sec);
}
sub date {
my $self = shift;
my $time = shift || time;
my ($sec,$min,$hour,$day,$mon,$year) = localtime($time);
$year += 1900; # avoid Y3K bug
sprintf("%4d-%02d-%02d",$year,$mon+1,$day);
}
view all matches for this distribution
view release on metacpan or search on metacpan
lib/Acme/123.pm view on Meta::CPAN
BEGIN {
use Exporter ();
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
$VERSION = '0.04';
@ISA = qw(Exporter);
@EXPORT = qw(printnumbers setLanguage getnumbers);
@EXPORT_OK = qw();
%EXPORT_TAGS = qw(@numbers);
}
my %languages = (
lib/Acme/123.pm view on Meta::CPAN
'sp' => [qw /uno dos tres cuatro cinco seis siete ocho nueve diez/],
'it' => [qw /uno due tre quattro cinque sei sette otto nove dieci/]
);
my @numbers = @{$languages {en}};
sub printnumbers {
foreach (@numbers) {
print "$_ \n";
}
}
sub setLanguage {
my $self = shift;
lib/Acme/123.pm view on Meta::CPAN
=head1 SYNOPSIS
use Acme::123;
my $123 = Acme::123->new;
$123->printnumbers; #print English numbers
$123->setLanguage('fr'); #sets language to French
$123->printnumbers; #prints French numbers
=head1 DESCRIPTION
Prints numbers one through ten in different languages. Currently only
English, French, Spanish, and Italian supported. In later versions, more languages
view all matches for this distribution
view release on metacpan or search on metacpan
fortune/unique.pl view on Meta::CPAN
if($line =~ /^\%/)
{
if(! exists $phrases{$current})
{
print $current, '%', "\n";
$phrases{$current} = 0;
}
$current = '';
}
else
view all matches for this distribution
view release on metacpan or search on metacpan
lib/Acme/6502.pm view on Meta::CPAN
sub _bad_inst {
my $self = shift;
my $pc = $self->get_pc;
croak sprintf( "Bad instruction at &%04x (&%02x)\n",
$pc - 1, $self->{ mem }->[ $pc - 1 ] );
}
# Functions that generate code fragments
sub _set_nz {
view all matches for this distribution
view release on metacpan or search on metacpan
t/00-load.t view on Meta::CPAN
use Test::More;
plan tests => 1;
BEGIN {
use_ok( 'Acme::ADEAS::Utils' ) || print "Bail out!\n";
}
diag( "Testing Acme::ADEAS::Utils $Acme::ADEAS::Utils::VERSION, Perl $], $^X" );
view all matches for this distribution
view release on metacpan or search on metacpan
t/00-load.t view on Meta::CPAN
use Test::More;
plan tests => 1;
BEGIN {
use_ok( 'Acme::ALEXEY::Utils' ) || print "Bail out!\n";
}
diag( "Testing Acme::ALEXEY::Utils $Acme::ALEXEY::Utils::VERSION, Perl $], $^X" );
view all matches for this distribution
view release on metacpan or search on metacpan
lib/Acme/APHILIPP/Utils.pm view on Meta::CPAN
=head1 SYNOPSIS
use Acme::APHILIPP::Utils;
my $sum = sum(1, 2, 3);
print "$sum\n"; # 6
=head1 EXPORT
A list of functions that can be exported.
view all matches for this distribution