view release on metacpan or  search on metacpan

Auth/RCS/Makefile.old,v  view on Meta::CPAN

TEST_F = test -f
TOUCH = touch
UMASK_NULL = umask 0
DEV_NULL = > /dev/null 2>&1

# The following is a portable way to say mkdir -p
# To see which directories are created, change the if 0 to if 1
MKPATH = $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Command -e mkpath

# This helps us to minimize the effect of the .exists files A yet
# better solution would be to have a stable file in the perl

 view release on metacpan or  search on metacpan

lib/Apache2/Controller/DBI/Connector.pm  view on Meta::CPAN

 </Location>

If you use a tiered database structure with one master record
and many replicated nodes, you can do it this way.  Then you 
overload C<< dbi_pnotes_name >> to provide the pnotes key,
say "dbh_write" and "dbh_read".  In the controller get them
with C<< $self->pnotes->{a2c}{dbh_write} >> and
C<< $self->pnotes->{a2c}{dbh_read} >>, etc.

If you subclass DBI, specify your DBI subclass name with
the directive C<< A2C_DBI_Class >>.  Note that this has

lib/Apache2/Controller/DBI/Connector.pm  view on Meta::CPAN

This means that on a lightly-loaded server with a lot of spare child processes,
you will quickly get a large number of idle database connections, one per child.

To solve this you need to set your database handle idle timeout
to some small number of seconds, say 5 or 10.  Then you load
L<Apache::DBI> in your Apache config file so they automatically
get reconnected if needed.  

Then when you get a load increase, handles are connected that persist
across requests long enough to handle the next request, but during

 view release on metacpan or  search on metacpan

Changes  view on Meta::CPAN

	- Fixed usage of Digest::MD5::md5_hex in sub pkit_auth_credential and
		pkit_auth_session_key in Common.pm (Boris Zentner)
	- Set Default for the server attrs can_edit and reload (Boris Zentner)
	- First attempt to make pkit warning clean (Boris Zentner, David Raimbault)
        - Fix default timeout for 'recent_login_timeout' from unlimited to 3600
		like the Docs say (Boris Zentner)
	- Parse difficult parameters like
		http://ka.brain.de/login2?passwd=ss&&&&submit&&login=s& (Boris Zentner)
        - Add restricted page to the example site (Boris Zentner)
        - Fixed setup_session without touch of pkit_merge_session (Boris Zentner)
        - Fixed problem with append of check_cookie (Boris Zentner)

 view release on metacpan or  search on metacpan

lib/Apache2/SiteControl.pm  view on Meta::CPAN

The intent is to provide a clear, easy-to-integrate system that does not
require the policies to be written into your application components. It
attempts to separate the concerns of how to show and manipulate data from the
concerns of who is allowed to view and manipulate data and why.

For example, say your web application is written in HTML::Mason. Your
individual "screens" are composed of Mason modules, and you would like to keep
those as clean as possible, but decisions have to be made about what to allow
as the component is processed. SiteControl attempts to make that as easy as
possible.

lib/Apache2/SiteControl.pm  view on Meta::CPAN

makes calls like: 
 
   if($referee->can($userA, "beat up", $userB)) { ... }

In terms of English, we would describe the rule "If A is taller than B, then
we say that A can beat up B. If A is less skilled than B, then we say that
A cannot beat up B".  The rule looks like this:

   package samples::FightRules;

   use strict;

 view release on metacpan or  search on metacpan

README  view on Meta::CPAN

        an uninitialized variable that is by cause 0, see
        <http://www.gossamer-threads.com/lists/apache/dev/327770#327770>

    Call: string, ?@params?
        Well, the name suggests it is calling a subroutine. Assume you have
        several WEB applications running on the same server, say one
        application for each department. Each department needs of course
        some kind of authorization:

         #uri      blk ord action
         AUTH      0   0   Config: "AuthName \"$ARGV[0]\""

 view release on metacpan or  search on metacpan

devscripts/gen-json  view on Meta::CPAN

my $json = JSON->new->allow_nonref->pretty->canonical;

my $reader = Config::Apachish::Reader->new();
for (glob "share/examples/*.conf") {
    next if /TODO-|invalid-/;
    say "$_ ...";
    write_text("$_.json", $json->encode($reader->read_file($_)));
}

 view release on metacpan or  search on metacpan

