PUT results from the CPAN

ppport.h view on Meta::CPAN

PUSHSTACK|5.005000||Viu
PUSHSTACKi|5.005000||Viu
PUSHSTACK_INIT_HWM|5.027002||Viu
PUSHTARG|5.003007||Viu
PUSHu|5.004000|5.003007|p
PUTBACK|5.003007|5.003007|
putc|5.003007||Viu
put_charclass_bitmap_innards|5.021004||Viu
put_charclass_bitmap_innards_common|5.023008||Viu
put_charclass_bitmap_innards_invlist|5.023008||Viu
put_code_point|5.021004||Viu

ppport.h view on Meta::CPAN

    eval_sv(sv, G_SCALAR);
    SvREFCNT_dec(sv);

    SPAGAIN;
    sv = POPs;
    PUTBACK;

    D_PPP_CROAK_IF_ERROR(croak_on_error);

    return sv;
}

view all matches for this distribution

App-Basis-ConvertText2

3 results

README.md view on Meta::CPAN


# we assume that the plantuml.jar file is in the same directory as this executable
EXEC_DIR=`dirname $0`
PLANTUML="$EXEC_DIR/plantuml.jar"

INPUT=$1
OUPUT=$2
function show_usage  {
    arg=$1
    err=$2
    if [ "$err" == "" ] ; then
        err=1

README.md view on Meta::CPAN

        echo "$arg
"
    fi
    exit $err
}
if [ "$INPUT" == "-help" ] ; then
    show_usage "" 0
fi
if [ ! -f "$INPUT" ] ; then
    show_usage "ERROR: Could not find input file $1"
fi
if [ "$OUPUT" == "" ] ; then
    show_usage "ERROR: No output file specified"
fi
# we use the pipe option to control output into the file we want
cat "$INPUT" | java -jar $PLANTUML -nbthread auto -pipe >$OUPUT
# exit 0
~~~~

The content for this code-block must be the same that you would use to with the [PlantUML] software

view all matches for this distribution

App-Beeminder-Hook

1 match

public/javascripts/jquery.js view on Meta::CPAN

"&":"?")+(e.jsonp||"callback")+"=?");else if(!e.data||!N.test(e.data))e.data=(e.data?e.data+"&":"")+(e.jsonp||"callback")+"=?";e.dataType="json"}if(e.dataType==="json"&&(e.data&&N.test(e.data)||N.test(e.url))){j=e.jsonpCallback||"jsonp"+sb++;if(e.dat...
false&&n==="GET"){var r=J(),u=e.url.replace(wb,"$1_="+r+"$2");e.url=u+(u===e.url?(ka.test(e.url)?"&":"?")+"_="+r:"")}if(e.data&&n==="GET")e.url+=(ka.test(e.url)?"&":"?")+e.data;e.global&&!c.active++&&c.event.trigger("ajaxStart");r=(r=xb.exec(e.url))&...
false;C.onload=C.onreadystatechange=function(){if(!B&&(!this.readyState||this.readyState==="loaded"||this.readyState==="complete")){B=true;b();d();C.onload=C.onreadystatechange=null;z&&C.parentNode&&z.removeChild(C)}}}z.insertBefore(C,z.firstChild);r...
c.lastModified[e.url]);c.etag[e.url]&&x.setRequestHeader("If-None-Match",c.etag[e.url])}r||x.setRequestHeader("X-Requested-With","XMLHttpRequest");x.setRequestHeader("Accept",e.dataType&&e.accepts[e.dataType]?e.accepts[e.dataType]+", */*":e.accepts._...
d();E=true;if(x)x.onreadystatechange=c.noop}else if(!E&&x&&(x.readyState===4||q==="timeout")){E=true;x.onreadystatechange=c.noop;i=q==="timeout"?"timeout":!c.httpSuccess(x)?"error":e.ifModified&&c.httpNotModified(x,e.url)?"notmodified":"success";var ...
g("abort")}}catch(l){}e.async&&e.timeout>0&&setTimeout(function(){x&&!E&&g("timeout")},e.timeout);try{x.send(n==="POST"||n==="PUT"||n==="DELETE"?e.data:null)}catch(m){c.handleError(e,x,null,m);d()}e.async||g();return x}},handleError:function(a,b,d,f)...
1223||a.status===0}catch(b){}return false},httpNotModified:function(a,b){var d=a.getResponseHeader("Last-Modified"),f=a.getResponseHeader("Etag");if(d)c.lastModified[b]=d;if(f)c.etag[b]=f;return a.status===304||a.status===0},httpData:function(a,b,d){...
"json"||!b&&f.indexOf("json")>=0)a=c.parseJSON(a);else if(b==="script"||!b&&f.indexOf("javascript")>=0)c.globalEval(a);return a},param:function(a,b){function d(i,o){if(c.isArray(o))c.each(o,function(k,n){b||/\[\]$/.test(i)?f(i,n):d(i+"["+(typeof n===...
if(c.isArray(a)||a.jquery)c.each(a,function(){f(this.name,this.value)});else for(var j in a)d(j,a[j]);return e.join("&").replace(yb,"+")}});var la={},Ab=/toggle|show|hide/,Bb=/^([+-]=)?([\d+-.]+)(.*)$/,W,va=[["height","marginTop","marginBottom","padd...
this[a].style.display=d||"";if(c.css(this[a],"display")==="none"){d=this[a].nodeName;var f;if(la[d])f=la[d];else{var e=c("<"+d+" />").appendTo("body");f=e.css("display");if(f==="none")f="block";e.remove();la[d]=f}c.data(this[a],"olddisplay",f)}}a=0;f...
"olddisplay",c.css(this[a],"display"))}a=0;for(b=this.length;a<b;a++)this[a].style.display="none";return this}},_toggle:c.fn.toggle,toggle:function(a,b){var d=typeof a==="boolean";if(c.isFunction(a)&&c.isFunction(b))this._toggle.apply(this,arguments)...

view all matches for this distribution

App-Bernard

2 results

lib/App/Bernard/Magic/Fuzzaccept.pm view on Meta::CPAN

sub handle {

    my ($self, $settings) = @_;

    if ($settings->{'output'}) {
	open OUTPUT, ">$settings->{'output'}"
	    or die "Can't open $settings->{'output'}: $!";
	binmode OUTPUT, ":utf8";
    }

    $settings->{'print'} = sub {
	my ($text) = @_;

	if ($settings->{'output'}) {
	    print OUTPUT $text;
	} else {
	    print $text;
	}
    };

view all matches for this distribution

App-Bin4TSV

2 results

scripts/csv2tsv view on Meta::CPAN

    #exit if $o{'~'} ;
    exit if ! defined $csv ; 
    my @tmp = $csv -> error_diag () ; # ($cde, $str, $pos, $rec, $fld) = $csv->error_diag ();
    if ( $tmp[0] != 2012 ) {  # perldoc Text::CSV_XS ã§ 2012Â ã‚’å‚ç…§ã€‚EOFã‚’æ„å‘³ã™ã‚‹ã€‚
      print STDERR BRIGHT_RED join (":",@tmp),"\n" ;
      print STDERR ON_BRIGHT_RED BLACK "_ERROR_INPUT at line $.: " ; 
      #use Data::Dumper ; #print STDERR UNDERLINE Dumper $csv  ; 
      print STDERR UNDERLINE BRIGHT_RED $csv ->{_ERROR_INPUT} ; 
      exit 1 ; 
    }
  }
}

