perl
view release on metacpan or search on metacpan
Porting/sort_perldiag.pl view on Meta::CPAN
#!/usr/bin/perl -w
use strict;
no locale;
my %items;
my $item_key;
$/ = '';
while (<>) {
if (/^=item\s+(.+)/) {
# new item
$item_key = get_item_key($1);
$items{$item_key} .= $_;
} elsif (/^=back\b/) {
# no more items in this group
# in such cases.
#
# =cut
#
ENDOFTAIL
if ($Opts{glossary}) {
open(GLOS, '<', $Glossary) or die "Can't open $Glossary: $!";
}
my $text = 0;
$/ = '';
my $errors= 0;
my %glossary;
my $fc;
my $item;
sub process {
if (s/\A(\w*)\s+\(([\w.]+)\):\s*\n(\t?)/=item C<$1>\n\nFrom F<$2>:\n\n/m) {
$item = $1;
cpan/IO-Compress/t/compress/generic.pl view on Meta::CPAN
ok @lines == 1 && $lines[0] eq $str;
$io = $UncompressClass->new($name);
ok ! $io->eof;
my $line = $io->getline();
ok $line eq $str;
ok $io->eof;
}
{
local $/ = ""; # paragraph mode
my $io = $UncompressClass->new($name);
is $., 0;
is $io->input_line_number, 0;
ok ! $io->eof;
my @lines = $io->getlines();
is $., 2;
is $io->input_line_number, 2;
ok $io->eof;
ok @lines == 2
or print "# Got " . scalar(@lines) . " lines, expected 2\n" ;
cpan/IO-Compress/t/compress/generic.pl view on Meta::CPAN
$io = $UncompressClass->new($name);
ok ! $io->eof;
my $line = $io->getline;
is $., 1;
is $io->input_line_number, 1;
is $line, $str;
ok $io->eof;
}
{
local $/ = ""; # paragraph mode
my $io = $UncompressClass->new($name);
ok ! $io->eof;
my @lines = $io->getlines;
is $., 2;
is $io->input_line_number, 2;
ok $io->eof;
ok @lines == 2
or print "# expected 2 lines, got " . scalar(@lines) . "\n";
ok $lines[0] eq "This is an example\nof a paragraph\n\n\n"
or print "# [$lines[0]]\n" ;
cpan/IO-Compress/t/compress/newtied.pl view on Meta::CPAN
ok @lines == 1 && $lines[0] eq $str;
$io = $UncompressClass->new($name);
ok ! $io->eof;
my $line = <$io>;
ok $line eq $str;
ok $io->eof;
}
{
local $/ = ""; # paragraph mode
my $io = $UncompressClass->new($name);
ok ! $io->eof;
my @lines = <$io>;
ok $io->eof;
ok @lines == 2
or print "# Got " . scalar(@lines) . " lines, expected 2\n" ;
ok $lines[0] eq "This is an example\nof a paragraph\n\n\n"
or print "# $lines[0]\n";
ok $lines[1] eq "and a single line.\n\n";
}
cpan/IO-Compress/t/compress/tied.pl view on Meta::CPAN
ok @lines == 1 && $lines[0] eq $str;
$io = $UncompressClass->new($name);
ok ! $io->eof;
my $line = <$io>;
ok $line eq $str;
ok $io->eof;
}
{
local $/ = ""; # paragraph mode
my $io = $UncompressClass->new($name);
ok ! $io->eof;
my @lines = <$io>;
ok $io->eof;
ok @lines == 2
or print "# Got " . scalar(@lines) . " lines, expected 2\n" ;
ok $lines[0] eq "This is an example\nof a paragraph\n\n\n"
or print "# $lines[0]\n";
ok $lines[1] eq "and a single line.\n\n";
}
cpan/IO-Compress/t/compress/tied.pl view on Meta::CPAN
ok @lines == 1 && $lines[0] eq $str;
$io = $UncompressClass->new($name);
ok ! $io->eof;
my $line = <$io>;
ok $line eq $str;
ok $io->eof;
}
{
local $/ = ""; # paragraph mode
my $io = $UncompressClass->new($name);
ok ! $io->eof;
my @lines = <$io>;
ok $io->eof;
ok @lines == 2
or print "# expected 2 lines, got " . scalar(@lines) . "\n";
ok $lines[0] eq "This is an example\nof a paragraph\n\n\n"
or print "# [$lines[0]]\n" ;
ok $lines[1] eq "and a single line.\n\n";
}
cpan/perlfaq/lib/perlfaq6.pod view on Meta::CPAN
For example, this program detects duplicate words, even when they span
line breaks (but not paragraph ones). For this example, we don't need
C</s> because we aren't using dot in a regular expression that we want
to cross line boundaries. Neither do we need C</m> because we don't
want caret or dollar to match at any point inside the record next
to newlines. But it's imperative that $/ be set to something other
than the default, or else we won't actually ever have a multiline
record read in.
$/ = ''; # read in whole paragraph, not just one line
while ( <> ) {
while ( /\b([\w'-]+)(\s+\g1)+\b/gi ) { # word starts alpha
print "Duplicate $1 at paragraph $.\n";
}
}
Here's some code that finds sentences that begin with "From " (which would
be mangled by many mailers):
$/ = ''; # read in whole paragraph, not just one line
while ( <> ) {
while ( /^From /gm ) { # /m makes ^ match next to \n
print "leading From in paragraph $.\n";
}
}
Here's code that finds everything between START and END in a paragraph:
undef $/; # read in whole file, not just one line or paragraph
while ( <> ) {
dist/Tie-File/lib/Tie/File.pm view on Meta::CPAN
Curse these pesky flies!\n
then the C<@array> would appear to have four elements:
"Curse th"
"e p"
"ky fli"
"!\n"
An undefined value is not permitted as a record separator. Perl's
special "paragraph mode" semantics (E<agrave> la C<$/ = "">) are not
emulated.
Records read from the tied array do not have the record separator
string on the end; this is to allow
$array[17] .= "extra";
to work as expected.
(See L<"autochomp">, below.) Records stored into the array will have
ext/B/t/OptreeCheck.pm view on Meta::CPAN
sub OptreeCheck::processExamples {
my @files = @_;
# gets array of paragraphs, which should be code-samples. They're
# turned into optreeCheck tests,
foreach my $file (@files) {
open (my $fh, '<', $file) or die "cant open $file: $!\n";
$/ = "";
my @chunks = <$fh>;
print preamble (scalar @chunks);
foreach my $t (@chunks) {
print "\n\n=for gentest\n\n# chunk: $t=cut\n\n";
print OptreeCheck::gentest ($t);
}
}
}
# OK - now for the final insult to your good taste...
ext/Pod-Html/t/anchorify.t view on Meta::CPAN
use strict;
use warnings;
use Pod::Html::Util qw( anchorify relativize_url );
use Test::More;
my @filedata;
{
local $/ = '';
@filedata = <DATA>;
}
my (@poddata, $i, $j);
for ($i = 0, $j = -1; $i <= $#filedata; $i++) {
$j++ if ($filedata[$i] =~ /^\s*=head[1-6]/);
if ($j >= 0) {
$poddata[$j] = "" unless defined $poddata[$j];
$poddata[$j] .= "\n$filedata[$i]" if $j >= 0;
}
installhtml view on Meta::CPAN
# now go through and truncate after the index
$dir =~ /^(.*?)(\.pod|\.pm)?$/sm;
my $file = "$htmldir/$1";
print "creating index $file.html\n" if $verbose;
# read in everything until what would have been the first =head
# directive, patching the index as we go.
open(H, '<', "$file.html") ||
die "$0: error opening $file.html for input: $!\n";
$/ = "";
my @data = ();
while (<H>) {
last if m!<h1 id="NAME">NAME</h1>!;
$_ =~ s{href="#(.*)">}{
my $url = "$file/@{[anchorify(qq($1))]}.html" ;
$url = relativize_url( $url, "$file.html" )
if ( ! defined $Options{htmlroot} || $Options{htmlroot} eq '' );
"href=\"$url\">" ;
}egi;
push @data, $_;
installhtml view on Meta::CPAN
# is encountered in the input file.
#
sub splitpod {
my($pod, $poddir, $htmldir, $splitdirs) = @_;
my(@poddata, @filedata, @heads);
my($file, $i, $j, $prevsec, $section, $nextsec);
print "splitting $pod\n" if $verbose;
# read the file in paragraphs
$/ = "";
open(SPLITIN, '<', $pod) ||
die "$0: error opening $pod for input: $!\n";
@filedata = <SPLITIN>;
close(SPLITIN) ||
die "$0: error closing $pod: $!\n";
# restore the file internally by =head[1-6] sections
@poddata = ();
for ($i = 0, $j = -1; $i <= $#filedata; $i++) {
$j++ if ($filedata[$i] =~ /^\s*=head[1-6]/);
lib/diagnostics.pm view on Meta::CPAN
my %transfmt = ();
my $transmo = <<EOFUNC;
sub transmo {
#local \$^W = 0; # recursive warnings we do NOT need!
EOFUNC
my %msg;
my $over_level = 0; # We look only at =item lines at the first =over level
{
print STDERR "FINISHING COMPILATION for $_\n" if $DEBUG;
local $/ = '';
local $_;
my $header;
my @headers;
my $for_item;
my $seen_body;
while (<POD_DIAG>) {
sub _split_pod_link {
$_[0] =~ m'(?:([^|]*)\|)?([^/]*)(?:/("?)(.*)\3)?'s;
($1,$2,$4);
pod/buildtoc view on Meta::CPAN
last;
}
}
unless ($found_pod) {
warn "$0: NOTE: cannot find '=head1 NAME' in:\n $file\n" unless $Quiet;
return;
}
seek $fh, 0, 0 or my_die "Can't rewind file '$file': $!";
local $/ = '';
while(<$fh>) {
s/\r$//;
if (s/^=head1 (NAME)\s*/=head2 /) {
unhead1();
$OUT .= "\n\n=head2 ";
$_ = <$fh>;
last unless defined $_;
# Remove svn keyword expansions from the Perl FAQ
s/ \(\$Revision: \d+ \$\)//g;
pod/perl588delta.pod view on Meta::CPAN
C<PerlIO> upgraded to version 1.04
=over
=item *
C<PerlIO::via> iterate over layers properly now
=item *
C<PerlIO::scalar> understands C<< $/ = "" >> now
=item *
C<encoding(utf-8-strict)> with partial characters now works
=item *
Enhanced documentation
=item *
pod/perlform.pod view on Meta::CPAN
.
Here's a little program that's somewhat like fmt(1):
format =
^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< ~~
$_
.
$/ = '';
while (<>) {
s/\s*\n\s*/ /g;
write;
}
=head2 Footers
X<format, footer> X<footer>
While $FORMAT_TOP_NAME contains the name of the current header format,
there is no corresponding mechanism to automatically do the same thing
pod/perlfunc.pod view on Meta::CPAN
=for Pod::Functions remove a trailing record separator from a string
This safer version of L<C<chop>|/chop VARIABLE> removes any trailing
string that corresponds to the current value of
L<C<$E<sol>>|perlvar/$E<sol>> (also known as C<$INPUT_RECORD_SEPARATOR>
in the L<C<English>|English> module). It returns the total
number of characters removed from all its arguments. It's often used to
remove the newline from the end of an input record when you're worried
that the final record may be missing its newline. When in paragraph
mode (C<$/ = ''>), it removes all trailing newlines from the string.
When in slurp mode (C<$/ = undef>) or fixed-length record mode
(L<C<$E<sol>>|perlvar/$E<sol>> is a reference to an integer or the like;
see L<perlvar>), L<C<chomp>|/chomp VARIABLE> won't remove anything.
If VARIABLE is omitted, it chomps L<C<$_>|perlvar/$_>. Example:
while (<>) {
chomp; # avoid \n on last field
my @array = split(/:/);
# ...
}
pod/perlmodlib.PL view on Meta::CPAN
for my $filename (@files) {
unless (open MOD, '<', $filename) {
warn "Couldn't open $filename: $!";
next;
}
my ($name, $thing);
my $foundit = 0;
{
local $/ = "";
while (<MOD>) {
next unless /^=head1 NAME/;
$foundit++;
last;
}
}
unless ($foundit) {
next if pod_for_module_has_head1_NAME($filename);
die "p5p-controlled module $filename missing =head1 NAME\n"
if $filename !~ m{^(dist/|cpan/)}n # under our direct control
pod/perlmodlib.PL view on Meta::CPAN
push @pragma, $title;
}
}
sub pod_for_module_has_head1_NAME {
my ($filename) = @_;
(my $pod_file = $filename) =~ s/\.pm\z/.pod/ or return 0;
return 0 if !-e $pod_file;
open my $fh, '<', $pod_file
or die "Can't open $pod_file for reading: $!\n";
local $/ = '';
while (my $para = <$fh>) {
return 1 if $para =~ /\A=head1 NAME$/m;
}
return 0;
}
# Much easier to special case it like this than special case the depending on
# and parsing lib/Config.pod, or special case opening configpm and finding its
# =head1 (which is not found with the $/="" above)
push @mod, "=item Config\n\nAccess Perl configuration information\n\n";
# The intent of using =cut as the heredoc terminator is to make the whole file
# parse as (reasonably) sane Pod as-is to anything that attempts to
# brute-force treat it as such. The content is already useful - this just
# makes it tidier, by stopping anything doing this mistaking the rest of the
# Perl code for Pod. eg https://metacpan.org/pod/perlmodlib
print $out <<'=cut';
pod/perlop.pod view on Meta::CPAN
the C<\A> assertion to match the beginning of the string. Note also
that, currently, C<\G> is only properly supported when anchored at the
very beginning of the pattern.
Examples:
# list context
($one,$five,$fifteen) = (`uptime` =~ /(\d+\.\d+)/g);
# scalar context
local $/ = "";
while ($paragraph = <>) {
while ($paragraph =~ /\p{Ll}['")]*[.!?]+['")]*\s/g) {
$sentences++;
}
}
say $sentences;
Here's another way to check for sentences in a paragraph:
my $sentence_rx = qr{
pod/perlop.pod view on Meta::CPAN
# whitespace
(?<! \b [DMS]r ) # but isn't a common abbr.
(?<! \b Mrs )
(?<! \b Sra )
(?<! \b St )
[.?!] # followed by a sentence
# ender
(?= $ | \s ) # in front of end-of-string
# or whitespace
}sx;
local $/ = "";
while (my $paragraph = <>) {
say "NEW PARAGRAPH";
my $count = 0;
while ($paragraph =~ /($sentence_rx)/g) {
printf "\tgot sentence %d: <%s>\n", ++$count, $1;
}
}
Here's how to use C<m//gc> with C<\G>:
pod/perlvar.pod view on Meta::CPAN
$string .= "epsilon zeta eta\n\n";
$string .= "theta\n";
my $file = 'simple_file.txt';
open my $OUT, '>', $file or die;
print $OUT $string;
close $OUT or die;
Now we read that file in paragraph mode:
local $/ = ""; # paragraph mode
open my $IN, '<', $file or die;
my @records = <$IN>;
close $IN or die;
C<@records> will consist of these 3 strings:
(
"alpha beta\ngamma delta\n\n",
"epsilon zeta eta\n\n",
"theta\n",
pod/splitpod view on Meta::CPAN
#!/usr/bin/perl
BEGIN { push @INC, '../lib' } # If you haven't installed perl yet.
use Pod::Functions;
local $/ = '';
$level = 0;
$cur = '';
while (<>) {
next unless /^=(?!cut)/ .. /^=cut/;
++$level if /^=over/;
--$level if /^=back/;
t/base/rs.t view on Meta::CPAN
$bar = <FH>;
if ($bar ne "1234") {print "not ";}
print "ok $test_count # \$/ = \"34\"\n";
$test_count++;
# Eat the line terminator
$/ = "\n";
$bar = <FH>;
# Does paragraph mode work?
$/ = '';
$bar = <FH>;
if ($bar ne "1234\n12345\n\n") {print "not ";}
print "ok $test_count # \$/ = ''\n";
$test_count++;
# Try slurping the rest of the file
$/ = undef;
$bar = <FH>;
if ($bar ne "123456\n1234567\n") {print "not ";}
print "ok $test_count # \$/ = undef\n";
$test_count++;
}
t/io/paragraph_mode.t view on Meta::CPAN
);
print $OUT $chunks[3];
close $OUT or die;
@expected = (
"$chunks[0]\n\n",
"$chunks[1]\n\n",
"$chunks[2]\n\n",
$chunks[3],
);
local $/ = '';
perform_tests($filename, \@expected, $msg);
}
{
$msg = "'Well behaved' file: >= 2 newlines between text blocks; no internal newlines; 0 final newline";
($OUT, $filename) = open_tempfile();
print $OUT "$_\n" for (
$chunks[0],
("") x 1,
t/io/paragraph_mode.t view on Meta::CPAN
$chunks[3],
);
close $OUT or die;
@expected = (
"$chunks[0]\n\n",
"$chunks[1]\n\n",
"$chunks[2]\n\n",
"$chunks[3]\n",
);
local $/ = '';
perform_tests($filename, \@expected, $msg);
}
{
$msg = "'Well behaved' file: >= 2 newlines between text blocks; no internal newlines; 1 final newline";
($OUT, $filename) = open_tempfile();
print $OUT "$_\n" for (
$chunks[0],
("") x 1,
t/io/paragraph_mode.t view on Meta::CPAN
("") x 1,
);
close $OUT or die;
@expected = (
"$chunks[0]\n\n",
"$chunks[1]\n\n",
"$chunks[2]\n\n",
"$chunks[3]\n\n",
);
local $/ = '';
perform_tests($filename, \@expected, $msg);
}
{
$msg = "'Well behaved' file: >= 2 newlines between text blocks; no internal newlines; 2 final newlines";
($OUT, $filename) = open_tempfile();
print $OUT "$_\n" for (
$chunks[0],
("") x 1,
t/io/paragraph_mode.t view on Meta::CPAN
("") x 2,
);
close $OUT or die;
@expected = (
"$chunks[0]\n\n",
"$chunks[1]\n\n",
"$chunks[2]\n\n",
"$chunks[3]\n\n",
);
local $/ = '';
perform_tests($filename, \@expected, $msg);
}
}
{
# We continue with files whose "paragraphs" contain internal newlines.
@chunks = (
join('' => ( 1, 2, "\n", 3 )),
join('' => ( 4, 5, " \n", 6 )),
join('' => ( 7, 8, " \t\n", 9 )),
t/io/paragraph_mode.t view on Meta::CPAN
);
print $OUT $chunks[3];
close $OUT or die;
@expected = (
"$chunks[0]\n\n",
"$chunks[1]\n\n",
"$chunks[2]\n\n",
$chunks[3],
);
local $/ = '';
perform_tests($filename, \@expected, $msg);
}
{
$msg = "'Misbehaving' file: >= 2 newlines between text blocks; no internal newlines; 0 final newline";
($OUT, $filename) = open_tempfile();
print $OUT "$_\n" for (
$chunks[0],
("") x 1,
t/io/paragraph_mode.t view on Meta::CPAN
$chunks[3],
);
close $OUT or die;
@expected = (
"$chunks[0]\n\n",
"$chunks[1]\n\n",
"$chunks[2]\n\n",
"$chunks[3]\n",
);
local $/ = '';
perform_tests($filename, \@expected, $msg);
}
{
$msg = "'Misbehaving' file: >= 2 newlines between text blocks; no internal newlines; 1 final newline";
($OUT, $filename) = open_tempfile();
print $OUT "$_\n" for (
$chunks[0],
("") x 1,
t/io/paragraph_mode.t view on Meta::CPAN
("") x 1,
);
close $OUT or die;
@expected = (
"$chunks[0]\n\n",
"$chunks[1]\n\n",
"$chunks[2]\n\n",
"$chunks[3]\n\n",
);
local $/ = '';
perform_tests($filename, \@expected, $msg);
}
{
$msg = "'Misbehaving' file: >= 2 newlines between text blocks; no internal newlines; 2 final newlines";
($OUT, $filename) = open_tempfile();
print $OUT "$_\n" for (
$chunks[0],
("") x 1,
t/io/paragraph_mode.t view on Meta::CPAN
("") x 2,
);
close $OUT or die;
@expected = (
"$chunks[0]\n\n",
"$chunks[1]\n\n",
"$chunks[2]\n\n",
"$chunks[3]\n\n",
);
local $/ = '';
perform_tests($filename, \@expected, $msg);
}
}
{
# We continue with files which start with newlines
# but whose "paragraphs" contain no internal newlines.
# We'll set our expectation that the leading newlines will get trimmed off
# and everything else will proceed normally.
t/io/paragraph_mode.t view on Meta::CPAN
);
print $OUT $chunks[3];
close $OUT or die;
@expected = (
"$chunks[0]\n\n",
"$chunks[1]\n\n",
"$chunks[2]\n\n",
$chunks[3],
);
local $/ = '';
perform_tests($filename, \@expected, $msg);
}
{
$msg = "'Badly behaved' file: leading newlines; 0 final newline";
($OUT, $filename) = open_tempfile();
print $OUT "\n\n\n";
print $OUT "$_\n" for (
$chunks[0],
t/io/paragraph_mode.t view on Meta::CPAN
$chunks[3],
);
close $OUT or die;
@expected = (
"$chunks[0]\n\n",
"$chunks[1]\n\n",
"$chunks[2]\n\n",
"$chunks[3]\n",
);
local $/ = '';
perform_tests($filename, \@expected, $msg);
}
{
$msg = "'Badly behaved' file: leading newlines; 1 final newline";
($OUT, $filename) = open_tempfile();
print $OUT "\n\n\n";
print $OUT "$_\n" for (
$chunks[0],
t/io/paragraph_mode.t view on Meta::CPAN
("") x 1,
);
close $OUT or die;
@expected = (
"$chunks[0]\n\n",
"$chunks[1]\n\n",
"$chunks[2]\n\n",
"$chunks[3]\n\n",
);
local $/ = '';
perform_tests($filename, \@expected, $msg);
}
{
$msg = "'Badly behaved' file: leading newlines; 2 final newlines";
($OUT, $filename) = open_tempfile();
print $OUT "\n\n\n";
print $OUT "$_\n" for (
$chunks[0],
t/io/paragraph_mode.t view on Meta::CPAN
("") x 2,
);
close $OUT or die;
@expected = (
"$chunks[0]\n\n",
"$chunks[1]\n\n",
"$chunks[2]\n\n",
"$chunks[3]\n\n",
);
local $/ = '';
perform_tests($filename, \@expected, $msg);
}
}
{
# We continue with files which start with newlines
# and whose "paragraphs" contain internal newlines.
# We'll set our expectation that the leading newlines will get trimmed off
# and everything else will proceed normally.
t/io/paragraph_mode.t view on Meta::CPAN
);
print $OUT $chunks[3];
close $OUT or die;
@expected = (
"$chunks[0]\n\n",
"$chunks[1]\n\n",
"$chunks[2]\n\n",
$chunks[3],
);
local $/ = '';
perform_tests($filename, \@expected, $msg);
}
{
$msg = "'Very badly behaved' file: leading newlines; internal newlines; 0 final newline";
($OUT, $filename) = open_tempfile();
print $OUT "\n\n\n";
print $OUT "$_\n" for (
$chunks[0],
t/io/paragraph_mode.t view on Meta::CPAN
$chunks[3],
);
close $OUT or die;
@expected = (
"$chunks[0]\n\n",
"$chunks[1]\n\n",
"$chunks[2]\n\n",
"$chunks[3]\n",
);
local $/ = '';
perform_tests($filename, \@expected, $msg);
}
{
$msg = "'Very badly behaved' file: leading newlines; internal newlines; 1 final newline";
($OUT, $filename) = open_tempfile();
print $OUT "\n\n\n";
print $OUT "$_\n" for (
$chunks[0],
t/io/paragraph_mode.t view on Meta::CPAN
("") x 1,
);
close $OUT or die;
@expected = (
"$chunks[0]\n\n",
"$chunks[1]\n\n",
"$chunks[2]\n\n",
"$chunks[3]\n\n",
);
local $/ = '';
perform_tests($filename, \@expected, $msg);
}
{
$msg = "'Very badly behaved' file: leading newlines; internal newlines; 2 final newlines";
($OUT, $filename) = open_tempfile();
print $OUT "\n\n\n";
print $OUT "$_\n" for (
$chunks[0],
t/io/paragraph_mode.t view on Meta::CPAN
("") x 2,
);
close $OUT or die;
@expected = (
"$chunks[0]\n\n",
"$chunks[1]\n\n",
"$chunks[2]\n\n",
"$chunks[3]\n\n",
);
local $/ = '';
perform_tests($filename, \@expected, $msg);
}
}
########## SUBROUTINES ##########
sub open_tempfile {
my $filename = tempfile();
open my $OUT, '>', $filename or die;
binmode $OUT;
t/io/scalar.t view on Meta::CPAN
is($x, '');
{
# [perl #35929] verify that works with $/ (i.e. test PerlIOScalar_unread)
my $s = <<'EOF';
line A
line B
a third line
EOF
open(F, '<', \$s) or die "Could not open string as a file";
local $/ = "";
my $ln = <F>;
close F;
is($ln, $s, "[perl #35929]");
}
# [perl #40267] PerlIO::scalar doesn't respect readonly-ness
{
my $warn;
local $SIG{__WARN__} = sub { $warn = "@_" };
ok(!(defined open(F, '>', \undef)), "[perl #40267] - $!");
t/op/chop.t view on Meta::CPAN
is ($got, "2", 'check return value when chomp string with $/ consisting of more than one character, and with the ending of the string matching $/');
is ($_, "f", 'chomp a string when $/ consists of two characters that are at the end of the string, check that chomped string contains remnant of original string');
$_ = "bar";
$/ = "oo";
$got = chomp();
is($got, "0", 'check return value when call chomp with $/ consisting of more than one character, and with the ending of the string NOT matching $/');
is ($_, "bar", 'chomp a string when $/ consists of two characters that are NOT at the end of the string');
$_ = "f\n\n\n\n\n";
$/ = "";
$got = chomp();
is ($got, 5, 'check return value when chomp in paragraph mode on string ending with 5 newlines');
is ($_, "f", 'chomp in paragraph mode on string ending with 5 newlines');
$_ = "f\n\n";
$/ = "";
$got = chomp();
is ($got, 2, 'check return value when chomp in paragraph mode on string ending with 2 newlines');
is ($_, "f", 'chomp in paragraph mode on string ending with 2 newlines');
$_ = "f\n";
$/ = "";
$got = chomp();
is ($got, 1, 'check return value when chomp in paragraph mode on string ending with 1 newline');
is ($_, "f", 'chomp in paragraph mode on string ending with 1 newlines');
$_ = "f";
$/ = "";
$got = chomp();
is ($got, 0, 'check return value when chomp in paragraph mode on string ending with no newlines');
is ($_, "f", 'chomp in paragraph mode on string lacking trailing newlines');
$_ = "xx";
$/ = "xx";
$got = chomp();
is ($got, 2, 'check return value when chomp string that consists solely of current value of $/');
is ($_, "", 'chomp on string that consists solely of current value of $/; check that empty string remains');
t/porting/copyright.t view on Meta::CPAN
sub readme_year
# returns the latest copyright year from the top-level README file
{
my $file = shift || "README";
open my $readme, '<', "../$file" or die "Opening $file failed: $!";
# The copyright message is the first paragraph:
local $/ = '';
my $copyright_msg = <$readme>;
my ($year) = $copyright_msg =~ /.*\b(\d{4,})/s
or die "Year not found in $file copyright message '$copyright_msg'";
$year;
}
sub v_year
( run in 0.858 second using v1.01-cache-2.11-cpan-49f99fa48dc )