Beefy Boxes and Bandwidth Generously Provided by pair Networks
laziness, impatience, and hubris
 
PerlMonks  

ikegami's scratchpad

by ikegami (Pope)
on Aug 16, 2004 at 23:32 UTC ( #383504=scratchpad: print w/ replies, xml ) Need Help??

Help for this page

Select Code to Download


  1. or download this
    Program received signal SIGSEGV, Segmentation fault.
    0x00000000004d406e in S_regmatch (prog=Cannot access memory at address
    + 0x3e4dd10ce38
    ...
    #6896 0x0000000000459750 in S_run_body (oldscope=1) at perl.c:2448
    #6897 0x0000000000459275 in perl_run (my_perl=0x792700) at perl.c:2368
    #6898 0x000000000041ff67 in main (argc=3, argv=0x3e4dd90b478, env=0x3e
    +4dd90b498) at perlmain.c:109
    
  2. or download this
    use IPC::Open3 qw( open3 );
    
    ...
    }
    
    waitpid($pid, 0);
    
  3. or download this
    use IPC::Open3 qw( open3 );
    
    ...
    }
    
    waitpid($pid, 0);
    
  4. or download this
    >type script.bat
    @echo off
    ...
    echo today=%today%
    for /f "usebackq delims=" %%q in (`perl -MPOSIX -E"say strftime('%Y%m%
    +d', localtime)"`) do set today=%%q
    echo today=%today%
    
  5. or download this
    perl -MDateTime -E"say DateTime->today( time_zone => 'local' )->ymd"
    
  6. or download this
    >type script.bat
    @echo off
    ...
    testb=
    testa=abc
    testb=def
    
  7. or download this
    package My::XML::Generator;
    
    ...
                ]),
            ]);
        }
    
  8. or download this
    #!/bin/bash
    exec 3>&2 2>&1
    err=$( perl -e'print "O\n"; warn "E\n"' 3>&2 2>&1 1>&3 )
    exec 2>&3 3>&-
    echo "[STDERR:$err]" >&2
    
  9. or download this
    $ x
    O
    ...
    
    $ x 1>/dev/null
    [STDERR:E]
    
  10. or download this
    # Set your timezone to America/New_York before running.
    # In this time zone, DST ends on Nov 2, 2008 at 2:00 AM.
    ...
    use POSIX;
    print( strftime( "%m-%d\n", localtime( 86400 * $_ + $time ) ) )
       for 1..30;
    
  11. or download this
    10-29
    10-30
    ...
    11-25
    11-26
           > 11-27 didn't get created
    
  12. or download this
       +-------------+    +-------------+    +-------------+
       | Document    |    | Linkage     |    | Animal      |
    ...
       +-------------+    +-------------+    +-------------+
    
    P - Primary key (Unique, Not NULL)
    
  13. or download this
    SELECT Document.data
      FROM Document
    ...
                   ON Animal.id = Linkage.b
                WHERE Animal.name IN (?, ?, ...)
           )
    
  14. or download this
    SELECT Document.data
      FROM Document
    ...
                GROUP BY Linkage.a
                HAVING COUNT(*) = ?
           )
    
  15. or download this
    use IO::Handle ();  # For "flush" method.
    
    ...
    }
    
    print("crlf\n");
    
  16. or download this
    use IO::Handle ();  # For "flush" method.
    
    ...
    STDOUT_BIN->flush();     
    
    print("crlf\n");
    
  17. or download this
    >perl -v
    
    ...
    -D100 L10
    0B27:0100  63 72 6C 66 0D 0A 72 61-77 0A 63 72 6C 66 0D 0A   crlf..raw
    +.crlf..
    -Q
    
  18. or download this
    use strict;
    use warnings;
    ...
    
    for (         $min .. $max) { print(":"); <STDIN>; last; }  # 2.2MB
    for ( reverse $min .. $max) { print(":"); <STDIN>; last; }  # 239MB
    
  19. or download this
    use File::Basename  qw( fileparse );
    use IO::Dir         qw( );
    ...
    
       return "$d${n}[$max]$e";
    }
    
  20. or download this
    sub get_iter {
       my $pass = 0;
    ...
    while ($_ = $i->()) {
       print("$_\n");
    }
    
  21. or download this
    sub get_iter {
       my $pass = 0;
    ...
    while ($_ = $i->()) {
       print("$_\n");
    }
    
  22. or download this
    sub get_fibonacci_iter {
       my ($x, $y) = (0, 1);
    ...
    my $i = get_fibonacci_iter();
    print($i->(), "\n")
       for 1..40;
    
  23. or download this
    my $mask = 0x06000003; # or whatever
    
    ...
       last if not $val;
       $val = ($val - 1) & $mask;
    }
    
  24. or download this
    0x00000000
    0x00000001
    ...
    0x06000001
    0x06000002
    0x06000003
    
  25. or download this
    sub slice_ref {
       return \@_;
    ...
    print("After inserting into bar:\n");    # Doesn't work:
    print('foo: ', join(', ', @foo), "\n");  # foo: a, 2, 3, 4, 5
    print('bar: ', join(', ', @bar), "\n");  # bar: a, 6, 2, 3
    
  26. or download this
    perl -M"ActivePerl::DocTools"
         -e"ActivePerl::DocTools::UpdateHTML();
            ActivePerl::DocTools::WriteTOC();"
    
  27. or download this
    use URI ();
    use File::Spec::Unix ();
    ...
    # ------
    # http://www.faqs.org/rfcs/
    # http://www.server.com/
    
  28. or download this
    system("... ...")
    system("...", "...", "...")
    ...
    IPC::Open3
    IPC::Run
    IPC::Run3
    
  29. or download this
    /^(?:(?!$re).)*$/          # NOT re
    /$re1|$re2/                # re1 OR re2
    /^(?=.*$re1)(?=.*$re2)/    # re1 AND re2
    
  30. or download this
    sub create_closure {
       my $var = shift;
    ...
    # around $var. I don't know if "closes"
    # is the official terminology, but
    # that's what's happening.
    
  31. or download this
    sub scale_dimentions {
       my ($width, $height, $max_width, $max_height) = @_;
    ...
    
    printf("%d,%d$/", scale_dimentions(2272, 1704, 150, 150));  # 150,112
    printf("%d,%d$/", scale_dimentions(1704, 2272, 150, 150));  # 112,150
    
  32. or download this
    my @ranges = (
       [ 0 .. 2 ],
    ...
    
    print(join(' ', @$_), $/)
       foreach @results;
    
  33. or download this
    my @lists = (
       [ ... ],
    ...
    
    print(join(' ', @$_), $/)
       foreach @results;
    
  34. or download this
    # Add $value to sorted @array, if it's not already there.
    my $idx = binsearch { $a <=> $b } $value, @array;
    splice(@array, ~$idx, 0, $value) if $idx < 0;
    
  35. or download this
    sub binsearch(&$\@) {
       my  $compare = $_[0];
    ...
    }
    
    sub _unsigned_to_signed { unpack('j', pack('J', $_[0])) }
    
  36. or download this
    $i = 4;       print($i)   while ($i--);  #  3210
    $i = 4;  do { print($i) } while ($i--);  # 43210
    
  37. or download this
    $a = something;  # something is executed in a scalar context.
    @a = something;  # something is executed in a list   context.
    ...
       print(scalar(localtime));  # Fri Oct  1 15:05:32 2004
    }
    # Refer to wantarray in perlfunc.
    
  38. or download this
    sub nearest {
       my ($num) = @_;
    ...
    
       return int($num + 0.5) * $f;
    }
    
  39. or download this
    sub nearest {
       my ($num, $digits) = @_;
    ...
    
       return int($num + 0.5) * $f;
    }
    
  40. or download this
    $stmt = 'SELECT Field1, Field2 FROM Table';
    $href = { map { @$_ } @{$dbh->selectall_arrayref($stmt)} };
    ...
    #    Row2Field1 => Row2Field2,
    #    ...
    # };
    
  41. or download this
    $stmt = 'SELECT Field1, Field2 FROM Table';
    $href = $dbh->selectall_hashref($stmt, 'Field1');
    ...
    #    Row2Field1 => { Field1 => Row2Field1, Field2 => Row2Field2 },
    #    ...
    # };
    
  42. or download this
    # Serializes an array, a hash or a list which contains only
    # strings and undefs. Everything else will be stringified.
    ...
          )
       } split(/\|/, $_[0]);
    }
    
  43. or download this
    # Untested.
    
    ...
    # End HTML.
    print($q->end_form());
    print($q->end_html());
    
  44. or download this
    sub flush {
       my $h = select($_[0]); my $af=$|; $|=1; $|=$af; select($h);
    }
    
  45. or download this
    package MyStruct;
    
    ...
       $x->Counter++;                      print($x->Counter, "\n");  # 5
       $x->Counter += 1;                   print($x->Counter, "\n");  # 6
    }
    
  46. or download this
    # This \$var syntax of open() requires Perl 5.8.0 or higher.
    use 5.8.0;
    ...
    }
    
    print("\$output contains:\n$output");
    
  47. or download this
    Windows Registry Editor Version 5.00
    
    ...
    
    [HKEY_CLASSES_ROOT\Drive\shell\cmd\command]
    @="cmd.exe /k \"cd %L\""
    
  48. or download this
    use strict;
    use warnings;
    ...
    test 3: bypassed
    test 4: bypassed
    test 5: bypassed
    
  49. or download this
    @status = sort {
       my $mtime_a = (stat("$target_dir\\$a"))[9];
       my $mtime_b = (stat("$target_dir\\$b"))[9];
       $mtime_a <=> $mtime_b
    } @status;
    
  50. or download this
    @status = (
       map  { $_->[0] }
    ...
       map  { [ $_, stat("$target_dir\\$_"))[9] ] }
       @status
    );
    
  51. or download this
    use Alorithm::Loops;
    
    ...
       ];
    }
    
  52. or download this
    use strict;
    use warnings;
    ...
    my $a = $p->[0];    ## Gives no warnings!!
    my $q = undef;
    my $b = ${$q}[0];   ## Gives no warnings!!
    
  53. or download this
    ...
    print("$p\n");  # ARRAY(0x1abefa0)
    print("$q\n");  # ARRAY(0x1abf054)
    
  54. or download this
    # Create some subroutines to find:
    sub PACKAGEA::PACKAGEB::test {}
    ...
    
    print(join(', ', check_for_sub('test')), $/);
    # Prints "main, PACKAGEA::PACKAGEB, PACKAGED"
    
  55. or download this
    # Create some packages for testing:
    $PACKAGEA::ANYVAR = 1;
    ...
    PACKAGEA exists
    PACKAGEA::PACKAGEB exists
    PACKAGEC doesn't exist
    
  56. or download this
    # Create some packages for testing:
    $PACKAGEA::ANYVAR = 1;
    ...
    IO
    CORE
    main
    
  57. or download this
    $color = substr($color, -6);
    $color .= '0' x length(6-$color);
    $color =~ s/[^0-9A-Fa-f]/0/g;
    $color = hex($color);
    
  58. or download this
    // K&R C:
    char string[6] = "hello";  // Initializes string[] to "hello\0".
    ...
    
    a1 = "Greetings";  // ERROR
    a2 = "Greetings";  // OK
    

Log In?
Username:
Password:

What's my password?
Create A New User
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others perusing the Monastery: (9)
As of 2014-07-22 22:17 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    My favorite superfluous repetitious redundant duplicative phrase is:









    Results (129 votes), past polls