view release on metacpan or  search on metacpan

Changes  view on Meta::CPAN

Revision history for App-otfile

0.07  2018-04-04 06:55:47 EDT
       - Add --uuid or -u for manual uuid string

0.06  2014-06-10 22:38:38 EDT
        - Add Clipboard.pm for clipboard access, adding support for
          Windows and Linux.
        - --self or -s to serve a copy of itself
        - minor rephrasing of some help text
        - INTERNAL cleanup Term::ProgressBar terminal width setting

0.05  2013-09-26 19:51:19 EDT
        - -m to serve a file multiple times, doesn't exit until ctrl+c

0.04  2013-09-12 05:17:05 EDT
        - Add author, copyright, & license sections to otfile.pm

script/otfile  view on Meta::CPAN

my $file = shift or do { warn "Must provide file to serve\n"; pod2usage(2) };
die "Unable to read '$file'\n" unless -r $file;

# try loading some optional dependencies
my %opt_depend;

# we try for Mac::Pasteboard first for pre 0.06 people that have it
# but don't have Clipboard installed

eval { require Mac::Pasteboard; $opt_depend{pasteboard} = 1 };
eval { require Clipboard;       $opt_depend{clipboard}  = 1 }
    unless $opt_depend{pasteboard};
eval { require File::MMagic;      $opt_depend{mmagic}     = 1 };
eval { require UUID::Tiny;        $opt_depend{uuid}       = 1 };
eval { require URI::Escape;       $opt_depend{uri_escape} = 1 };
eval { require Term::ProgressBar; $opt_depend{progress}   = 1 };

my $type     = get_file_type($file);
my $size     = -s $file;
my $filename = fileparse($file);
my $ip       = get_local_ip();

script/otfile  view on Meta::CPAN

    }
    $port++;
}

my $url = "http://$ip:$port$path";

say "Serving '$file' as '$filename', size $size, type $type";

if ( $opt_depend{pasteboard} ) {
    Mac::Pasteboard::pbcopy($url);
    say "$url copied to clipboard.";
}
elsif ( $opt_depend{clipboard} ) {
    Clipboard->import;    # finds OS driver
    Clipboard->copy($url);
    say "$url copied to clipboard.";
}
else {
    say $url;
}

while ( my $client = $server->accept() ) {
    say 'I: Connect from ' . $client->peerhost;
    my $requested_path;
    LINE: while ( my $line = <$client> ) {
        last if $line =~ m/^\s*$/;