view all matches for this distribution

App-BlockWebFlooders

1 match

        {
            die => ($which eq 'block' ? 1:0),
            dry_run => $Opts{dry_run},
            (capture_stderr => \my $stderr) x ($which eq 'block' ? 0:1),
        },
        "iptables", ($which eq 'block' ? "-A" : "-D"), "INPUT", "-s", $ip,
        "-p", "tcp", "-m", "multiport", "--dports", "80,443",
        "-j", "DROP",
    );
    my $now = time();
    if ($which eq 'block') {

    my $last_reload_data_time;
    my $num_lines = 0;

    _init();

    local *INPUT;
    if (defined $Opts{spanel_site}) {
        require Tie::Handle::TailSwitch;
        my $dir = "/s/$Opts{spanel_site}/syslog";
        tie *INPUT, 'Tie::Handle::TailSwitch', (
            globs => ["$dir/https_access.*.log", "$dir/http_access.*.log"],
        );
    } else {
        *INPUT = \*STDIN;
    }

  LINE:
    while (1) {
        my $line = <INPUT>;
        if (!defined($line) || !length($line)) {
            sleep 0.5;
            next;
        }

            next;
        };
        my $ip = $1;
        next if $Blocked{$ip};

      OUTPUT:
        {
            last unless !$last_update_output_time ||
                $last_update_output_time <= $now-2;
            print "\e[2J\e[;H"; # clear screen + put cursor at top (0,0)
            printf "Blocked IPs: %s%4d%s | Log lines: %s%6d%s | Running for: %s%s%s\n",

            $i = 0;
            for my $msg (@Messages) {
                last if $i++ >= 5;
                print "  $msg\n";
            }
        } # OUTPUT

      UNBLOCK:
        {
            last unless !$last_unblock_time ||
                $last_unblock_time <= $now-60;

 # tail -f /s/example.com/syslog/https_access.2017-06-07.log | grep /heavy

and somethins like this in yet another terminal (monitor system load and number
of web server processes, this depends on the web server you use):

 # watch 'w | head -n1; echo -n "Blocked IPs total: "; iptables -nL INPUT | wc -l; echo -n "Apache processes: "; ps ax | grep apache | wc -l'

If your webserver is still maxed out by requests, you might want to tweak
C<--limit> and C<--period> options and restart the web server.

To see the blocked IP addresses:

 # iptables -nL INPUT

As long as the script runs, IP addresses are blocked by default temporarily for
86400 seconds (or, according to the --block-period command-line option or
block_period configuration). After that block period is exceeded, the IP is
unblocked.

To immediately clear/unblock all the IPs:

 # iptables -F INPUT

(this is assuming the default policy of input is ACCEPT; if you have a firewall
package installed, please follow the procedure for that firewall.)

To immediately unblock some IPs:

your website. The script works by reading web access log file, considering lines
which match the specified pattern(s), then block the IP address of the requester
if the speed of request from that IP exceeds a limit. The blocking is done using
firewall (L<iptables>), by default:

 # iptables -A INPUT -s <ip-address> -p tcp -m multiport --dports 80,443 -j DROP

To use this script, see the general guide in the Synopsis.

=head1 OPTIONS

view all matches for this distribution

App-BoolFindGrep

1 match

lib/App/BoolFindGrep/Find.pm view on Meta::CPAN

} ## end sub process

sub _get_made_list {
    my $self = shift;

    local $INPUT_RECORD_SEPARATOR = $self->files_delim();

    my $fh
        = $self->files_from() =~ /\A(?:-|stdin)\z/i
        ? \*STDIN
        : IO::File->new( $self->files_from(), q(r) );

view all matches for this distribution

App-Buuilt-CLI

1 match

lib/App/Buuilt/CLI.pm view on Meta::CPAN

    my ( $self, $asset_relative, $asset ) = @_;

    my $config = $self->config();

    my $ua = Mojo::UserAgent->new;
    my $tx = $ua->build_tx( PUT => $config->{host} . '/api/theme/assets/' . $asset_relative => $config );
    $tx->req->content->asset( Mojo::Asset::File->new( path => $asset ) );
    my $txr = $ua->start($tx);

    Mojo::IOLoop->start unless Mojo::IOLoop->is_running;

view all matches for this distribution

App-CPANModuleSite

1 match

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

sub _build_tt_config {
  my $self = shift;

  return {
    INCLUDE_PATH => $self->include_path,
    OUTPUT_PATH => $self->output_path,
    ( $self->wrapper ? ( WRAPPER => $self->wrapper ) : () ),
    RELATIVE => 1,
    VARIABLES => {
      distribution => $self->distribution,
      release => $self->release,

view all matches for this distribution

App-CPANtoRPM

1 match

                         '_optimize'  => '%{optimize}',
                         '_buildroot' => '%{buildroot}',
                        }
                  );

our ($OUTPUT,@OUTPUT,%package,$MAN);
$package{'VERSION'} = $VERSION;

my $old_locale = setlocale(LC_TIME);
setlocale(LC_TIME, "C");
$package{'date'}    = POSIX::strftime("%a %b %d %Y",localtime());

   my(@print);

   METHOD:
   foreach my $method (@method) {
      my($type,@tmp)   = @$method;
      @OUTPUT          = ();

      if ($type eq 'ignore') {
         next METHOD;

      } elsif ($type eq 'module') {

                 $self->_log_message('INFO',"Failed to load module: $module"));
            $self->_log_indent(-1);
            next METHOD;
         }

         push(@OUTPUT,eval "$eval_string");

      } elsif ($type eq 'system'  ||
               $type eq 'system-null') {
         my($bin,$command,@args) = @tmp;

            $self->_log_indent(-1);
            next METHOD;
         }

         if ($type eq 'system-null') {
            @OUTPUT  = ();
         } else {
            my $in = new IO::File;
            $in->open("$TMPDIR/cmd.out");
            my @out = <$in>;
            $in->close();
            chomp(@out);
            @OUTPUT  = @out;
         }

      } elsif ($type eq 'function') {
         my($coderef,@args) = @$method;

         my @out = &$coderef(@args);
         chomp(@out);
         @OUTPUT  = @out;
      }

      if (&$testfunc(@args)) {
         $self->_log_indent(-1);
         return 1;


      $succ = $self->_multiple_methods
        ( [ sub { 1; } ],
          [ 'module', 'YAML::XS', [],
            "my \@tmp = YAML::XS::LoadFile('$file'); " .
            "\$OUTPUT = \$tmp[0]" ],
          [ 'module', 'YAML::Tiny', [],
            "my \@tmp = YAML::Tiny::LoadFile('$file'); " .
            "\$OUTPUT = \$tmp[0]" ],
          [ 'module', 'YAML', [],
            "my \@tmp = YAML::LoadFile('$file'); " .
            "\$OUTPUT = \$tmp[0]" ],
          [ 'module', 'YAML::Syck', [],
            "my \@tmp = YAML::Syck::LoadFile('$file'); " .
            "\$OUTPUT = \$tmp[0]" ],
        );

   } elsif ($file =~ /\.json$/i) {

      $succ = $self->_multiple_methods
        ( [ sub { 1; } ],
          [ 'module', 'JSON::XS', ['decode_json'],
            "my \$fh; " .
            "open \$fh,'<:utf8','$file'; " .
            "my \$json_text = do { local \$/; <\$fh> }; " .
            "\$OUTPUT = decode_json(\$json_text);" ],
          [ 'module', 'JSON', ['from_json'],
            "my \$fh; " .
            "open \$fh,'<:utf8','$file'; " .
            "my \$json_text = do { local \$/; <\$fh> }; " .
            "\$OUTPUT = from_json(\$json_text);" ],
          [ 'module', 'JSON::PP', ['decode_json'],
            "my \$fh; " .
            "open \$fh,'<:utf8','$file'; " .
            "my \$json_text = do { local \$/; <\$fh> }; " .
            "\$OUTPUT = decode_json(\$json_text);" ],
          [ 'module', 'JSON::DWIW', ['from_json'],
            "my \$fh; " .
            "open \$fh,'<:utf8','$file'; " .
            "my \$json_text = do { local \$/; <\$fh> }; " .
            "\$OUTPUT = from_json(\$json_text);" ],
        );

   } else {
      $self->_log_message('ERR',"Options file must be YAML or JSON: $file");
   }

   if (! $succ) {
      $self->_log_message('ERR',"Unable to read options file: $file");
   }

   return ()  if (! exists $OUTPUT->{$$self{'package'}});

   my @opts;

   foreach my $line (@{ $OUTPUT->{$$self{'package'}} }) {
      if ($line =~ /^(.+?)(?:\s+|=)(.+?)\s*$/) {
         push(@opts,$1,$2);
      } else {
         push(@opts,$line);
      }

   $self->_log_message('INFO',"Listing package files");

   my $succ = $self->_multiple_methods
     ( [ sub { 1; } ],
       [ 'module','File::Find',['find'],
         qq< find(sub { push(\@OUTPUT,\$File::Find::name) if (-f) },"$dir"); >
       ],
       [ 'system','find',
         "{find} '$dir' -type f" ]
     );

   my %files;
   foreach my $file (@OUTPUT) {
      $file =~ s,^$dir/,,;
      next  if (! $file);

      $files{lc($file)}{$file} = 1;
   }

         "Multiple '$tmp' files exist (with different cases).",
         "This is not supported, so they will be ignored.");
      return;
   }
   my $file = "$package{DIR}/$tmp[0]";
   $OUTPUT = '';

   $self->_log_message('INFO',"Reading META file: $tmp[0]");

   my $succ;
   if ($type eq 'json') {

      $succ = $self->_multiple_methods
        ( [ sub { 1; } ],
          [ 'module', 'Parse::CPAN::Meta', '1.41', [],
            "\$OUTPUT = Parse::CPAN::Meta->load_file('$file')" ],
          [ 'module', 'JSON', ['from_json'],
            "my \$fh; " .
            "open \$fh,'<:utf8','$file'; " .
            "my \$json_text = do { local \$/; <\$fh> }; " .
            "\$OUTPUT = from_json(\$json_text);" ],
          [ 'module', 'JSON::XS', ['decode_json'],
            "my \$fh; " .
            "open \$fh,'<:utf8','$file'; " .
            "my \$json_text = do { local \$/; <\$fh> }; " .
            "\$OUTPUT = decode_json(\$json_text);" ],
          [ 'module', 'JSON::PP', ['decode_json'],
            "my \$fh; " .
            "open \$fh,'<:utf8','$file'; " .
            "my \$json_text = do { local \$/; <\$fh> }; " .
            "\$OUTPUT = decode_json(\$json_text);" ],
          [ 'module', 'JSON::DWIW', ['from_json'],
            "my \$fh; " .
            "open \$fh,'<:utf8','$file'; " .
            "my \$json_text = do { local \$/; <\$fh> }; " .
            "\$OUTPUT = from_json(\$json_text);" ],
        );

   } else {

      $succ = $self->_multiple_methods
        ( [ sub { 1; } ],
          # [ 'module', 'Parse::CPAN::Meta', [],
          #   "\$OUTPUT = Parse::CPAN::Meta::LoadFile('$file')" ],
          # [ 'module', 'CPAN::Meta::YAML', [],
          #   "my \$fh; " .
          #   "open \$fh,'<:utf8','$file'; " .
          #   "my \$yaml_text = do { local \$/; <\$fh> }; " .
          #   "my \$tmp = CPAN::Meta::YAML->read_string(\$yaml_text);" .
          #   "\$OUTPUT = \$tmp->[0]" ],
          [ 'module', 'YAML', [],
            "my \@tmp = YAML::LoadFile('$file'); " .
            "\$OUTPUT = \$tmp[0]" ],
          [ 'module', 'YAML::Syck', [],
            "my \@tmp = YAML::Syck::LoadFile('$file'); " .
            "\$OUTPUT = \$tmp[0]" ],
          [ 'module', 'YAML::XS', [],
            "my \@tmp = YAML::XS::LoadFile('$file'); " .
            "\$OUTPUT = \$tmp[0]" ],
          [ 'module', 'YAML::Tiny', [],
            "my \@tmp = YAML::Tiny::LoadFile('$file'); " .
            "\$OUTPUT = \$tmp[0]" ],
        );
   }

   if (! $succ) {
      $self->_log_message('WARN',"Unable to read META file: $tmp[0]");
      return;
   }
   if (! $OUTPUT) {
      $self->_log_message('ERR',"META file empty or corrupt: $tmp[0]");
      return;
   }

   # Now get the meta information:


   if (! $package{'m_license'}) {

      my $lic = '';

      if ($OUTPUT->{'license'}) {
         my @lic;

         if (ref($OUTPUT->{'license'})) {
            @lic = @{ $OUTPUT->{'license'} };
         } else {
            @lic = ($OUTPUT->{'license'});
         }

         foreach my $l (@lic) {
            if ($l =~ /^perl$/i  ||
                $l =~ /^perl_5$/i) {

             }
         }

         $lic = join(', ',@lic);

      } elsif ($OUTPUT->{'resources'}  &&
               $OUTPUT->{'resources'}->{'license'}) {
         $lic = join(' ',@{ $OUTPUT->{'resources'}->{'license'} });

      } elsif ($OUTPUT->{'license_uri'}) {
         $lic = $OUTPUT->{'license_uri'};
      }


      $package{'m_license'} = $lic  if ($lic);
   }

   # (but we'll use the VERSION from the first file they're
   # found in so we'll assume that we're examining the most
   # accurate file first).

   my %requires;
   if ($OUTPUT->{'prereqs'}) {
      my %lev = ( 'configure'  => [ 'build' ],
                  'build'      => [ 'build' ],
                  'test'       => [ 'test' ],
                  'runtime'    => [ 'build', 'runtime' ],
                );

                   ($t eq 'test'     &&  $$self{'test_rec'})   ||
                   ($t eq 'runtime'  &&  $$self{'runtime_rec'}) );

            foreach my $key (@key) {

               if ($OUTPUT->{'prereqs'}->{$lev}  &&
                   $OUTPUT->{'prereqs'}->{$lev}->{$key}) {

                  foreach my $f (keys %{ $OUTPUT->{'prereqs'}->{$lev}->{$key} }) {
                     my $v = $OUTPUT->{'prereqs'}->{$lev}->{$key}->{$f};
                     $requires{$t}{$f} = $v;
                  }
               }
            }
         }

                  'build_rquires'       => [ 'build' ],
                  'requires'            => [ 'build', 'runtime' ],
                );

      foreach my $lev (keys %lev) {
         if ($OUTPUT->{$lev}) {
            foreach my $f (keys %{ $OUTPUT->{$lev} }) {
               my $v = $OUTPUT->{$lev}->{$f};
               foreach my $t (@{ $lev{$lev} }) {
                  $requires{$t}{$f} = $v;
               }
            }
         }


      %lev = ( 'recommends'          => [ 'build', 'runtime' ],
             );

      foreach my $lev (keys %lev) {
         if ($OUTPUT->{$lev}) {
            foreach my $f (keys %{ $OUTPUT->{$lev} }) {
               my $v = $OUTPUT->{$lev}->{$f};
               foreach my $t (@{ $lev{$lev} }) {

                  if ( ($t eq 'build'    &&  $$self{'build_rec'})  ||
                       ($t eq 'test'     &&  $$self{'test_rec'})   ||
                       ($t eq 'runtime'  &&  $$self{'runtime_rec'}) ) {


sub _get_meta_field {
   my($self,$meta_field,$pack_field) = @_;

   return  if ($package{$pack_field}  ||
               ! exists $OUTPUT->{$meta_field});
   $package{$pack_field} = $OUTPUT->{$meta_field};

   # Strings containing newlines in the META.* files cause problems,
   # so change them to spaces.
   $package{$pack_field} =~ tr{\n}{ }  if (! ref($OUTPUT->{$meta_field}));
}

# This will get the NAME, SUMMARY, and DESCRIPTION sections of a POD
# file.  It will return () if it is not a valid POD file.
#

      my $succ = $self->_multiple_methods( [ sub { 1; } ],
                                           ['system','pwd',
                                            "cd '$$self{file_path}'; {pwd}"],
                                         );

      if (! $succ  ||  ! @OUTPUT) {
         $self->_log_message('ERR',
                             "Unable to determine package directory: $package");
      }

      $package = $OUTPUT[0];
      $package =~ m,^(.*/)?(.*)$,;
      $dir     = $2;
   }

   my ($dist,$vers);

view all matches for this distribution

App-CSV

1 match

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

sub run {
  my($self) = @_;
  $self->init;

  # L<perlsyn/"modifiers don't take loop labels">
  INPUT: { do {
    my $data;
    while (defined($data = $self->_get_line)) {
      if ($self->columns) {
        @$data = @$data[@{ $self->columns }];
      }
      
      if (!$self->_output_csv->print($self->_output_fh, $data)) {
        warn $self->format_error("Warning - Output error", diag => [$self->_input_csv->error_diag]), "\n";
        next INPUT;
      }
      $self->_output_fh->print("\n");
    }

    # Keeps us going on input errors.
    # TODO: strict errors, according to command line, blah
    if (not defined $data) {
      last INPUT if $self->_input_csv->eof;
      warn $self->format_error("Warning - Input error", line => $., diag => [$self->_input_csv->error_diag]), "\n";
    }
  } }
}

view all matches for this distribution

App-CSVUtils-csv_mix_formulas

3 results

lib/App/CSVUtils/csv_mix_formulas.pm view on Meta::CPAN

=item * B<inplace> => I<true>

Output to the same file as input.

Normally, you output to a different file than input. If you try to output to the
same file (C<-o INPUT.csv -O>) you will clobber the input file; thus the utility
prevents you from doing it. However, with this C<--inplace> option, you can
output to the same file. Like perl's C<-i> option, this will first output to a
temporary file in the same directory as the input file then rename to the final
file at the end. You cannot specify output file (C<-o>) when using this option,
but you can specify backup extension with C<-b> option.

view all matches for this distribution

App-CSVUtils

82 results

        summary => 'Output to the same file as input',
        schema => 'true*',
        description => <<'_',

Normally, you output to a different file than input. If you try to output to the
same file (`-o INPUT.csv -O`) you will clobber the input file; thus the utility
prevents you from doing it. However, with this `--inplace` option, you can
output to the same file. Like perl's `-i` option, this will first output to a
temporary file in the same directory as the input file then rename to the final
file at the end. You cannot specify output file (`-o`) when using this option,
but you can specify backup extension with `-b` option.


To read CSV data, normally your utility would provide handler for the
`on_input_data_row` hook and sometimes additionally `on_input_header_row`.


*OUTPUTTING STRING OR RETURNING RESULT*

To output string, usually you call the provided routine `$r->{code_print}`. This
routine will open the output files for you.

You can also return enveloped result directly by setting `$r->{result}`.


*OUTPUTTING CSV DATA*

To output CSV data, usually you call the provided routine `$r->{code_print_row}`.
This routine accepts a row (arrayref or hashref). This routine will open the
output files for you when needed, as well as print header row automatically.

as usual. To switch to the next file, set
`$r->{wants_switch_to_next_output_file}` to true, in which case the next call to
`$r->{code_print_row}` will close the current file and open the next file.


*CHANGING THE OUTPUT FIELDS*

When calling `$r->{code_print_row}`, you can output whatever fields you want. By
convention, you can set `$r->{output_fields}` and `$r->{output_fields_idx}` to
let other handlers know about the output fields. For example, see the
implementation of <prog:csv-concat>.

                            @output_filenames = @{ $util_args{output_filenames} // ['-'] };
                        } else {
                            @output_filenames = ($util_args{output_filename} // '-');
                        }

                      CHECK_OUTPUT_FILENAME_SAME_AS_INPUT_FILENAME: {
                            my %seen_output_abs_path; # key = output filename
                            last unless $reads_csv && $writes_csv;
                            for my $input_filename (@{ $r->{input_filenames} }) {
                                next if $input_filename eq '-';
                                my $input_abs_path = Cwd::abs_path($input_filename);

                                         ($output_filename ne $output_abs_path ? "($output_abs_path) ":"").
                                         "because it is the same as input filename and input will be clobbered; use --inplace to avoid clobbering<"]
                                        if $output_abs_path eq $input_abs_path;
                                }
                            }
                        } # CHECK_OUTPUT_FILENAME_SAME_AS_INPUT_FILENAME

                        $r->{output_filenames} = \@output_filenames;
                        $r->{output_num_of_files} //= scalar(@output_filenames);
                    } # set output filenames

                    } else {
                        @input_filenames = ($util_args{input_filename} // '-');
                    }
                    $r->{input_filenames} //= \@input_filenames;

                  BEFORE_INPUT_FILENAME:
                    $r->{input_filenum} = 0;

                  INPUT_FILENAME:
                    for my $input_filename (@input_filenames) {
                        $r->{input_filenum}++;
                        $r->{input_filename} = $input_filename;
                        $r->{input_file_input_has_been_skipped} = 0;

                        if ($before_open_input_file) {
                            log_trace "[csvutil] Calling before_open_input_file handler ...";
                            $before_open_input_file->($r);
                            if (delete $r->{wants_skip_file}) {
                                log_trace "[csvutil] Handler wants to skip this file, moving on to the next file";
                                next INPUT_FILENAME;
                            } elsif (delete $r->{wants_skip_files}) {
                                log_trace "[csvutil] Handler wants to skip all files, skipping all input files";
                                last READ_CSV;
                            }
                        }

                                    log_trace "[csvutil] Calling on_input_header_row hook handler ...";
                                    $on_input_header_row->($r);

                                    if (delete $r->{wants_skip_file}) {
                                        log_trace "[csvutil] Handler wants to skip this file, moving on to the next file";
                                        next INPUT_FILENAME;
                                    } elsif (delete $r->{wants_skip_files}) {
                                        log_trace "[csvutil] Handler wants to skip all files, skipping all input files";
                                        last READ_CSV;
                                    }
                                }

                                    log_trace "[csvutil] Calling on_input_data_row hook handler (for first data row) ..." if $r->{input_rownum} <= 2;
                                    $on_input_data_row->($r);

                                    if (delete $r->{wants_skip_file}) {
                                        log_trace "[csvutil] Handler wants to skip this file, moving on to the next file";
                                        next INPUT_FILENAME;
                                    } elsif (delete $r->{wants_skip_files}) {
                                        log_trace "[csvutil] Handler wants to skip all files, skipping all input files";
                                        last READ_CSV;
                                    }
                                }

I<READING CSV DATA>

To read CSV data, normally your utility would provide handler for the
C<on_input_data_row> hook and sometimes additionally C<on_input_header_row>.

I<OUTPUTTING STRING OR RETURNING RESULT>

To output string, usually you call the provided routine C<< $r-E<gt>{code_print} >>. This
routine will open the output files for you.

You can also return enveloped result directly by setting C<< $r-E<gt>{result} >>.

I<OUTPUTTING CSV DATA>

To output CSV data, usually you call the provided routine C<< $r-E<gt>{code_print_row} >>.
This routine accepts a row (arrayref or hashref). This routine will open the
output files for you when needed, as well as print header row automatically.

Then, you can supply handler for C<on_input_header_row> and C<on_input_data_row>
as usual. To switch to the next file, set
C<< $r-E<gt>{wants_switch_to_next_output_file} >> to true, in which case the next call to
C<< $r-E<gt>{code_print_row} >> will close the current file and open the next file.

I<CHANGING THE OUTPUT FIELDS>

When calling C<< $r-E<gt>{code_print_row} >>, you can output whatever fields you want. By
convention, you can set C<< $r-E<gt>{output_fields} >> and C<< $r-E<gt>{output_fields_idx} >> to
let other handlers know about the output fields. For example, see the
implementation of L<csv-concat>.

view all matches for this distribution

App-CamelPKI

1 match

t/lib/App/CamelPKI/Test.pm view on Meta::CPAN



=head1 EXPORTED FUNCTIONS

All functions described in this section factor some useful test
tactics and are exported by default.  The L</SAMPLE INPUTS> may also
be exported upon request.

=over

=cut

t/lib/App/CamelPKI/Test.pm view on Meta::CPAN

                ("perl-Camel-PKI-Test-XXXXXX",
                 TMPDIR => 1, ($ENV{DEBUG} ? () : (CLEANUP => 1))));
    }
}

