#!/usr/bin/perl -w -- 

use Wx 0.15 qw[:allclasses];
use strict;
use warnings;

package MyFrame;

use Wx qw[:everything];
use base qw(Wx::Frame);
use strict;
our $gl_self;
sub new {
    my( $self, $parent, $id, $title, $pos, $size, $style, $name ) = @_
+;
    $parent = undef              unless defined $parent;
    $id     = wxID_ANY                 unless defined $id;
    $title  = ""                 unless defined $title;
    $pos    = wxDefaultPosition  unless defined $pos;
    $size   = wxDefaultSize      unless defined $size;
    $name   = ""                 unless defined $name;

    $style = wxDEFAULT_FRAME_STYLE unless defined $style;

    $self = $self->SUPER::new( $parent, $id, $title, $pos, $size, $sty
+le, $name );
    $self->SetTitle("Drawing on image");

    $gl_self= $self;    # Set Global variable for use in EVT handler
    
# Image for drawing on
    $self->{image1} = Wx::Image->new( 'C:\insert_your_jpeg.jpg',  wxBI
+TMAP_TYPE_ANY, -1 );
    $self->{Loc_Photo_Bmp} = Wx::Bitmap->new( $self->{image1} ) ;
    $self->{bitmap_1} = Wx::StaticBitmap->new( $self, wxID_ANY, $self-
+>{Loc_Photo_Bmp});
    
# Button to draw image
    
    use Wx::Event qw( EVT_LEFT_UP );
    $self->{bitmap_1}->SetCursor(wxCROSS_CURSOR);
    $self->{bitmap_1}->Connect( wxID_ANY,wxID_ANY,wxEVT_LEFT_UP, \&on_
+button );
#
#    Sizer
#
    $self->{sizer_1} = Wx::BoxSizer->new(wxVERTICAL);
    $self->{sizer_1}->Add($self->{bitmap_1}, 0, 0, 0);
    $self->SetSizer($self->{sizer_1});
    $self->{sizer_1}->Fit($self);
    $self->Layout();
    
    return $self;
}
sub on_button{

        my ($self, $event) = @_;
    # select it into a memory dc
       if (defined $gl_self->{Loc_Photo_Bmp}){
        my $mdc = Wx::MemoryDC->new();
        $mdc->SelectObject($gl_self->{Loc_Photo_Bmp});
        my $pen = Wx::Pen->new( Wx::Colour->new(255,255,255), 3, wxSOL
+ID);
        $mdc->SetPen( $pen );
        $mdc->SetBrush( wxTRANSPARENT_BRUSH );
# Determine mouse event
#        my $m= Wx::MouseEvent->new($event);
        my $r = 50;
        my $x=$event->GetX();
        my $y=$event->GetY();
# Draw circle round mouse event
        $mdc->DrawCircle( $x, $y, $r );
        $mdc->SelectObject(wxNullBitmap); # deselect the bitmap out of
+ the DC
        $gl_self->{bitmap_1} ->SetBitmap($gl_self->{Loc_Photo_Bmp});
               $gl_self->{bitmap_1}->SetCursor(wxSTANDARD_CURSOR);
        $gl_self->{bitmap_1}->Disconnect( wxID_ANY,wxID_ANY,wxEVT_LEFT
+_DOWN );
        $gl_self->{bitmap_1}->Disconnect( wxID_ANY,wxID_ANY,wxEVT_LEFT
+_UP );
        }

    $event->Skip() ;
    return $self;
}

1;


package main;

unless(caller){
    local *Wx::App::OnInit = sub{1};
    my $app = Wx::App->new();
    Wx::InitAllImageHandlers();

    my $frame_1 = MyFrame->new();

    $app->SetTopWindow($frame_1);
    $frame_1->Show(1);
    $app->MainLoop();
}
[download]

use IO qw(File Handle);

my $io = do 
{
    if (shift) 
    {
    my $tmp = IO::Handle->new;

    die "open failed: $!" unless $tmp->fdopen(fileno(STDOUT),"w");
    $tmp;
    } 
    else 
    {
    my $tmp = IO::File->new('tmp.out', 'w');
    $tmp;
    }
};

$io->print("Some text\n");
[download]

use Image::ExifTool qw(ImageInfo);
my $exifTool = new Image::ExifTool;
$exifTool->Options(Binary => 1);
my $info = $exifTool->ImageInfo('image_file.jpg', 'thumbnailimage');
my $data = ${$$info{ThumbnailImage}};
my $loader = Gtk2::Gdk::PixbufLoader->new();
$loader->write($data);
$loader->close();
$pixbuf = $loader->get_pixbuf();
[download]

C:\Perl\bin\perl.exe -e "use Win32::Clipboard;Win32::Clipboard($ARGV[0
+]);"
[download]

C:\Perl\bin\perl.exe -e "use Win32::Clipboard;Win32::Clipboard($ARGV[0
+]);"
[download]