examples/api_products.pl  view on Meta::CPAN

    org => $ENV{APIGEE_ORG},
    usr => $ENV{APIGEE_USR},
    pwd => $ENV{APIGEE_PWD}
);

# say "Create API Product...";
# my $product = $apigee->create_api_product(
#     "approvalType" => "manual",
#     "attributes" => [
#         {
#           "name" => "access",

examples/api_products.pl  view on Meta::CPAN

#     # "quota" => "{quota}",
#     # "quotaInterval" => "{quota_interval}",
#     # "quotaTimeUnit" => "{quota_unit}",
#     "scopes" => ["user", "repos"]
# );
# say Dumper(\$product);

# say "Get API Products...";
# my $products = $apigee->get_api_products(expand => 'true');
# say Dumper(\$products);

# say "Search API Products...";
# my $products = $apigee->search_api_products('attributename' => 'access', 'attributevalue' => 'public', expand => 'true');
# say Dumper(\$products);

# say "Update API Product...";
# my $product = $apigee->update_api_product(
#     "test-product-name",
#     {
#         "approvalType" => "auto",
#         "displayName" => "TEST PRODUCT NAME 4",
#     }
# );
# say Dumper(\$product);

# say "Get API Product...";
# my $product = $apigee->get_api_product("test-product-name");
# say Dumper(\$product);

say "Get API Product Apps...";
my $apps = $apigee->get_api_product_details(
    'test-product-name',
    query => 'list', entity => 'apps' # or query => 'count', entity => 'keys, apps, developers, or companies'
);
say Dumper(\$apps);

1;

 view release on metacpan or  search on metacpan

1234567891  view on Meta::CPAN

 
$ARGV[0] //= 20 ;
$o{d} //= 1 ;
my $bk = ( $o{f} ? '　' :' ' ) x $o{d} ; # 空白文字を $o{d}個連結する。 全角空白と半角空白を左に書いた。
my ($n1,$n2) = $ARGV[0] =~ m/(\d+)-(\d+)/ ? ($1,$2) : exists $ARGV[1] ? @ARGV : (1,$ARGV[0]) ; 
exit if map {say "'$_' seems not a number."} grep { ! looks_like_number $_ } ($n1,$n2) ;

my $out = '' ; 
for ( $n1 .. $n2 ) { 
  my $c = s/0{$o{d},}$//ro =~ s/^$/0/ro ; # 文末の1個以上の0を除去して、もしも全部消えたら0にする。
  $c = substr $bk . $c , -$o{d} , $o{d} ; 
  $c =~ y/0123456789 /０１２３４５６７８９　/ if $o{f} ; 
  $out .= $c ; 
}

binmode STDOUT, ":utf8" ; 
say $out ;
exit ; 

no utf8 ; 

## ヘルプの扱い

 view release on metacpan or  search on metacpan

12567834  view on Meta::CPAN

my $p2 ; # 元のPDFファイルの最後のページ番号
my $p2a ; # $p2+1 以下の、 $p2a - $p1 が4の倍数となる最大の数。

# コマンド引数から、与え方に応じて3通りに、ページ数の最初と最後を取り出す。
($p1,$p2) = $ARGV[0] =~ m/(.*)(-|\.\.)(.*)/ ? ($1,$3) : exists $ARGV[1] ? @ARGV : (1,$ARGV[0]) ; 
exit if map {say "'$_' seems not a numbper."} grep { ! looks_like_number $_ } ($p1,$p2) ;
exit if  $p1 > $p2 && say "'$p1 <= $p2' does not hold." ;


 
# 最後に出力する紙の処理 および 出力枚数の算出
my $pr = ($p2-$p1+1) % 4 ; # reminder 余り

12567834  view on Meta::CPAN

if ( $o{p} ) {
  my @P ; 
  my $out = "pdftk INPUT.pdf cat " ; 
  $p=$p1-1;splice @P,@P/2,0,$p+1..($p+=4)for 1..$q;$out .= join" ",@P ;
  $out .= " output OUTPUT.pdf" ;
  say $out ; 
  print "# Page " . con2($p2a, $p2)  . " has not contained above." if $pr ; 
  say "# The above contains " . length ($out) . " characters." ;  
  $o{2}//= 0 ; 
  exit ; 
}