=head1 SAMPLE INPUTS

I<App::CamelPKI::Test> also provides a couple of constants and
class methods to serve as inputs for tests.  All such symbols are
exportable, but not exported by default (see L</SYNOPSIS>) and they
start with I<test_>, so as to be clearly identified as sample data in

view all matches for this distribution

App-Caoliu

1 match

lib/App/Caoliu/Downloader.pm view on Meta::CPAN

    # get refvalue and reffvalue for post_form
    my $ua = Mojo::UserAgent->new( max_redirects => 5 );
    my $tx = $ua->get( $url => $headers );
    if ( my $res = $tx->success ) {
        my $html = $res->body;
        if ( $html =~ m/(<INPUT.+?name=['"]?ref['"]?.*?>)/gi ) {
            my $tmp = $1;
            $post_form->{ref} = $1
              if ( $tmp =~ m/(?<=value=)["']?([^\s>'"]+)/gi );
        }
        if ( $html =~ m/(<INPUT.+?name=['"]?ref['"]?.*?>)/gi ) {
            my $tmp = $1;
            $post_form->{reff} = $1
              if ( $tmp =~ m/(?<=value=)["']?([^\s>'"]+)/gi );
        }
    }

view all matches for this distribution

App-CaseUtils

4 results

    summary => 'Change input to upper case',
    description => <<'MARKDOWN',

This is basically a simple shortcut for something like:

    % perl -ne'print uc' INPUT ...
    % perl -pe'$_ = uc' INPUT ...

with some additional options.

MARKDOWN
    args => {

    summary => 'Change input to lower case',
    description => <<'MARKDOWN',

This is basically a simple shortcut for something like:

    % perl -ne'print lc' INPUT ...
    % perl -pe'$_ = lc' INPUT ...

with some additional options.

MARKDOWN
    args => {


Change input to lower case.

This is basically a simple shortcut for something like:

 % perl -ne'print lc' INPUT ...
 % perl -pe'$_ = lc' INPUT ...

with some additional options.

This function is not exported.


Change input to upper case.

This is basically a simple shortcut for something like:

 % perl -ne'print uc' INPUT ...
 % perl -pe'$_ = uc' INPUT ...

with some additional options.

This function is not exported.

view all matches for this distribution

App-Changelog2x

1 match

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


This method is not generally intended for end-user utilization. It is bound
to the ChangeLogML namespace URI with the name C<credits> for use by the
XSLT processor.

=item transform_changelog INPUT, OUTPUT, STYLE [, PARAMS]

This method performs the actual transformation of ChangeLogML content. There
are three required parameters and one optional parameter:

=over 8

=item INPUT

This parameter must be either an open filehandle or a string containing the
ChangeLogML XML content to be transformed. If the value is not a reference,
it is assumed to be XML content.

=item OUTPUT

This parameter must be an open filehandle, to which the transformed XML
content is written. This may be any object that acts like a filehandle;
an B<IO::File> instance, the result of an C<open> call, etc.

view all matches for this distribution

App-Chart

2 results

inc/MyMakeMakerGettext.pm view on Meta::CPAN

# message translation stuff -- from MyMakeMakerGettext

PO_DOMAIN = $po_domain
POT_COPYRIGHT_HOLDER = $pot_copyright_holder
POT_FILE = po/\$(PO_DOMAIN).pot
POT_INPUTS = $pot_inputs
PO_FILES = $po_files
MO_FILES = $mo_files

HERE
  $ret .= <<'HERE';

inc/MyMakeMakerGettext.pm view on Meta::CPAN


# "--keyword" options needed for 0.17, maybe they'll be builtin in later
# gettext.
#
POT_TEMP_FILE = $(PO_DOMAIN)-messages.tmp
$(POT_FILE): po/header.pot $(POT_INPUTS)
	xgettext \
	  --omit-header \
	  --add-comments=TRANSLATORS: \
	  --width=78 \
	  --msgid-bugs-address='$(AUTHOR)' \

inc/MyMakeMakerGettext.pm view on Meta::CPAN

	  --keyword=__x \
	  --keyword=N__ \
	  --keyword=__nx:1,2 \
	  --keyword=__p:1c,2 \
	  --keyword=__px:1c,2 \
	  $(POT_INPUTS)
	cat po/header.pot $(POT_TEMP_FILE) >$(POT_FILE)
	rm $(POT_TEMP_FILE)

# Each po/XX.po is msgmerged from the .pot, and generates a .mo under
# LocaleData.

view all matches for this distribution

App-Cheats

1 match

cheats.txt view on Meta::CPAN


# Print a message in cmake
message( "PROJECT_NAME: ${PROJECT_NAME}" )

# Assign variable in cmake
set(GENERATE_OUTPUT_DIR "${CMAKE_BINARY_DIR}/src_generated/")

# Remove files from a folder using cmake
file(GLOB REMOVE_FILES "${CMAKE_BINARY_DIR}/*")
message("REMOVE_FILES: ${REMOVE_FILES}")
file(REMOVE_RECURSE ${REMOVE_FILES})

cheats.txt view on Meta::CPAN

# filename  â€œâ€“â€  refers  to  STDIN.  When
# opened for  writing,  the  same  special
# filename  refers  to  STDOUT.
# Normally,  these  are  specified as â€œ<â€“â€ and â€œ>â€“â€,
# respectively.
open(INPUT,  "â€“" ) || die;     # reâ€“open standard input for reading
open(INPUT,  "<â€“") || die;     # same thing, but explicit
open(OUTPUT, ">â€“") || die;     # reâ€“open standard output for writing

# Can always use / for files in perl (even on DOS).
my $path = "a\b\c.txt";
my $path = "a/b/c.txt";

cheats.txt view on Meta::CPAN


# Run a child in a separate process and wait for it.
perl -E 'my $PID = fork; if (!$PID){ sleep 2; say "child"; exit 0 } waitpid $PID, 0; say "parent"'

# Send data from forked child back to parent using pipes.
perl -E 'pipe(INPUT,OUTPUT); my $PID = fork; if (!$PID){ close INPUT; sleep 1; say "child"; say OUTPUT "42"; close OUTPUT; exit 0 } close OUTPUT; waitpid $PID, 0; say "parent"; my ($Data) = <INPUT>; say "[$Data]"'

# Run multiple processes and collect their data.
perl -MMojo::Util=dumper -E 'use strict; use warnings; local $| = 1; my @Wait; for my $Count (1..5){ my($In,$Out); pipe($In,$Out); my $PID = fork; if (!$PID){ close $In; sleep int(rand(5)); say "Running child $Count"; say $Out "From-$Count"; close $O...
Running child 2
Running child 3

view all matches for this distribution

App-CommonPrefixUtils

2 results

script/remove-common-prefix view on Meta::CPAN

            exit 0;
        },
        'help|h'           => sub {
            print <<TEXT;
Usage:
  strip-common-prefix [OPTIONS]... [INPUT [OUTPUT]]
  strip-common-prefix --version, -v
  strip-common-prefix --help, -h
Options:

For more details, see the manpage/documentation.

script/remove-common-prefix view on Meta::CPAN


This document describes version 0.001 of remove-common-prefix (from Perl distribution App-CommonPrefixUtils), released on 2024-05-16.

=head1 SYNOPSIS

 strip-common-prefix [OPTION]... [INPUT]

Sample input:

 foobar
 foobaz

view all matches for this distribution

App-CommonSuffixUtils

2 results

script/remove-common-suffix view on Meta::CPAN

            exit 0;
        },
        'help|h'           => sub {
            print <<TEXT;
Usage:
  strip-common-suffix [OPTIONS]... [INPUT [OUTPUT]]
  strip-common-suffix --version, -v
  strip-common-suffix --help, -h
Options:

For more details, see the manpage/documentation.

script/remove-common-suffix view on Meta::CPAN


This document describes version 0.001 of remove-common-suffix (from Perl distribution App-CommonSuffixUtils), released on 2024-05-16.

=head1 SYNOPSIS

 strip-common-suffix [OPTION]... [INPUT]

Sample input:

 1foo
 23foo

view all matches for this distribution

App-Context

1 match

lib/App/Context/POE/Server.pm view on Meta::CPAN


### THIS DOESN'T WORK YET, THROWS AN EXCEPTION
sub _state_q {
    my $self = @_;
    my $HOTEL_SITE_QNAME    = "q-hotel_site";
    my $HOTEL_COMPUTE_QNAME = "q-hotel_compute";
    my $state = "";

    for my $qname ("q-hotel_site", "q-hotel_compute") {
        $state .= "$qname\n";
        ### EXCEPTION IS THROWN HERE

view all matches for this distribution

App-Cpanx

2 results

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


This script has no dependencies. It uses the curl program to download.

This script is self contained. It's runnable if all you have is the one file.

=head1 EXAMPLE OUTPUT

    jacob@prism ~ $ cpanx Acme::MetaSyntactic
    curl http://www.cpan.org/modules/02packages.details.txt.gz -z /Users/jacob/.cpanx/02packages.details.txt.gz -R
      % Total    % Received % Xferd  Average Speed   Time    Time     Time  Current
				     Dload  Upload   Total   Spent    Left  Speed

view all matches for this distribution

App-DBBrowser

1 match

bin/db-browser view on Meta::CPAN

Some C<read-line>s have predefined values. You can access these values with the C<Up-Arrow> and C<Down-Arrow> keys.

To exit a C<read-line> without returning anything, press C<Ctrl-X>. When the input buffer is empty and C<Enter> is
pressed, C<read-line> returns an empty string.

=head1 OUTPUT

The elements are right-justified if they look like a number; otherwise, they are left-justified.

If the option I<squash_spaces> is enabled, leading and trailing spaces are removed from the elements, and spaces are
squashed to a single white space.

view all matches for this distribution

App-DTWMIC

1 match

use App::DTWMIC;
use Udev::FFI;
use YAML::Syck;

use constant {
    DEVICE_INPUT_OTHER          => 0,
    DEVICE_INPUT_MOUSE          => 1,
    DEVICE_INPUT_TOUCHPAD       => 2,
    DEVICE_INPUT_TABLET         => 3,
    DEVICE_INPUT_TOUCHSCREEN    => 4,

    SYNCLIENT_LOCATIONS => [
        '/usr/bin/synclient'
    ]
};

my $udev;

sub _get_device_type {
    my $device = shift;

    my $id_input_mouse          = $device->get_property_value('ID_INPUT_MOUSE');
    my $id_input_touchpad       = $device->get_property_value('ID_INPUT_TOUCHPAD');
    my $id_input_tablet         = $device->get_property_value('ID_INPUT_TABLET');
    my $id_input_touchscreen    = $device->get_property_value('ID_INPUT_TOUCHSCREEN');

    if (defined($id_input_mouse) && $id_input_mouse eq '1') {
        # ID_INPUT_MOUSE: Touchscreens and tablets have this flag as well, since by the type of events they can produce
        # they act as a mouse.
        # https://askubuntu.com/questions/520359/how-to-detect-touchscreen-devices-from-a-script

        if (defined($id_input_touchpad) && $id_input_touchpad eq '1') {
            return DEVICE_INPUT_TOUCHPAD;
        }
        elsif (defined($id_input_tablet) && $id_input_tablet eq '1') {
            return DEVICE_INPUT_TABLET;
        }
        elsif (defined($id_input_touchscreen) && $id_input_touchscreen eq '1') {
            return DEVICE_INPUT_TOUCHSCREEN;
        }

        return DEVICE_INPUT_MOUSE;
    }
    elsif (defined($id_input_touchpad) && $id_input_touchpad eq '1') {
        return DEVICE_INPUT_TOUCHPAD;
    }
    elsif (defined($id_input_tablet) && $id_input_tablet eq '1') {
        return DEVICE_INPUT_TABLET;
    }
    elsif (defined($id_input_touchscreen) && $id_input_touchscreen eq '1') {
        return DEVICE_INPUT_TOUCHSCREEN;
    }

    return DEVICE_INPUT_OTHER;
}

sub _get_device_data {
    my $device = shift;

        if (defined(my $device = $udev->new_device_from_syspath($_))) {
            my $device_data = _get_device_data($device);
            next
                unless %$device_data;

            if (DEVICE_INPUT_TOUCHPAD == $device_data->{'type'}) {
                $touchpads->{ $device_data->{'sysname'} } = $device_data->{'data'};
            }
            elsif (DEVICE_INPUT_MOUSE == $device_data->{'type'}) {
                ++$has_mouse_devices;
            }
        }
    }

            }
        }

        $max_str_length += 8 - ($max_str_length % 4);

        for my $dev_type (@{ [[DEVICE_INPUT_MOUSE, 'MOUSE DEVICES'], [DEVICE_INPUT_TOUCHPAD, 'TOUCHPAD DEVICES']] }) {
            print("$dev_type->[1]:\n");

            while (my ($sysname, $device_data) = each(%{ $input_devices->{ $dev_type->[0] } })) {
                print('  '.$device_data->{'name'}.(' ' x ($max_str_length - length($device_data->{'name'}))).
                    "sysname: $sysname\n");

view all matches for this distribution

App-Dapper

2 results

README.md view on Meta::CPAN

To make it easy to publish to Amazon S3, one option is to create a Makefile
that encodes the publishing instructions. Here is a Makefile that I use for
[Mark Benson Portfolio](http://markbenson.io/):

    BASEDIR=$(CURDIR)
    INPUTDIR=$(BASEDIR)/_source
    OUTPUTDIR=$(BASEDIR)/_output

    S3_BUCKET=markbenson.io

    build:
    	dapper build

    serve: build
    	dapper serve

    publish: build
    	s3cmd sync $(OUTPUTDIR)/ s3://$(S3_BUCKET) --reduced-redundancy --acl-public --delete-removed

    watch:
    	dapper watch

    .PHONY: build serve publish watch

view all matches for this distribution

App-DocKnot

13 results

use Path::Tiny qw(path);
use Template;
use Text::Wrap qw(wrap);

# Default output files for specific templates.
my %DEFAULT_OUTPUT = (
    'readme'    => 'README',
    'readme-md' => 'README.md',
);

##############################################################################

#  Throws: autodie exception on failure to read metadata or write the output
#          Text exception on Template Toolkit failures
#          Text exception on inconsistencies in the package data
sub generate_all {
    my ($self) = @_;
    for my $template (keys(%DEFAULT_OUTPUT)) {
        $self->generate_output($template);
    }
    return;
}

#  Throws: autodie exception on failure to read metadata or write the output
#          Text exception on Template Toolkit failures
#          Text exception on inconsistencies in the package data
sub generate_output {
    my ($self, $template, $output) = @_;
    $output //= $DEFAULT_OUTPUT{$template};

    # If the template doesn't have a default output file, $output is required.
    if (!defined($output)) {
        croak('missing required output argument');
    }


Generate all of the documentation files for a package.  This is currently
defined as the C<readme> and C<readme-md> templates.  The output will be
written to the default output locations, as described under generate_output().

=item generate_output(TEMPLATE [, OUTPUT])

The same as generate() except that rather than returning the generated
documentation file as a string, it will be written to the file named by
OUTPUT.  If that argument isn't given, a default based on the TEMPLATE
argument is chosen as follows:

    readme     ->  README
    readme-md  ->  README.md

If TEMPLATE isn't one of the templates listed above, the OUTPUT argument is
required.

=back

=head1 AUTHOR

view all matches for this distribution

App-Dochazka-CLI

13 results

config/CLI_Config.pm view on Meta::CPAN

set( 'DOCHAZKA_REST_LOGIN_NICK', undef );

# DOCHAZKA_REST_LOGIN_NICK
#     password to use when we authenticate ourselves to the App::Dochazka::REST server
#     when this is set to '' or undef, App::Dochazka::CLI will prompt for a password
#     WARNING: PUTTING YOUR PASSWORD HERE MAY BE CONVENIENT, BUT IS PROBABLY UNSAFE
set( 'DOCHAZKA_REST_LOGIN_PASSWORD', undef );

# MREST_CLI_COOKIE_JAR
#     default location of the cookie jar
set( 'MREST_CLI_COOKIE_JAR', "$ENV{HOME}/.cookies.txt" );

view all matches for this distribution

App-Dochazka-REST

20 results