%bullets = ('*'=>'foo', '+'=>'bar', '@'=>'qux');

#Original, which as ikegami points out, doesn't quite work
#my $bullet= sprintf(qr/[%s]/, join('', keys %bullets));
#Alternate form, that I was trying to make more scrutable, with added 
+\Q
my $bullet=  qr/[\Q@{[join '', keys %bullets]}\E]/;
[download]

#!/usr/local/bin/perl

use strict;
use warnings;
use CPAN;

CPAN::Shell->a;
CPAN::Shell->d;
CPAN::Shell->m;
[download]

#!/usr/bin/perl

use strict;
use warnings;

use lib '../..' ;

use File::Copy;
use File::Find;
use File::Path;

my $root_dir = find_root_dir; 
our $prefix;


sub wanted {
    my ($file)=$_;

    return if -d $file;

    return if $File::Find::dir ne $root_dir;

    my $dir_to_make = categorize($file);

    File::Path::make_path($dir_to_make);

    File::Copy::move($file, $dir_to_make);

}

sub find_root_dir {

    use Local::Config;
    Local::Config->new->logdir;

}
 
sub categorize {
    my($file)=@_;

    substr($file, 0, 5);
}

File::Find::find(\&wanted, $root_dir);




# thanks to jhannah in #perl-help

# [09:52] <metaperl_work> Is there a utility to move files into a dire
+ctory based on a prefix of the name?
# [09:54] <mxf> "mv foo* bar/"?
# [09:54] <metaperl_work> mxf, yes, but there are tons of files which 
+must be automatically moved and directories created for them
# [09:55] <jhannah> trivial to write one?
# [09:55] <metaperl_work> jhannah, I suppose I need one of the File::F
+ind modules to do it
# [09:55] <metaperl_work> people seem to lieke F::F::Rules?
# [09:55] <mxf> metaperl_work, Ah, i see.
# [09:55] <jhannah> why? glob the dir in question, split your prefix, 
+create the dirs, move files
# [09:56] <jhannah> how is this more than 6 lines of perl?
# [09:56] <metaperl_work> for file in <*> { ... }
# [09:56] <metaperl_work> for my $file <*> { ... }
# [09:56] <metaperl_work> ?
# [09:56] <metaperl_work> next unless -f $file
# [09:56] <jhannah> foreach $file (glob "/path/to/dir") {  }
# [09:56] <jhannah> my $file
[download]

#!/usr/bin/perl

use strict;
use warnings;
use PDF::Create;

my $pdf = new PDF::Create(filename=>"test.pdf",Author=>"Me");
my $psz = $pdf->get_page_size("Letter");
my $rt = $pdf->new_page( MediaBox => $psz );
for my $i (<*.jpg>) {
    my $im = $pdf->image($i);
    my $pg = $rt->new_page( MediaBox => $psz );
    $pg->image( image => $im,
        xpos => 0, ypos => 0,
        xscale => $$psz[2] / $$im{width},
        yscale => $$psz[3] / $$im{height}
    );
}
$pdf->close;
[download]

# PUT IN .bashrc FILE

perlver() {
   local m=$1
   perl -M$m -e "print $m->VERSION,qq{\n};"
}

# EXECUTE FROM COMMAND LINE AS perlver <module>
[download]

my $obj = DynObject->new(id => 'MyObj', action => sub{print "hi\n";});

print $obj->id, "\n";
$obj->action();
[download]

$obj = MyDyn->new(id => 'MyObj');
print $obj->id, "\n";
$obj->action();

package MyDyn;
use base 'DynObject';
sub action
{
   print "hi\n";
}
[download]

use strict;
package DynObject;
use Carp;

my $counter = 0;

sub new
{
    my $class = shift;
    croak("The number of parameters must be even") unless @_ % 2 == 0;

    no strict 'refs';
    my $type = ref $class;
    my $code;
    if(!$type)
    {
        $type = __PACKAGE__;
        $type .= "::obj@{[$counter++]}";
        *{"${type}::ISA"} = [$class];
    }
    for(my $i = 0; $i < @_; $i+=2)
    {
        croak("The method name '$_[$i]' is not a word")
            unless $_[$i] =~ /^\w+$/ && $_[$i] !~ /^\d+$/;
        if(ref $_[$i+1] eq 'CODE')
        {
            *{"${type}::$_[$i]"} = $_[$i+1];
        }
        elsif(defined $_[$i+1] && !ref $_[$i+1])
        {
            my $str = $_[$i+1];
            *{"${type}::$_[$i]"} = sub{$str};
        }
        else
        {
            delete ${"${type}::"}{$_[$i]};
        }
    }
    return ref $class ? $class : bless [], $type;
}

sub DESTROY
{
    my $obj = shift;
    my $type = ref $obj;
    $type =~ s/(\w+)$//;
    my $name = $1 . "::";
    no strict 'refs';
    delete ${$type}{$name};
}

1;
[download]