say CYAN + (map { join '', 1..9,($_% 10 ) } ( 1..$o{c}/10) ) , 1..$o{c} % 10 if ($o{2}//'')ne"0"; # 文字列長さの定規
for ( 1 .. $q ) {
  @P0 = @P1  ;
  splice @P0 , @P0/2 , 0 , con($p,$p+3) ; # $p . "-" . ($p+3) ; # 試しに1度に4ページ挿入。
  if ( length ( $o0 = join "," , @P0 ) > $o{c} ) 
    { say $o1 ; $o0 = '' ; @P1 = () ; @P0 = con($p,$p+3) ; $L++ }  ; # 長すぎたら出力。
  splice @P1 , @P1/2 , 0 , con($p++,$p++) , con($p++,$p++) ;
  $o1 = $o0 ;  
}
do { say join "," , @P0 ; $L ++ } if @P0  ; 
#print $p2a < $p2 ? (join",",con($p2a,$p2))."\n" : $p2a == $p2 ? "$p2\n" : '' ; # 最後のページの出力。4の倍数か否か、1枚だけか否かにより、3通りに分けた。
#print $p2a > $p2 ? '' : con2 ( $p2a , $p2 ) . "\n" ; 
$L ++ and say con2($p2a,$p2)  if $pr ;  
exit ;

END {
  exit if ($o{2}//'') eq "0" ; 
  my $procsec = sprintf "%.5f", tv_interval ${ dt_start } ; #time - $time0 ; # このプログラムの処理にかかった秒数。比較する2個の時刻は秒単位なので、±1秒未満の誤差は発生する。
  my $s = tv_interval $dt_start , [ gettimeofday ] ; 
  say STDERR BOLD FAINT ITALIC " -- $Script ; " . $procsec . " seconds in process. " . $L. " lines output." ;
}

## ヘルプの扱い
sub VERSION_MESSAGE {}
sub HELP_MESSAGE {

 view release on metacpan or  search on metacpan

lib/App/AFNI/SiemensPhysio.pm  view on Meta::CPAN

   $self->{PhRate} = $newrate 
     if abs($newrate-$self->{PhRate}) < .00001  and
        $self->{trustIdx}!~/All|Phys/i;


   say "file is $self->{ptype} with $#{$self->{measures}} samples, " ,
       "$self->{physStart}s - $self->{physEnd}s, ",
       "sample rate adjusted to $self->{PhRate}"
     if $self->{VERB};

   # does the time match the sample rate and number of samples

lib/App/AFNI/SiemensPhysio.pm  view on Meta::CPAN

 ## set start and end
 $self->{MRstart} = getMRAcqSecs($starttime);
 $self->{MRend}   = getMRAcqSecs($endtime);

 say "MR starts $self->{MRstart} (DICOM $starttime) and ends $self->{MRend} (DICOM $endtime)"
   if $self->{VERB};

 timeCheck($self->{MRstart},
           $self->{MRend},
           $self->{nDcms},

lib/App/AFNI/SiemensPhysio.pm  view on Meta::CPAN

 $self->{dat}->{$self->{ptype}}=$outfile;

 my @pvals = $self->getMRPhys;

 say "saving to $outfile" if $self->{VERB};
 writeDat($outfile,@pvals)
}

lib/App/AFNI/SiemensPhysio.pm  view on Meta::CPAN

 );

 # McRetroTS Respdatafile ECGdatafile VolTR Nslices SamplingFreq(PhysFS) ShowGraphs
 my @mcrts = qw/Opts.Respfile Opts.Cardfile Opts.VolTR Opts.Nslices Opts.PhysFS/;
 my $mccmd =  "McRetroTs @params{@mcrts}";
 say $mccmd if $runtype !~ /matlab|McRetroTs/g ;;


 # if have matlab and singal toolbox, can use this
 my $cmd = join("; ", map { join("=",$_,$params{$_}) } keys %params);
 $cmd .= "; Opts.ShowGraphs=0;Opts.Quiet=0;"; # turn off graphs, turn on verbose
 $cmd .= " rts = RetroTS(Opts)";

 # we should wrap matlab up in a try+quit so we dont hang in ML command window on a failure
 my $matlabwrap= qq/$matlabbin -nodisplay -r "try; $cmd; catch err; err, exit(1); end; rts, quit;"/;

 say $matlabwrap if $runtype !~ /matlab|McRetroTs/i;
 # eg
 # matlab -nodisplay -r "try; Opts.Cardfile='rest_164627.359000.puls.dat'; Opts.VolTR=1.5; Opts.Nslices=29; Opts.SliceOrder='alt+z'; Opts.PhysFS=50.0074711455304; Opts.Respfile='rest_164627.359000.resp.dat'; rts = RetroTS(Opts); catch; exit(666); end...

 # with either command, the original output name will be "oba.slibase.1D"
 # change that to our basename (assume resp and puls have same basename, use one from resp)

lib/App/AFNI/SiemensPhysio.pm  view on Meta::CPAN

 my $ps = timeToSamples($self->{physStart},$self->{physStart},$self->{PhRate});
 my $pe = timeToSamples($self->{physStart},$self->{physEnd},$self->{PhRate});
 my $s  = $self->{MRstartIdx} || undef;
 my $e  = $self->{MRendIdx}   || undef;
 # lets talk about what we have
 say "(ps  ) $self->{physStart}  | MR $self->{MRstart} $self->{MRend} | $self->{physEnd} (pe)  ";
 say "(sidx) $ps          | MR $s  $e     | $pe   (eidx)" if $s and $e;

}

 view release on metacpan or  search on metacpan

bin/apa  view on Meta::CPAN

binmode( STDOUT , ':encoding(UTF-8)' ); # warning: wide character

my $apa = App::APA -> new();

if ( defined( $options{f} or $options{1} ) ) {
  say $apa -> first_item;
}
elsif ( defined( $options{l} ) ) {
  say for $apa -> limit_items( $options{l} );
}
elsif ( defined( $options{a} ) ) {
  say for $apa -> all_items;
}
else {
  say pod2usage( verbose => 1 );
}

__END__

=pod

 view release on metacpan or  search on metacpan

lib/App/AVR/Fuses.pm  view on Meta::CPAN

package App::AVR::Fuses;

use strict;
use warnings;
use feature qw( say );
use 5.010;

our $VERSION = '0.01';

use File::ShareDir qw( module_dir );

lib/App/AVR/Fuses.pm  view on Meta::CPAN

   foreach my $arg ( @argv ) {
      my ( $name, $val ) = $arg =~ m/^(\w+)=(.*)$/ or
         die "Unable to parse '$arg'\n";

      if( $val eq "?" ) {
         say join "\n",
            "Possible values for $name are:",
            $self->list_values_for_fuse( $name );

         return 1;
      }

lib/App/AVR/Fuses.pm  view on Meta::CPAN

         }
         else {
            $val = $val ? "1" : "0";
         }

         say "using $name=$val";
      }
   }

   say join " ", $self->gen_fuses_avrdude;
}

sub new
{
   my $class = shift;

 view release on metacpan or  search on metacpan

lib/App/AcmeCpanauthors.pm  view on Meta::CPAN

                        'module.name'=>'Acme::CPANAuthors::*',
                    });
                my @res;
                while (my $row = $rs->next) {
                    my $mod = $row->module->[0]{name};
                    say "D: mod=$mod" if $ENV{DEBUG};
                    $mod =~ s/\AAcme::CPANAuthors:://;
                    next if _should_skip($mod);
                    push @res, $mod unless grep {$mod eq $_} @res;
                }
                warn "Empty result from MetaCPAN\n" unless @res;

 view release on metacpan or  search on metacpan

t/pleroma_user.json  view on Meta::CPAN

{"@context":["https://www.w3.org/ns/activitystreams","https://queer.hacktivis.me/schemas/litepub-0.1.jsonld",{"@language":"und"}],"alsoKnownAs":[],"attachment":[],"capabilities":{"acceptsChatMessages":true},"discoverable":true,"endpoints":{"oauthAuth...

 view release on metacpan or  search on metacpan

lib/App/Alice/Config.pm  view on Meta::CPAN

  my $config = {};
  if (-e $self->fullpath) {
    $config = require $self->fullpath;
  }
  else {
    say STDERR "No config found, writing a few config to ".$self->fullpath;
    $self->write;
  }
  my ($port, $debug, $address) = @_;
  GetOptions("port=i" => \$port, "debug" => \$debug, "address=s" => \$address);
  $self->commandline->{port} = $port if $port and $port =~ /\d+/;

lib/App/Alice/Config.pm  view on Meta::CPAN

  for my $key (keys %$config) {
    if (exists $config->{$key} and my $attr = $self->meta->get_attribute($key)) {
      $self->$key($config->{$key}) if $attr->has_write_method;
    }
    else {
      say STDERR "$key is not a valid config option";
    }
  }
}

sub write {

 view release on metacpan or  search on metacpan

lib/MojoX/Aliyun.pm  view on Meta::CPAN

        AccessKeyId => $self->access_key,
        $self->region_id ? (RegionId => $self->region_id) : (),
        $params ? %$params : (),
    );

    # say Dumper(\%auth_params); use Data::Dumper;

    # Thanks to https://github.com/lemontv/AliyunPerlLib/blob/master/Aliyun/Auth.pm
    my %dumb = %auth_params; $dumb{Timestamp} = uri_escape($dumb{Timestamp});
    my @tmps = map { join('=', $_, $dumb{$_}) } sort keys(%dumb);
    my $StringToSign = join("&",  @tmps);

 view release on metacpan or  search on metacpan

bin/get_github_favorites  view on Meta::CPAN

sub main {

    my $github_login = $ARGV[0];

    if (not defined $github_login) {
        say "You should run it as `$0 GITHUB_LOGIN`";
        exit 1;
    }

    my @repos = get_repos_liked_by_user($github_login);

    say 'namespace,name,source';

    foreach my $r (@repos) {
        my $language = $r->{language};
        say
            $language . ','

 view release on metacpan or  search on metacpan

lib/App/Aphra.pm  view on Meta::CPAN

  default => $VERSION,
);

sub version {
  my $me = path($0)->basename;
  say "\n$me version: $VERSION\n";
}

sub help {
  my $self = shift;
  my $me = path($0)->basename;
  $self->version;

  say <<ENDOFHELP;
$me is a simple static sitebuilder which uses the Template Toolkit to
process input templates and turn them into a web site.
ENDOFHELP
}

 view release on metacpan or  search on metacpan

lib/App/AppSpec.pm  view on Meta::CPAN

        $spec->name($name);
    }
    my $completion = $spec->generate_completion(
        shell => $shell,
    );
    say $completion;
}

sub generate_pod {
    my ($self, $run) = @_;
    my $parameters = $run->parameters;

lib/App/AppSpec.pm  view on Meta::CPAN

    my $generator = App::Spec::Pod->new(
        spec => $spec,
    );
    my $pod = $generator->generate;

    say $pod;
}

sub cmd_validate {
    my ($self, $run) = @_;
    my $options = $run->options;

lib/App/AppSpec.pm  view on Meta::CPAN

        @errors = $validator->validate_spec_file($spec_file);
    }
    binmode STDOUT, ":encoding(utf-8)";
    if (@errors) {
        print $validator->format_errors(\@errors);
        say $run->colored(out => red => "Not valid!");
    }
    else {
        say $run->colored(out => [qw/ bold green /] => "Validated ✓");
    }
}

sub cmd_new {
    my ($self, $run) = @_;

lib/App/AppSpec.pm  view on Meta::CPAN

    $dist = $dist_path // $dist;
    if (-d $dist and not $overwrite) {
        die "Directory $dist already exists";
    }
    elsif (-d $dist) {
        say "Removing old $dist directory first";
        File::Path::remove_tree($dist);
    }
    my $spec = <<"EOM";
name: $name
appspec: { version: '0.001' }

lib/App/AppSpec.pm  view on Meta::CPAN

    my $subname = $options->{"with-subcommands"} ? "mycommand" : "execute";
    my $module = <<"EOM";
package $class;
use strict;
use warnings;
use feature qw/ say /;
use base 'App::Spec::Run::Cmd';

sub $subname \{
    my (\$self, \$run) = \@_;
    my \$options = \$run->options;
    my \$parameters = \$run->parameters;

    say "Hello world";
\}

1;
EOM
    my $script = <<"EOM";

lib/App/AppSpec.pm  view on Meta::CPAN

    File::Path::make_path($dist);
    File::Path::make_path("$dist/share");
    File::Path::make_path("$dist/bin");
    File::Path::make_path(dirname $module_path);
    my $specfile = "$dist/share/$name-spec.yaml";
    say "Writing spec to $specfile";
    open my $fh, ">", $specfile or die $!;
    print $fh $spec;
    close $fh;

    open $fh, ">", $module_path or die $!;

 view release on metacpan or  search on metacpan

lib/App/ArchiveDevelCover.pm  view on Meta::CPAN

    my $self = shift;
    if (-e $self->from->file('coverage.html')) {
        return $self->from->file('coverage.html');
    }
    else {
        say "Cannot find 'coverage.html' in ".$self->from.'. Aborting';
        exit;
    }
}
has 'runtime' => (is=>'ro',isa=>'DateTime',lazy_build=>1,traits=> ['NoGetopt'],);
sub _build_runtime {

lib/App/ArchiveDevelCover.pm  view on Meta::CPAN

    my $from = $self->from;
    my $target = $self->to->subdir($self->runtime->iso8601);

    if (-e $target) {
        say "This coverage report has already been archived.";
        exit;
    }

    $target->mkpath;
    my $target_string = $target->stringify;

lib/App/ArchiveDevelCover.pm  view on Meta::CPAN

    while (my $f = $from->next) {
        next unless $f=~/\.(html|css)$/;
        copy($f->stringify,$target_string) || die "Cannot copy $from to $target_string: $!";
    }

    say "archived coverage reports at $target_string";
}

sub update_index {
    my $self = shift;

lib/App/ArchiveDevelCover.pm  view on Meta::CPAN

}

sub update_archive_db {
    my ($self, $last_row) = @_;
    my $dbw = $self->archive_db->open(">>") || warn "Can't write archive.db: $!";
    say $dbw join(';',$self->runtime->iso8601,@$last_row);
    close $dbw;
}

sub generate_diff {
    my $self = shift;

 view release on metacpan or  search on metacpan

script/article-wrap  view on Meta::CPAN

  # ``` toggles wrap
  $wrap = not $wrap if /^$prefix\s*```$/;
  # end old paragraph with the old prefix if the prefix changed, an empty line,
  # or not wrapping anymore
  if ($buffer and ($new_prefix ne $prefix or $empty or not $wrap)) {
    say $prefix . $buffer;
    $buffer = '';
  }
  # print empty lines or not wrapped lines without stripping trailing whitespace
  if ($empty or not $wrap) {
    say $_;
    next;
  }
  # continue old paragraph
  $buffer .= " " if $buffer;
  # strip the prefix

script/article-wrap  view on Meta::CPAN

    # this is the max line + 1
    my $test_line = substr($buffer, 0, $max - length($prefix) + 1);
    # if there's a word that reaches into that last character, break before
    if ($test_line =~ /(\s+(\S+)\S)$/) {
      # $1 is the last word: strip it, print prefix and stripped line
      say $prefix . substr($buffer, 0, $max - length($prefix) - length($1) + 1);
      # the new buffer starts with the word just stripped
      $buffer = substr($buffer, $max - length($prefix) - length($2));
    } else {
      # we know that there is no word at the boundary, so cut there
      my $line = substr($buffer, 0, $max - length($prefix));
      # strip trailing whitespace and print it
      $line =~ s/\s+$//;
      say $prefix . $line;
      # the new buffer starts where we did the cut, strip leading whitespace
      $buffer = substr($buffer, $max - length($prefix));
      $buffer =~ s/^\s+//;
    }
  }
}
say $prefix . $buffer if $buffer;
1;

 view release on metacpan or  search on metacpan

lib/App/BCVI.pm  view on Meta::CPAN

=back

The ssh wrapper command arranges for these pieces of information to be
forwarded to the remote host.  If you don't want to know how it does that then
please skip the rest of this paragraph.  WARNING: It's not pretty.  OK, so you
really want to know?  Don't say I didn't warn you.  SSH does not normally pass
environment variables from client to server unless you customise the ssh config
files on the client and the server.  However, SSH B<does> pass the TERM
variable.  So, C<bcvi> appends all the extra info to the end of the TERM
variable before invoking SSH.  This 'overstuffed' TERM variable then needs to
be unpacked by the user's shell startup script on the server.  If this is not

 view release on metacpan or  search on metacpan

lib/BS/Common.pm  view on Meta::CPAN

            indent      => 1,
            skip_frames => 1
          )->as_string
          : "at $caller[1]:$caller[2]";

        say STDERR "$out\n";
        $out;
    }
}

method bsx : common ($cmd_aref, %args) {

 view release on metacpan or  search on metacpan

bin/BackupTumblr  view on Meta::CPAN

    
    my $json_scalar = from_json($+{json}, { utf8 => 1});
    my $posts = $json_scalar->{posts};
    $total_count += $fetch_count = scalar @$posts;

    say "[$total_count] fetching...";
    
    for my $post (@$posts) {
	my $file_name = $post->{id} . '-' . $post->{slug};

	if (-e "$file_name.json") {
	    say "$file_name.json exists.";
	    next;
	}
	
	my %meta = (
	    date => $post->{date}

bin/BackupTumblr  view on Meta::CPAN

		$meta{'link-url'} = $post->{'link-url'};
		break;
	    }

	    when ('audio') {
		say "[Audio] fetching...";
		$post->{'audio-player'} =~
		    /audio_file=(?<audio>.*)&color/;
		my $fetch = File::Fetch->new(
		    uri => $+{audio}
		    );

bin/BackupTumblr  view on Meta::CPAN

		$meta{audio} = $fetch->output_file;
		break;
	    }
	    
	    when ('photo') {
		say "[Photo] fetching...";
		my @photos = map {
		    my $photo = $_;
		    my $photo_url = 
			$photo->{'photo-url-1280'};
		    my $fetch = File::Fetch->new(

bin/BackupTumblr  view on Meta::CPAN

	$meta{tags} = $post->{tags} if $post->{tags};

	open my $content_file, '>:utf8', "$file_name.txt"
	    or die $!;

	say $content_file $body;

	close $content_file;

	open my $meta_file, '>', "$file_name.json"
	    or die $!;

	say $meta_file 
	    to_json(\%meta, { ascii => 1, pretty => 1 });
	
	close $meta_file;
    }
    
    last if $fetch_count != NUMBER_OF_FETCH;
}

say "\nTotal Count: $total_count";

# END { say "$_ => $INC{$_}" for sort keys %INC }

 view release on metacpan or  search on metacpan

lib/App/BarnesNoble/WishListMinder.pm  view on Meta::CPAN

{
  my ($self) = @_;

  my $config_file = $self->config_file;

  say "Your config file is:\n $config_file";

  unless ($config_file->is_file) {
    die "$config_file is a directory!\n" if $config_file->is_dir;
    $config_file->spew_utf8(<<'END CONFIG');
;						-*-conf-windows-*-

lib/App/BarnesNoble/WishListMinder.pm  view on Meta::CPAN

; Each wishlist must have a unique name in [brackets].

[My Wishlist]
wishlist = WISHLIST URL HERE
END CONFIG
    say "\nYou need to replace the ALL CAPS placeholders with the correct values.";
  }

  if (my $editor = $ENV{VISUAL} || $ENV{EDITOR}) {
    require Text::ParseWords;
    system(Text::ParseWords::shellwords($editor), "$config_file");

 view release on metacpan or  search on metacpan

lib/App/Base/Daemon/Supervisor.pm  view on Meta::CPAN

=cut

sub ping_supervisor {
    my $self = shift;
    my $pipe = $self->supervisor_pipe or $self->error("Supervisor pipe is not defined");
    say $pipe "ping";
    my $pong = <$pipe>;
    unless (defined $pong) {
        $self->error("Error reading from supervisor pipe: $!");
    }
    return;

lib/App/Base/Daemon/Supervisor.pm  view on Meta::CPAN

=cut

sub ready_to_take_over {
    my $self = shift;
    my $pipe = $self->supervisor_pipe or die "Supervisor pipe is not defined";
    say $pipe "takeover";
    my $ok = <$pipe>;
    defined($ok) or $self->error("Failed to take over");
    return;
}

lib/App/Base/Daemon/Supervisor.pm  view on Meta::CPAN

            $par->autoflush(1);
            $self->_supervisor_pipe($par);
            while (local $_ = <$par>) {
                chomp;
                if ($_ eq 'ping') {
                    say $par 'pong';
                } elsif ($_ eq 'takeover') {
                    $self->_control_takeover;
                    say $par 'ok';
                } elsif ($_ eq 'shutdown') {
                    kill KILL => $pid;
                    close $par;
                } else {
                    warn("Received unknown command from the supervised process: $_") unless $self->getOption('no-warn');

 view release on metacpan or  search on metacpan

lib/App/Basis/ConvertText2/UtfTransform.pm  view on Meta::CPAN

        <l>Some Leet speak</l>
        <o>text in bubbles</o>
        <s>script text</s>
        <l>are you leet</l>" ;

    say utf_transform( $string) ;

    my $smile = ":beer: is food!  :) I <3 :cake: ;)" ;

    say uttf_smilies( $smile ) ;

=head1 DESCRIPTION

A number of popular websites (eg twitter) do not allow the use of HTML to create
bold/italic font effects or perform smily transformations

 view release on metacpan or  search on metacpan

lib/App/Basis/ConvertText2.pm  view on Meta::CPAN

            $exit = _pandoc_format( $file, $outfile );
        }
        if ($cmd) {
            my ( $out, $err );
            try {
                # say "$cmd" ;
                ( $exit, $out, $err ) = run_cmd($cmd);
            }
            catch {
                $err  = "run_cmd($cmd) died - $_";
                $exit = 1;

lib/App/Basis/ConvertText2.pm  view on Meta::CPAN

    if ($outfile) {
        try {
            $status = path($outfile)->copy($filename);
        }
        catch {
            say STDERR "$_ ";
            debug( "ERROR", "failed to copy $outfile to $filename" );
        };
    }
    return $status;
}

 view release on metacpan or  search on metacpan

lib/App/Basis/Email.pm  view on Meta::CPAN

    );

=head1 DESCRIPTION
 
Sending email should be simple, sending formatted email should be simple too.
I just want to be able to say send this thing via this process.

This module provides that, a way to simply send email (plain/html or markdown) via
either a SMTP or sendmail target.

Obviously I do nothing new, just wrap around existing modules, to make life simple.

 view release on metacpan or  search on metacpan

lib/App/Basis.pm  view on Meta::CPAN

{
    my ( $where, $msg ) = @_ ;

    if ( !$_test_mode ) {
        if ( $where =~ /stderr/i ) {
            say STDERR $msg ;
        } else {
            say $msg ;
        }
    }
}

# ----------------------------------------------------------------------------

lib/App/Basis.pm  view on Meta::CPAN

sub verbose
{
    my ($msg) = @_ ;
    say STDERR $msg if ($verbose) ;
}


sub verbose_data
{
    if ( @_ % 2 ) {
        say STDERR Dump(@_) if ($verbose) ;

    } else {
        my ($data) = @_ ;
        say STDERR Dump($data) if ($verbose) ;
    }
}

# ----------------------------------------------------------------------------
# check that the option structure does not have repeated things in it

lib/App/Basis.pm  view on Meta::CPAN

    # put back inline blocks
    $txt =~ s{(`)(.+?)\1}{$1._get_source($2,\%code).$1}egm ;
    # put back code blocks too
    $txt =~ s{(`{3})(.+?)(?<!`)\1(?!`)}
           {$1._get_source($2,\%code).$1}egs ;
    say $txt;
}

# ----------------------------------------------------------------------------
# make sure we do any cleanup required

lib/App/Basis.pm  view on Meta::CPAN

            $debug = $lvl ;
            # set a default level
            $lvl = 'INFO' ;
        }

        say STDERR strftime( '%Y-%m-%d %H:%M:%S', gmtime( time() ) ) . " [$lvl] " . get_program() . " " . $debug;
    }

    # main
    my %opt = App::Basis::init_app(
    help_text   => 'Sample program description'

lib/App/Basis.pm  view on Meta::CPAN

make not be so consistent, leading to scripts that have no help and take lots of cryptic parameters.

So I created this module to help with command line arguments and displaying help, then I added L<App::Basis::Config> because
everyone needs config files and does not want to constantly repeat themselves there either.

So how is better than other similar modules? I can't say that it is, but it meets my needs.

There is app help available, there is basic debug functionality, which you can extend using your own function,
you can daemonise your script or run a shell command and get the output/stderr/return code.

If you choose to use App::Basis::Config then you will find easy methods to manage reading/saving YAML based config data.

lib/App/Basis.pm  view on Meta::CPAN

=item init_app

B<Parameters> hash of these things

    help_text    - what to say when people do app --help
    help_cmdline - extra things to put after the sample args on a sample command line (optional)
    cleanup      - coderef of function to call when your script ends (optional)
    debug        - coderef of function to call to save/output debug data (optional, recommended)
    'verbose'    - use verbose mode (optional) will trigger set_verbose by default
    log_file     - alternate name of file to store debug to